Search the Community

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.