delphi 创建半透明的异形窗口

准备一个半透明效果的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;

效果图：（后方蓝色框是鼠标选择桌面图标的效果）