AlphaBlend in FireMonkey

前端 未结 2 1373
深忆病人
深忆病人 2020-12-16 07:07

How can I change AlphaBlend value (of a form) in a FireMonkey Desktop Application? Well It\'s available in VCL Application but I couldn\'t find it in FireMonkey

相关标签:
2条回答
  • 2020-12-16 07:13

    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;
    

    enter image description here

    0 讨论(0)
  • 2020-12-16 07:31

    To make your form background semitransparent you should set form Transparency property to true and use Fill.Color with alpha value like $AAFFFFFF(with Fill.Kind = bkSolid). in this case form border becomes invisible (at least in Delphi XE2)

    if you need to make all components at form semitransparent then place TLayout on form with Align = alContents and set its Opacity property to required value.

    enter image description here

    if you need semitransparent window with alpha blend as it was in VCL you can use the same methods (for Windows platform) as getWindowLong/SetWindowLong. Set transparency back to false and use code like this in form OnCreate event handler:

    implementation
    uses fmx.platform.win, winapi.windows;
    {$R *.fmx}
    
    procedure TMainForm.FormCreate(Sender: TObject);
    var h : HWND;
        aStyle : integer;
        alphaValue : byte;
    begin
        h := WindowHandleToPlatform(self.Handle).Wnd;
        AStyle := GetWindowLong(h, GWL_EXSTYLE);
        SetWindowLong(h, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
    
    
        AlphaValue := 125;
        SetLayeredWindowAttributes(h, 0, alphaValue, LWA_ALPHA);
    end;
    

    of course all your components become trasparent too.

    0 讨论(0)
提交回复
热议问题