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

时间：2023-01-26 19:34:02
  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.

相关文章