准备一个半透明效果的png图片放在res目录下。
新建一个rc文件:test.rc 加入项目。
内如如下
Png_test PNG "res\未命名-1.png"
代码如下:
uses Winapi.GDIPAPI, Winapi.GDIPOBJ,ActiveX;
procedure TForm1.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: HGLOBAL;
begin
SetWindowLong(Handle,GWL_EXSTYLE,
getwindowlong(handle,GWL_EXSTYLE)
and (not WS_EX_APPWINDOW)
or WS_EX_TOOLWINDOW
or WS_EX_LAYERED
);
//从资源中载入
with TResourceStream.Create(HInstance, 'Png_test', '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,pointer( vGdip)) <> OK then Exit;
GlobalFree(vGlobal);
finally
Free;
end;
if GdipCreateHBITMAPFromBitmap(pointer(vGdip), vBitmap, 0) <> 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(Pointer(vGdip));
end;
效果图:(后方蓝色框是鼠标选择桌面图标的效果)