paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 21:55:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@23565 -
This commit is contained in:
paul 2010-01-27 07:57:16 +00:00
parent bbf658b1c9
commit 3208c507b6
5 changed files with 48 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/forms.pp
View File

@ -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;

20
lcl/include/customform.inc
View File

@ -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;

2
lcl/interfaces/win32/win32extra.pas
View File

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

26
lcl/interfaces/win32/win32wsforms.pp
View File

@ -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
else if Alpha>1 then Alpha:=1;
style:=GetWindowLong(ACustomForm.Handle,GWL_EXSTYLE);
if Alpha<1 then
Style := GetWindowLong(ACustomForm.Handle, GWL_EXSTYLE);
if AlphaBlend then
begin
if (style and WS_EX_LAYERED) = 0 then SetWindowLong(ACustomForm.Handle, GWL_EXSTYLE, style or WS_EX_LAYERED);
Win32Extra.SetLayeredWindowAttributes(ACustomForm.Handle, 0, Round(Alpha*255), LWA_ALPHA);
if (Style and WS_EX_LAYERED) = 0 then
SetWindowLong(ACustomForm.Handle, GWL_EXSTYLE, Style or WS_EX_LAYERED);
Win32Extra.SetLayeredWindowAttributes(ACustomForm.Handle, 0, Alpha, LWA_ALPHA);
end
else begin
SetWindowLong(ACustomForm.Handle, GWL_EXSTYLE, style and not WS_EX_LAYERED);
else
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;

6
lcl/widgetset/wsforms.pp
View File

@ -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;