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

{*******************************************************}

{ }

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

{ }

{ 版权所有 (C) 2008 QQ:3150379 }

{ }

{*******************************************************}

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs,

GDIPAPI, GDIPOBJ, Menus, StdCtrls;

type

TForm1 = class(TForm)

PopupMenu1: TPopupMenu;

mniClose: TMenuItem;

mniChangeSkin: TMenuItem;

About1: TMenuItem;

Stayontop1: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure About1Click(Sender: TObject);

procedure Stayontop1Click(Sender: TObject);

procedure mniChangeSkinClick(Sender: TObject);

procedure mniCloseClick(Sender: TObject);

private

m_Blend: BLENDFUNCTION;

procedure SetTransparent(lpSkinFile: WideString; nTran: integer);

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

BorderStyle := bsNone;

m_Blend.BlendOp := AC_SRC_OVER; // the only BlendOp defined in Windows 2000

m_Blend.BlendFlags := 0; // Must be zero

m_Blend.AlphaFormat := AC_SRC_ALPHA; //This flag is set when the bitmap has an Alpha channel

m_Blend.SourceConstantAlpha := 255;

if (FileExists(ExtractFilePath(ParamStr(0)) + 'Security - Alert.png')) then

SetTransparent(WideString(ExtractFilePath(ParamStr(0)) + 'Security - Alert.png'), 100);

// Stay on top

SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

end;

procedure TForm1.SetTransparent(lpSkinFile: WideString; nTran: integer);

var

GPImage: TGPImage;

GPGraph: TGPGraphics;

m_Image: TGPImage;

m_hdcMemory: HDC;

hdcScreen: HDC;

hBMP: HBITMAP;

sizeWindow: SIZE;

rct: TRECT;

ptSrc: TPOINT;

begin

// Use GDI+ load image

GPImage := TGPImage.Create();

m_Image := GPImage.FromFile(lpSkinFile);

// Create Compatible Bitmap

hdcScreen := GetDC(0);

m_hdcMemory := CreateCompatibleDC(hdcScreen);

hBMP := CreateCompatibleBitmap(hdcScreen, m_Image.GetWidth(), m_Image.GetHeight());

SelectObject(m_hdcMemory, hBMP);

// Alpha Value

if (nTran < 0) or (nTran > 100) then

nTran := 100;

m_Blend.SourceConstantAlpha := round(nTran * 2.55); // 1~255

GetWindowRect(Handle, rct);

GPGraph := TGPGraphics.Create(m_hdcMemory);

GPGraph.DrawImage(m_Image, 0, 0, m_Image.GetWidth(), m_Image.GetHeight());

sizeWindow.cx := m_Image.GetWidth();

sizeWindow.cy := m_Image.GetHeight();

ptSrc.x := 0;

ptSrc.y := 0;

// Set Window style

SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);

// perform the alpha blend

UpdateLayeredWindow(Handle, hdcScreen, nil,@sizeWindow, m_hdcMemory, @ptSrc, 0, @m_Blend, ULW_ALPHA);

//Release resources

GPGraph.ReleaseHDC(m_hdcMemory);

ReleaseDC(0, hdcScreen);

hdcScreen := 0;

DeleteObject(hBMP);

DeleteDC(m_hdcMemory);

m_hdcMemory := 0;

m_Image.Free;

GPGraph.Free;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if (Button = mbLeft) then

begin

ReleaseCapture();

Perform(WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);

end;

end;

procedure TForm1.About1Click(Sender: TObject);

begin

MessageDlg('效果还不行吧！'#13+'QQ:3150379', mtInformation, [mbOK], 0);

end;

procedure TForm1.Stayontop1Click(Sender: TObject);

var

mi: TMenuItem;

WindowPos: HWND;

begin

mi := Sender as TMenuItem;

mi.Checked := not mi.Checked;

if mi.Checked then

WindowPos := HWND_TOPMOST

else

WindowPos := HWND_NOTOPMOST;

SetWindowPos(Handle, WindowPos,0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

end;

procedure TForm1.mniChangeSkinClick(Sender: TObject);

var

dlgOpen: TOpenDialog;

begin

dlgOpen := TOpenDialog.Create(Self);

dlgOpen.Filter := 'PNG file(*.png)|*.png';

if (dlgOpen.Execute()) then

begin

SetTransparent(WideString(dlgOpen.FileName), 100);

Invalidate();

end;

dlgOpen.Free;

end;

procedure TForm1.mniCloseClick(Sender: TObject);

begin

Close;

end;

end.