paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-17 10:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: added SetAlphaBlend method to TWSCustomForm class + win32 implementation

Browse Source 
git-svn-id: trunk@23562 -
This commit is contained in:
dmitry 2010-01-27 07:06:06 +00:00
parent 076e4e76dd
commit f9a3cc0fd2
2 changed files with 31 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -85,6 +85,7 @@ 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; AlphaValue: single); override;
end;
{ TWin32WSForm }
@ -482,6 +483,31 @@ begin
BringWindowToTop(ACustomForm.Handle);
end;
var
SetLayeredWindowAttributes_ : function (HWND:hwnd;crKey :COLORREF;bAlpha : byte;dwFlags : DWORD):WINBOOL; stdcall = nil; // external 'user32' name 'SetLayeredWindowAttributes';
class procedure TWin32WSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; AlphaValue: single);
var
style : LongWord;
begin
if not Assigned(SetLayeredWindowAttributes_) then
Pointer(SetLayeredWindowAttributes_):=GetProcAddress(GetModuleHandle('user32.dll'), 'SetLayeredWindowAttributes');
if not Assigned(SetLayeredWindowAttributes_) then Exit;
if Alpha<0 then Alpha:=0
else if Alpha>1 then Alpha:=1;
style:=GetWindowLong(AForm.Handle,GWL_EXSTYLE);
if Alpha<1 then
begin
if (style and WS_EX_LAYERED) = 0 then SetWindowLong(AForm.Handle, GWL_EXSTYLE, style or WS_EX_LAYERED);
SetLayeredWindowAttributes_(AForm.Handle, 0, Round(Alpha*255), LWA_ALPHA);
end
else begin
SetWindowLong(AForm.Handle, GWL_EXSTYLE, style and not WS_EX_LAYERED);
RedrawWindow(AForm.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN);
end;
end;
{ TWin32WSHintWindow }
class function TWin32WSHintWindow.CreateHandle(const AWinControl: TWinControl;

5
lcl/widgetset/wsforms.pp
View File

@ -91,6 +91,7 @@ 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;
end;
TWSCustomFormClass = class of TWSCustomForm;
@ -179,6 +180,10 @@ class procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
begin
end;
class procedure TWSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; AlphaValue: single);
begin
end;
{ WidgetSetRegistration }
procedure RegisterScrollingWinControl;