Since you are looking only for a Windows implementation you must add the WS_EX_LAYERED
style to your form and then using the SetLayeredWindowAttributes
method set the alpha value based in a value or a color.
Check this implementation, using a interposer class.
type
TForm = class(FMX.Forms.TForm)
private
FAlphaBlend: Boolean;
FAlphaBlendValue: Byte;
FTransparentColor: Boolean;
FTransparentColorValue: TColor;
procedure SetAlphaBlend(const Value: Boolean);
procedure SetAlphaBlendValue(const Value: Byte);
procedure SetLayeredAttribs;
procedure SetTransparentColor(const Value: Boolean);
procedure SetTransparentColorValue(const Value: TColor);
protected
property AlphaBlend: Boolean read FAlphaBlend write SetAlphaBlend default False;
property AlphaBlendValue: Byte read FAlphaBlendValue write SetAlphaBlendValue default 255;
property TransparentColor: Boolean read FTransparentColor write SetTransparentColor default False;
property TransparentColorValue: TColor read FTransparentColorValue write SetTransparentColorValue;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
uses
FMX.Platform.Win,
Winapi.Windows,
Vcl.Graphics;
type
TSetLayeredWindowAttributes = function (Hwnd: THandle; crKey: COLORREF;
bAlpha: Byte; dwFlags: DWORD): Boolean; stdcall;
var
SetLayeredWindowAttributes: TSetLayeredWindowAttributes = nil;
procedure TForm1.FormCreate(Sender: TObject);
begin
@SetLayeredWindowAttributes := GetProcAddress(GetModuleHandle(User32), 'SetLayeredWindowAttributes');
AlphaBlend:=True;
AlphaBlendValue:=200;
end;
{ TForm }
procedure TForm.SetAlphaBlend(const Value: Boolean);
begin
if FAlphaBlend <> Value then
begin
FAlphaBlend := Value;
SetLayeredAttribs;
end;
end;
procedure TForm.SetAlphaBlendValue(const Value: Byte);
begin
if FAlphaBlendValue <> Value then
begin
FAlphaBlendValue := Value;
SetLayeredAttribs;
end;
end;
procedure TForm.SetTransparentColor(const Value: Boolean);
begin
if FTransparentColor <> Value then
begin
FTransparentColor := Value;
SetLayeredAttribs;
end;
end;
procedure TForm.SetTransparentColorValue(const Value: TColor);
begin
if FTransparentColorValue <> Value then
begin
FTransparentColorValue := Value;
SetLayeredAttribs;
end;
end;
procedure TForm.SetLayeredAttribs;
const
cUseAlpha: array [Boolean] of Integer = (0, LWA_ALPHA);
cUseColorKey: array [Boolean] of Integer = (0, LWA_COLORKEY);
var
AStyle: Integer;
begin
if not (csDesigning in ComponentState) and
(Assigned(SetLayeredWindowAttributes)) then
begin
AStyle := GetWindowLong( WindowHandleToPlatform(Handle).Wnd, GWL_EXSTYLE);
if FAlphaBlend or FTransparentColor then
begin
if (AStyle and WS_EX_LAYERED) = 0 then
SetWindowLong(WindowHandleToPlatform(Handle).Wnd, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
SetLayeredWindowAttributes(WindowHandleToPlatform(Handle).Wnd, ColorToRGB(FTransparentColorValue), FAlphaBlendValue,
cUseAlpha[FAlphaBlend] or cUseColorKey[FTransparentColor]);
end
else
begin
SetWindowLong(WindowHandleToPlatform(Handle).Wnd, GWL_EXSTYLE, AStyle and not WS_EX_LAYERED);
RedrawWindow(WindowHandleToPlatform(Handle).Wnd, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN);
end;
end;
end;