1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:

/////////////////////////////////////////////////////
//                                                 //
//  Written by: AyaKoshigaya (March 2006)          //
//                                                 //
//  Mail: Aya@koshigaya.de                         //
//  Website: http://www.Koshigaya.de               //
//                                                 //
/////////////////////////////////////////////////////
unit kSysTransparentForm;

interface

uses
  Windows, Graphics;

function InitTransparentForm: Boolean;
procedure DestroyTransparentForm;
function MakeTransparentForm(FormHandle: hWnd; Width, Height: Integer; imageFilename: PWideChar): Boolean;

implementation

const
  GdiPlusLib = 'GdiPlus.dll';

var
  mDC: Cardinal;
  mainBitmap: Cardinal;
  blendFunc32bpp: BLENDFUNCTION;
  token: Cardinal;
  oldBitmap: Cardinal;

type
  DebugEventProc = procedure(Level: Integer; Msg: Pointer); stdcall;
  NotificationHookProc = function(out token: DWord): Integer; stdcall;
  NotificationUnhookProc = procedure(token: DWord); stdcall;
  PGdiplusStartupInput = ^GdiplusStartupInput;
  GdiplusStartupInput = packed object
    GdiplusVersion: UInt;
    DebugEventCallback: DebugEventProc;
    SuppressBackgroundThread: Bool;
    SuppressExternalCodecs: Bool;
    procedure Init(debugEventCB: DebugEventProc = nil; supBackgroundThread: BOOL = false; supExternalCodecs: BOOL = false);
  end;
  PGdiplusStartupOutput = ^GdiplusStartupOutput;
  GdiplusStartupOutput = packed record
    NotificationHook: NotificationHookProc;
    NotificationUnhook: NotificationUnhookProc;
  end;

function GdipCreateFromHDC(hDC: HDC; var Graphics: Cardinal): Integer; stdcall; external GdiPlusLib;
function GdipLoadImageFromFile(const fileName: PWideChar; var Image: Cardinal): Integer; stdcall; external GdiPlusLib;
function GdipGetImageWidth(Image: Cardinal; var Width: UINT): Integer; stdcall; external GdiPlusLib;
function GdipGetImageHeight(Image: Cardinal; var Height: UINT): Integer; stdcall; external GdiPlusLib;
function GdipDrawImageRect(Graphics: Cardinal; Image: Cardinal; X, Y, Width, Height: Single): Integer; stdcall; external GdiPlusLib;
function GdipDisposeImage(Image: Cardinal): Integer; stdcall; external GdiPlusLib;
function GdipDeleteGraphics(Graphics: Cardinal): Integer; stdcall; external GdiPlusLib;
function GdiplusStartup(out Token: DWord; const Input: GdiplusStartupInput; Output: PGdiplusStartupOutput): Integer; stdcall; external GdiPlusLib;
procedure GdiplusShutdown(Token: DWord); stdcall; external GdiPlusLib;

function InitTransparentForm: Boolean;
var
  GpInput: GdiplusStartupInput;
  GpOutput: GdiplusStartupOutput;
begin
  GpInput.Init;
  Result:=GdiplusStartup(Token, GpInput, @GpOutput) = 0;
end;

procedure DestroyTransparentForm;
begin
  GdiplusShutdown(Token);
  SelectObject(mDC, oldBitmap);
  DeleteObject(mainBitmap);
  DeleteObject(oldBitmap);
  DeleteDC(mDC);
end;

function MakeTransparentForm(FormHandle: hWnd; Width, Height: Integer; imageFilename: PWideChar): Boolean;
var
  tempBitmap: BITMAPINFO;
  lngHeight, lngWidth: Cardinal;
  curWinLong: Cardinal;
  img: Cardinal;
  graphics: Cardinal;
  winSize: Size;
  srcPoint: TPoint;
  pvBits: Pointer;
  HandleDC: hDC;
begin
  HandleDC:=GetDC(FormHandle);
  Result:=true;
  ZeroMemory(@tempBitmap, sizeof(BITMAPINFO));
  with tempBitmap.bmiHeader do begin
    biSize:=SizeOf(BITMAPINFOHEADER);
    biBitCount:=32;
    biWidth:=Width;
    biHeight:=Height;
    biPlanes:=1;
    biCompression:=BI_RGB;
    biSizeImage:=biWidth * biHeight * 4;
  end;
  mDC:=CreateCompatibleDC(HandleDC);
  mainBitmap:=CreateDIBSection(mDC, tempBitmap, DIB_RGB_COLORS, pvBits, 0, 0);
  oldBitmap:=SelectObject(mDC, mainBitmap);

  if GdipCreateFromHDC(mDC, graphics) <> 0 then Result:=false;
  if GdipLoadImageFromFile(imageFilename, img) <> 0 then Result:=false;
  if GdipGetImageWidth(img, lngWidth) <> 0 then Result:=false;
  if GdipGetImageHeight(img, lngHeight) <> 0 then Result:=false;
  if GdipDrawImageRect(graphics, img, 0, 0, lngWidth, lngHeight) <> 0 then Result:=false;
  curWinLong:=GetWindowLong(FormHandle, GWL_EXSTYLE);
  SetWindowLong(FormHandle, GWL_EXSTYLE, curWinLong or WS_EX_LAYERED);
  SetWindowPos(FormHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
  srcPoint.X:=0;
  srcPoint.Y:=0;
  winSize.cx:=Width;
  winSize.cy:=Height;
  with blendFunc32bpp do begin
    AlphaFormat:=AC_SRC_ALPHA;
    BlendFlags:=0;
    BlendOp:=AC_SRC_OVER;
    SourceConstantAlpha:=255;
  end;
  if GdipDisposeImage(img) <> 0 then Result:=false;
  if GdipDeleteGraphics(graphics) <> 0 then Result:=false;
  if not UpdateLayeredWindow(FormHandle, HandleDC, nil, @winSize, mDC, @srcPoint, 0, @blendFunc32bpp, ULW_ALPHA) then Result:=false; 
end;

{ GdiplusStartupInput }

procedure GdiplusStartupInput.Init(debugEventCB: DebugEventProc; supBackgroundThread, supExternalCodecs: BOOL);
begin
  GdiplusVersion:=1;
  DebugEventCallback:=debugEventCB;
  SuppressBackgroundThread:=supBackgroundThread;
  SuppressExternalCodecs:=supExternalCodecs;
end;

end.