W
wang_cai1
Unregistered / Unconfirmed
GUEST, unregistred user!
参考代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus, gdipapi, gdipobj; //最后两个是 GDI+ 引擎
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
Procedure MoveForm(var M:TWMNCHITTEST); Message WM_NCHITTEST;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
LWA_ALPHA = 2;
ULW_COLORKEY = 1;
ULW_ALPHA = 2;
ULW_OPAQUE = 4;
var
Form1: TForm1;
bmp, old_bmp : HBITMAP;
DC : HDC;
bitmap:array[1..15] of tgpbitmap;
j:integer;
Function UpdateLayeredWindow(hWnd : HWND;
hdcDst : HDC; pptDst : PPoint; psize : PSize;
hdcSrc : HDC; pptSrc : PPoint;
crKey : COLORREF;
pblend : PBlendFunction;
dwFlags : DWORD): BOOL; stdcall;
implementation
{$R *.dfm}
Function UpdateLayeredWindow; external 'user32.dll';
Procedure TForm1.MoveForm (var M:TWMNCHITTEST);
begin
inherited;
M.Result:=HTCAPTION;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
if SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED) = 0 then ShowMessage(SysErrorMessage(GetLastError));
for i:=1 to 15 do bitmap:=tgpbitmap.Create('./images/dd.'+inttostr(i)+'.png');
form1.Width:=bitmap[1].GetWidth;
form1.Height:=bitmap[1].GetHeight;
J:=1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i:integer;
begin
SelectObject(DC, old_bmp);
DeleteObject(bmp);
DeleteDC(DC);
for i:=1 to 15 do bitmap.Free;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
pt1, pt2 : TPoint;
sz : TSize;
bf : TBlendFunction;
begin
if j>15 then j:=1;
pt1 := Point(left, top);
pt2 := Point(0, 0);
sz.cx := bitmap[1].GetWidth;
sz.cy := bitmap[1].GetHeight;
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := $ff;
bf.AlphaFormat := AC_SRC_ALPHA;
DeleteObject(bmp);
bitmap[j].GetHBITMAP(0,bmp);
DeleteDC(DC);
DC := CreateCompatibleDC(Canvas.Handle);
old_bmp := SelectObject(DC, bmp);
UpdateLayeredWindow(Handle, Canvas.Handle, @pt1, @sz, DC, @pt2,0, @bf,ULW_ALPHA); // 有了这句话,WM_PAINT就不发生了,窗口也不画了,控件也看不见了
j:=j+1;
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus, gdipapi, gdipobj; //最后两个是 GDI+ 引擎
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
Procedure MoveForm(var M:TWMNCHITTEST); Message WM_NCHITTEST;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
LWA_ALPHA = 2;
ULW_COLORKEY = 1;
ULW_ALPHA = 2;
ULW_OPAQUE = 4;
var
Form1: TForm1;
bmp, old_bmp : HBITMAP;
DC : HDC;
bitmap:array[1..15] of tgpbitmap;
j:integer;
Function UpdateLayeredWindow(hWnd : HWND;
hdcDst : HDC; pptDst : PPoint; psize : PSize;
hdcSrc : HDC; pptSrc : PPoint;
crKey : COLORREF;
pblend : PBlendFunction;
dwFlags : DWORD): BOOL; stdcall;
implementation
{$R *.dfm}
Function UpdateLayeredWindow; external 'user32.dll';
Procedure TForm1.MoveForm (var M:TWMNCHITTEST);
begin
inherited;
M.Result:=HTCAPTION;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
if SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED) = 0 then ShowMessage(SysErrorMessage(GetLastError));
for i:=1 to 15 do bitmap:=tgpbitmap.Create('./images/dd.'+inttostr(i)+'.png');
form1.Width:=bitmap[1].GetWidth;
form1.Height:=bitmap[1].GetHeight;
J:=1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i:integer;
begin
SelectObject(DC, old_bmp);
DeleteObject(bmp);
DeleteDC(DC);
for i:=1 to 15 do bitmap.Free;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
pt1, pt2 : TPoint;
sz : TSize;
bf : TBlendFunction;
begin
if j>15 then j:=1;
pt1 := Point(left, top);
pt2 := Point(0, 0);
sz.cx := bitmap[1].GetWidth;
sz.cy := bitmap[1].GetHeight;
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := $ff;
bf.AlphaFormat := AC_SRC_ALPHA;
DeleteObject(bmp);
bitmap[j].GetHBITMAP(0,bmp);
DeleteDC(DC);
DC := CreateCompatibleDC(Canvas.Handle);
old_bmp := SelectObject(DC, bmp);
UpdateLayeredWindow(Handle, Canvas.Handle, @pt1, @sz, DC, @pt2,0, @bf,ULW_ALPHA); // 有了这句话,WM_PAINT就不发生了,窗口也不画了,控件也看不见了
j:=j+1;
end;
end.