GDI+用PNG图片做半透明异型窗口

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