http://hi.baidu.com/bluew/blog/item/2ecbe58bf93a937d9f2fb4de.html2007-08-09 00:52   我是用PNG图片Alpha透明的方式做的窗口,这种方法一个好处就是不用通过编程来控制窗口外观。Delphi7设置一下窗体的BorderStyle、Color、Transparent、TransparentColor属性就可以搞定异型窗口,但不是半透明的。UpdateLayeredWindow函数里设置Blend函数就可以实现半透明异型窗体。最近有个哥们网上弄来个老外用VC写的代码,他找人翻译成BCB的,因为BCB本身就支持GDI+,而Delphi不支持,所以我又找GDI+的类,我又改写成Delphi版的了,程序编译运行候效果很不错。需要两个pas文件:GDIPAPI, GDIPOBJ网上都有,唯一缺点是无法放VCL组件!放了也看不到,我真是晕啊,各位也帮忙看一下怎么解决??以下是全部源码:
//======================================
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,
GDIPAPI, GDIPOBJ, Menus, StdCtrls; //http://www.progdigy.com/modules.php?name=gdiplus

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Close1: TMenuItem;
ChangeSkin1: TMenuItem;
About1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
Edit1: TEdit;
Button1: TButton;
Stayontop1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Close1Click(Sender: TObject);
procedure ChangeSkin1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Stayontop1Click(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)) + 'test.png')) then
SetTransparent(WideString(ExtractFilePath(ParamStr(0)) + 'test.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.Close1Click(Sender: TObject);
begin
Close();
end;

procedure TForm1.ChangeSkin1Click(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.About1Click(Sender: TObject);
begin
MessageDlg('GDI plus API by: http://www.progdigy.com '#13 +
'C++Builder example by: http://www.ccrun.com '#13 +
'Delphi example by: http://www.handsomesoft.com ',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;

end.

05-27 23:14