water efect [delphi]

[mike_vio]

Salut, am gasit in kitul de la delphi 7 un .dll care facea efectul asta, pana la urma i-am gasit functiile si modul de apelare. Este misto mai ales pentru o forma de prezentare, "about" de exemplu. Am mai pus o functie ce face forma transparenta cu ce procent vrei.

Yfrog Photo : yfrog.com/5rtestkuj

waterctrl.dll de aici: MEGAUPLOAD - The leading online storage and file delivery service

waterctrl.dll si imaginea "1.bmp" (care trebuie rotita la 180 grade sa o afiseze in picioare) trebuie sa fie in directorul proiectului.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TButton;
    Timer1: TTimer;
    Button2: TButton;
    Button3: TButton;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    bmp:TBitmap;
  end;

var
  Form1: TForm1;
//  myFile : File of byte;

function enablewater(ParentWnd: HWND; Left, Top: integer; Bmp: HBITMAP; WaterRadius, WaterHeight: integer): BOOL; stdcall; external 'waterctrl.dll';
function waterblob(x, y: integer; radius, height: integer): BOOL; stdcall; external 'waterctrl.dll';
function disablewater(): BOOL; stdcall; external 'waterctrl.dll';
function flattenwater(): BOOL; stdcall; external 'waterctrl.dll';

implementation

{$R *.dfm}

Function MakeWindowTransparent(Wnd: HWND; nAlpha: Integer): Boolean;
Type TSetLayeredWindowAttributes = Function(HWnd: HWND; crKey: ColorREF; bAlpha: Byte;
     DwFlags: Longint): Longint; Stdcall;
Const LWA_ColorKEY  = 1;
      LWA_ALPHA     = 2;
      WS_EX_LAYERED = $80000;
Var hUser32: HMODULE;
    SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
Begin
  Result := False;
  hUser32 := GetModuleHandle('USER32.DLL');
  If hUser32 <> 0 Then Begin
    @SetLayeredWindowAttributes := GetProcAddress(hUser32, 'SetLayeredWindowAttributes');
    If @SetLayeredWindowAttributes <> nil Then  Begin
      SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE) Or WS_EX_LAYERED);
      SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)), LWA_ALPHA);
      Result := True;
                                                End;
                       End;
End;



procedure TForm1.btn1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  Timer1.Enabled:=True;
Btn3.Enabled:=true;
Button3.Enabled:=true;
Button2.Enabled:=true;
  try
enablewater(Form1.Handle,0,0,bmp.handle,3,50);

except
  end;
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
 waterblob(50, 50, 10, 1000);
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
 MakeWindowTransparent(Form1.Handle, 25);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
bmp:=TBitmap.Create;
bmp.LoadFromFile((ExtractFilePath(Application.ExeName)+'1.bmp'));
Btn3.Enabled:=False;
Button3.Enabled:=False;
Button2.Enabled:=False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 waterblob(70, 198, 10, 1000);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 disablewater;
 Timer1.Enabled:=false;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
flattenwater();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 disablewater();   
  bmp.Free;
end;

end.