五维思考

学习要加,骄傲要减,机会要乘,懒惰要除。 http://www.5dthink.cn

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
  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, 0000, 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 < 0or (nTran > 100then
  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, 00, 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,0000, 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.
posted on 2008-09-11 08:23  五维思考  阅读(250)  评论(0编辑  收藏  举报

QQ群:1. 全栈码农【346906288】2. VBA/VSTO【2660245】