1. {*******************************************************}
2. {                                                       }
3. {       GDI+用PNG图片做半透明异型窗口                   }
4. {                                                       }
5. {       版权所有 (C) 2008 QQ:3150379                    }
6. {                                                       }
7. {*******************************************************}
9. unit Unit1;
11. interface
13. uses
14.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
15.   Dialogs,
16.   GDIPAPI, GDIPOBJ, Menus, StdCtrls;
18. type
19.   TForm1 = class(TForm)
20.     PopupMenu1: TPopupMenu;
21.     mniClose: TMenuItem;
22.     mniChangeSkin: TMenuItem;
23.     About1: TMenuItem;
24.     Stayontop1: TMenuItem;
25.     procedure FormCreate(Sender: TObject);
26.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
27.       Shift: TShiftState; X, Y: Integer);
28.     procedure About1Click(Sender: TObject);
29.     procedure Stayontop1Click(Sender: TObject);
30.     procedure mniChangeSkinClick(Sender: TObject);
31.     procedure mniCloseClick(Sender: TObject);
32.   private
33.     m_Blend: BLENDFUNCTION;
34.     procedure SetTransparent(lpSkinFile: WideString; nTran: integer);
35.           {   Private   declarations   }
36.   public
37.           {   Public   declarations   }
38.   end;
40. var
41.   Form1: TForm1;
43. implementation
45. {$R   *.dfm}
47. procedure TForm1.FormCreate(Sender: TObject);
48. begin
49.   BorderStyle := bsNone;
50.   m_Blend.BlendOp := AC_SRC_OVER; //   the   only   BlendOp   defined   in   Windows   2000
51.   m_Blend.BlendFlags := 0; //   Must   be   zero
52.   m_Blend.AlphaFormat := AC_SRC_ALPHA; //This   flag   is   set   when   the   bitmap   has   an   Alpha   channel
53.   m_Blend.SourceConstantAlpha := 255;
54.   if (FileExists(ExtractFilePath(ParamStr(0)) + 'Security - Alert.png')) then
55.     SetTransparent(WideString(ExtractFilePath(ParamStr(0)) + 'Security - Alert.png'), 100);
56.   //   Stay   on   top
57.   SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
58. end;
60. procedure TForm1.SetTransparent(lpSkinFile: WideString; nTran: integer);
61. var
62.   GPImage: TGPImage;
63.   GPGraph: TGPGraphics;
64.   m_Image: TGPImage;
66.   m_hdcMemory: HDC;
67.   hdcScreen: HDC;
68.   hBMP: HBITMAP;
70.   sizeWindow: SIZE;
71.   rct: TRECT;
72.   ptSrc: TPOINT;
73. begin
74.   //   Use   GDI+   load   image
75.   GPImage := TGPImage.Create();
76.   m_Image := GPImage.FromFile(lpSkinFile);
78.   //   Create   Compatible   Bitmap
79.   hdcScreen := GetDC(0);
80.   m_hdcMemory := CreateCompatibleDC(hdcScreen);
81.   hBMP := CreateCompatibleBitmap(hdcScreen, m_Image.GetWidth(), m_Image.GetHeight());
82.   SelectObject(m_hdcMemory, hBMP);
84.   //   Alpha   Value
85.   if (nTran < 0) or (nTran > 100) then
86.     nTran := 100;
87.   m_Blend.SourceConstantAlpha := round(nTran * 2.55); //   1~255
88.   GetWindowRect(Handle, rct);
90.   GPGraph := TGPGraphics.Create(m_hdcMemory);
91.   GPGraph.DrawImage(m_Image, 0, 0, m_Image.GetWidth(), m_Image.GetHeight());
93.   sizeWindow.cx := m_Image.GetWidth();
94.   sizeWindow.cy := m_Image.GetHeight();
96.   ptSrc.x := 0;
97.   ptSrc.y := 0;
99.   //   Set   Window   style
100.   SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
102.   //   perform   the   alpha   blend
103.   UpdateLayeredWindow(Handle, hdcScreen, nil,@sizeWindow, m_hdcMemory, @ptSrc, 0, @m_Blend, ULW_ALPHA);
104.   //Release   resources
105.   GPGraph.ReleaseHDC(m_hdcMemory);
106.   ReleaseDC(0, hdcScreen);
107.   hdcScreen := 0;
109.   DeleteObject(hBMP);
111.   DeleteDC(m_hdcMemory);
112.   m_hdcMemory := 0;
114.   m_Image.Free;
115.   GPGraph.Free;
116. end;
118. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
119.   Shift: TShiftState; X, Y: Integer);
120. begin
121.   if (Button = mbLeft) then
122.   begin
123.     ReleaseCapture();
124.     Perform(WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);
125.   end;
126. end;
130. procedure TForm1.About1Click(Sender: TObject);
131. begin
132.   MessageDlg('效果还不行吧！'#13+'QQ:3150379', mtInformation, [mbOK], 0);
133. end;
135. procedure TForm1.Stayontop1Click(Sender: TObject);
136. var
137.   mi: TMenuItem;
138.   WindowPos: HWND;
139. begin
140.   mi := Sender as TMenuItem;
141.   mi.Checked := not mi.Checked;
142.   if mi.Checked then
143.     WindowPos := HWND_TOPMOST
144.   else
145.     WindowPos := HWND_NOTOPMOST;
146.   SetWindowPos(Handle, WindowPos,0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
147. end;
149. procedure TForm1.mniChangeSkinClick(Sender: TObject);
150. var
151.   dlgOpen: TOpenDialog;
152. begin
153.   dlgOpen := TOpenDialog.Create(Self);
154.   dlgOpen.Filter := 'PNG   file(*.png)|*.png';
155.   if (dlgOpen.Execute()) then
156.   begin
157.     SetTransparent(WideString(dlgOpen.FileName), 100);
158.     Invalidate();
159.   end;
160.   dlgOpen.Free;
161. end;
163. procedure TForm1.mniCloseClick(Sender: TObject);
164. begin
165.   Close;
166. end;
168. end.