lcl: add TCustomForm.AlphaBlend, TCustomForm.AlphaBlendValue, change TWsCustomForm.SetAlphaBlend

git-svn-id: trunk@23565 -

lcl/forms.pp

@@ -390,6 +390,8 @@ type
     FActiveControl: TWinControl;
     FActiveDefaultControl: TControl;
     FAllowDropFiles: Boolean;
+    FAlphaBlend: Boolean;
+    FAlphaBlendValue: Byte;
     FBorderIcons: TBorderIcons;
     FDefaultControl: TControl;
     FCancelControl: TControl;
@@ -440,6 +442,8 @@ type
     procedure SetActiveControl(AWinControl: TWinControl);
     procedure SetActiveDefaultControl(AControl: TControl);
     procedure SetAllowDropFiles(const AValue: Boolean);
+    procedure SetAlphaBlend(const AValue: Boolean);
+    procedure SetAlphaBlendValue(const AValue: Byte);
     procedure SetBorderIcons(NewIcons: TBorderIcons);
     procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
     procedure SetCancelControl(NewControl: TControl);
@@ -582,6 +586,8 @@ type
     property ActiveControl: TWinControl read FActiveControl write SetActiveControl;
     property ActiveDefaultControl: TControl read FActiveDefaultControl write SetActiveDefaultControl;
     property AllowDropFiles: Boolean read FAllowDropFiles write SetAllowDropFiles default False;
+    property AlphaBlend: Boolean read FAlphaBlend write SetAlphaBlend;
+    property AlphaBlendValue: Byte read FAlphaBlendValue write SetAlphaBlendValue;
     property AutoScroll stored IsAutoScrollStored;
     property BorderIcons: TBorderIcons read FBorderIcons write SetBorderIcons
       default [biSystemMenu, biMinimize, biMaximize];
@@ -654,6 +660,8 @@ type
     property ActiveControl;
     property Align;
     property AllowDropFiles;
+    property AlphaBlend default False;
+    property AlphaBlendValue default 255;
     property AutoScroll;
     property AutoSize;
     property BiDiMode;

lcl/include/customform.inc

@@ -1491,6 +1491,24 @@ begin
     TWSCustomFormClass(WidgetSetClass).SetAllowDropFiles(Self, AValue);
 end;
 
+procedure TCustomForm.SetAlphaBlend(const AValue: Boolean);
+begin
+  if FAlphaBlend = AValue then
+    Exit;
+  FAlphaBlend := AValue;
+  if not (csDesigning in ComponentState) and HandleAllocated then
+    TWSCustomFormClass(WidgetSetClass).SetAlphaBlend(Self, AlphaBlend, AlphaBlendValue);
+end;
+
+procedure TCustomForm.SetAlphaBlendValue(const AValue: Byte);
+begin
+  if FAlphaBlendValue = AValue then
+    Exit;
+  FAlphaBlendValue := AValue;
+  if not (csDesigning in ComponentState) and HandleAllocated then
+    TWSCustomFormClass(WidgetSetClass).SetAlphaBlend(Self, AlphaBlend, AlphaBlendValue);
+end;
+
 {------------------------------------------------------------------------------
        TCustomForm SetFormStyle
 ------------------------------------------------------------------------------}
@@ -1592,6 +1610,8 @@ begin
   FBorderIcons := [biSystemMenu, biMinimize, biMaximize];
   FDefaultMonitor := dmActiveForm;
   FShowInTaskbar := stDefault;
+  FAlphaBlend := False;
+  FAlphaBlendValue := 255;
   // set border style before handle is allocated
   if not (fsBorderStyleChanged in FFormState) then
     FFormBorderStyle:= bsSizeable;

lcl/interfaces/win32/win32extra.pas

@@ -620,7 +620,7 @@ begin
 
     p := GetProcAddress(user32handle, 'SetLayeredWindowAttributes');
     if p <> nil
-    then Pointer(SetLayout) := p;
+    then Pointer(SetLayeredWindowAttributes) := p;
   end;
 
   // Defaults

lcl/interfaces/win32/win32wsforms.pp

@@ -85,7 +85,8 @@ type
     class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
     class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
     class procedure ShowModal(const ACustomForm: TCustomForm); override;
-    class procedure SetAlphaBlend(const ACustomForm: TCustomForm; Alpha: single); override;
+    class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean;
+      const Alpha: Byte); override;
   end;
 
   { TWin32WSForm }
@@ -483,23 +484,26 @@ begin
   BringWindowToTop(ACustomForm.Handle);
 end;
 
-class procedure TWin32WSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; Alpha: single);
+class procedure TWin32WSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm;
+  const AlphaBlend: Boolean; const Alpha: Byte);
 var
-  style : LongWord;
+  Style: DWord;
 begin
   if not WSCheckHandleAllocated(ACustomForm, 'SetAlphaBlend') then
     Exit;
 
-  if Alpha<0 then Alpha:=0
+  Style := GetWindowLong(ACustomForm.Handle, GWL_EXSTYLE);
-  else if Alpha>1 then Alpha:=1;
+
-  style:=GetWindowLong(ACustomForm.Handle,GWL_EXSTYLE);
+  if AlphaBlend then
-  if Alpha<1 then
   begin
-    if (style and WS_EX_LAYERED) = 0 then SetWindowLong(ACustomForm.Handle, GWL_EXSTYLE, style or WS_EX_LAYERED);
+    if (Style and WS_EX_LAYERED) = 0 then
-    Win32Extra.SetLayeredWindowAttributes(ACustomForm.Handle, 0, Round(Alpha*255), LWA_ALPHA);
+      SetWindowLong(ACustomForm.Handle, GWL_EXSTYLE, Style or WS_EX_LAYERED);
+    Win32Extra.SetLayeredWindowAttributes(ACustomForm.Handle, 0, Alpha, LWA_ALPHA);
   end
-  else begin
+  else
-    SetWindowLong(ACustomForm.Handle, GWL_EXSTYLE, style and not WS_EX_LAYERED);
+  begin
+    if (Style and WS_EX_LAYERED) <> 0 then
+      SetWindowLong(ACustomForm.Handle, GWL_EXSTYLE, Style and not WS_EX_LAYERED);
     RedrawWindow(ACustomForm.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN);
   end;
 end;

lcl/widgetset/wsforms.pp

@@ -91,7 +91,8 @@ type
     class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); virtual;
     class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
     class procedure ShowModal(const ACustomForm: TCustomForm); virtual;
-    class procedure SetAlphaBlend(const ACustomForm: TCustomForm; AlphaValue: single); virtual;
+    class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean;
+      const Alpha: Byte); virtual;
   end;
   TWSCustomFormClass = class of TWSCustomForm;
 
@@ -180,7 +181,8 @@ class procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
 begin
 end;
 
-class procedure TWSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; AlphaValue: single);
+class procedure TWSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm;
+  const AlphaBlend: Boolean; const Alpha: Byte);
 begin
 end;