Author: Jonas Bilinkevicius
I want to create a form that has some degree of transparency. I know that in
Windows 2000 SDK there is a very good resource to do that
(SetLayeredWindowAttributes), but this one is not implemented in Windows.pas. I
tried to import directly from user32.dll, and I even could find the value for some
constants (WS_EX_LAYERED) with non documented value (MS C++.net), but at the end, I
got some weird messages of "invalid variant type conversion" when trying to use
this function. Does somebody have any example written in Delphi using this function?
Answer:
Solve 1:
1 { ... }2 const3 WS_EX_LAYERED = $80000;
4 LWA_COLORKEY = 1;
5 LWA_ALPHA = 2;
6 type7 TSetLayeredWindowAttributes = function(
8 hwnd: HWND; {handle to the layered window}9 crKey: TColor; {specifies the color key}10 bAlpha: byte; {value for the blend function}11 dwFlags: DWORD {action}12 ): BOOL; stdcall;
13 14 procedure TfBaseSplash.FormCreate(Sender: TObject);
15 var16 Info: TOSVersionInfo;
17 F: TSetLayeredWindowAttributes;
18 begin19 inherited;
20 Info.dwOSVersionInfoSize := SizeOf(Info);
21 GetVersionEx(Info);
22 if (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and (Info.dwMajorVersion >= 5) then23 begin24 F := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
25 if Assigned(F) then26 begin27 SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle,
28 GWL_EXSTYLE) or WS_EX_LAYERED);
29 F(Handle, 0, Round(255 * 80 / 100), LWA_ALPHA);
30 end;
31 end;
32 end;
Solve 2:
Make sure you check that the OS supports it. Here's how I do it:
33 function ALLOWALPHA: Boolean;
34 type35 TSetLayeredWindowAttributes = function(hwnd: HWND; crKey: LongInt; bAlpha: Byte;
36 dwFlags: LongInt): LongInt; stdcall;
37 var38 FhUser32: THandle;
39 SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
40 begin41 AllowAlpha := False;
42 FhUser32 := LoadLibrary('USER32.DLL');
43 if FhUser32 <> 0 then44 begin45 @SetLayeredWindowAttributes := GetProcAddress(FhUser32,
46 'SetLayeredWindowAttributes');
47 if @SetLayeredWindowAttributes <> nilthen48 begin49 FreeLibrary(FhUser32);
50 Result := TRUE;
51 end52 else53 begin54 FreeLibrary(FhUser32);
55 Result := False;
56 end;
57 end;
58 end;