使用PNG实现半透明的窗体

Delphi中标准控件是不支持png图片的，据说从Window2000后增加 gdiplus.dll库处理更多的gdi图像，其中包括png。

关键的几个api

GdipCreateBitmapFromFile()，从文件载入图像（不单只Bitmap）

GdipCreateBitmapFromStreamICM()，从流中入图像

GdipCreateHBITMAPFromBitmap()，获取图像的位图

GdipDisposeImage()，释放图像资源

开始直接调用 GdipCreateBitmapFromFile没有成功，返回18的错误

查一下资料这个错误是： “GdiplusNotInitialized”
看来必须的初始化gdiplus。

网上找到一套“ TGPBitmap”相关的组件，封装了gdiplus的调用。可以参考其中的代码。

png载入后，再取出其位图。特别注意，这个位图是32位的。包括了R、G、B、 Alpha四个色值，其中Alpha就是透明度。UpdateLayeredWindow()API函数可以支持Alpha风格。

如何从流中载入？如何将VCL的流处理成IStream？看看代码吧。

效果图：

准备一张Png图片，编写rc文件，然后加入到工程中。

代码：

CJ7.rc

Png_Cj7PNG"CJ7.png"

CJ7Unit.pas

unit CJ7Unit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TFormCJ7 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormCJ7: TFormCJ7;

implementation

{$R *.dfm}

uses ActiveX;

type
DebugEventLevel = (
DebugEventLevelFatal,
DebugEventLevelWarning
);
TDebugEventLevel = DebugEventLevel;

DebugEventProc = procedure(level: DebugEventLevel; message: PChar); stdcall;

GdiplusStartupInput = packed record
GdiplusVersion: Cardinal;
DebugEventCallback: DebugEventProc;
SuppressBackgroundThread: BOOL;
SuppressExternalCodecs: BOOL;
end;
TGdiplusStartupInput = GdiplusStartupInput;
PGdiplusStartupInput = ^TGdiplusStartupInput;

NotificationHookProc = function(out token: ULONG): Integer; stdcall;
NotificationUnhookProc = procedure(token: ULONG); stdcall;

GdiplusStartupOutput = packed record
NotificationHook : NotificationHookProc;
NotificationUnhook: NotificationUnhookProc;
end;
TGdiplusStartupOutput = GdiplusStartupOutput;
PGdiplusStartupOutput = ^TGdiplusStartupOutput;

function GdipCreateHBITMAPFromBitmap(bitmap: THandle; out hbmReturn: HBITMAP;
background: Longword): Integer; stdcall; external 'gdiplus.dll';

function GdipCreateBitmapFromFile(filename: PWChar; out bitmap: THandle): Integer;
stdcall; external 'gdiplus.dll';

function GdipCreateBitmapFromStreamICM(stream: ISTREAM;
out bitmap: THandle): Integer; stdcall; external 'gdiplus.dll';

function GdipDisposeImage(image: THandle): Integer; stdcall;
stdcall; external 'gdiplus.dll';

function GdiplusStartup(out token: ULONG; input: PGdiplusStartupInput;
output: PGdiplusStartupOutput): Integer; stdcall; external 'gdiplus.dll';

procedure GdiplusShutdown(token: ULONG); stdcall; external 'gdiplus.dll';

procedure TFormCJ7.FormCreate(Sender: TObject);
var
vGdip: THandle;
vBitmap: HBITMAP;
vOldBitmap: HBITMAP;
vPoint1, vPoint2: TPoint;
vSize: TSize;
vBlendFunction: TBlendFunction;
vDC: HDC;
vBitmapInfo: TBitmapInfoHeader;
vDIBSection: TDIBSection;
vBuffer: PChar;
vStream: IStream;
vGlobal: THandle;
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);

///////Begin 从资源中载入
with TResourceStream.Create(HInstance, 'Png_Cj7', 'PNG') do try
vGlobal := GlobalAlloc(GHND, Size);
if vGlobal = 0 then Exit;
vBuffer := GlobalLock(vGlobal);
if not Assigned(vBuffer) then Exit;
try
Read(vBuffer^, Size);
finally
GlobalUnlock(vGdip);
end;
if CreateStreamOnHGlobal(vGlobal, False, vStream) <> S_OK then Exit;
if GdipCreateBitmapFromStreamICM(vStream, vGdip) <> S_OK then Exit;
GlobalFree(vGlobal);
finally
Free;
end;
///////End 从资源中载入

if GdipCreateHBITMAPFromBitmap(vGdip, vBitmap, 0) <> S_OK then Exit;

vBitmapInfo.biSize := SizeOf(vBitmapInfo);
GetObject(vBitmap, SizeOf(vDIBSection), @vDIBSection);
vPoint1 := Point(Left, Top);
vPoint2 := Point(0, 0);
vSize.cx := vDIBSection.dsBm.bmWidth;
vSize.cy := vDIBSection.dsBm.bmHeight;
vBlendFunction.BlendOp := AC_SRC_OVER;
vBlendFunction.BlendFlags := 0;
vBlendFunction.SourceConstantAlpha := $FF; // 透明度
vBlendFunction.AlphaFormat := AC_SRC_ALPHA; //同上
vDC := CreateCompatibleDC(Canvas.Handle);
vOldBitmap := SelectObject(vDC, vBitmap);
UpdateLayeredWindow(Handle, Canvas.Handle,
@vPoint1, @vSize, vDC, @vPoint2, 0, @vBlendFunction, ULW_ALPHA);
SelectObject(vDC, vOldBitmap);
DeleteDC(vDC);
DeleteObject(vBitmap);
GdipDisposeImage(vGdip);
end;

procedure TFormCJ7.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, SC_MOVE or HTCLIENT, 0); // 拖动
end;

var
vStartupInput: TGDIPlusStartupInput;
vToken: ULONG;

initialization
vStartupInput.DebugEventCallback := nil;
vStartupInput.SuppressBackgroundThread := False;
vStartupInput.SuppressExternalCodecs := False;
vStartupInput.GdiplusVersion := 1;
GdiplusStartup(vToken, @vStartupInput, nil);

finalization
GdiplusShutdown(vToken);

end.

想了解gdi+的资料可以参考：

http://msdn2.microsoft.com/en-us/library/ms533798.aspx