paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-27 05:29:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: fixed lcl compilation. moved SetLayeredWindowAttributes dynamic loading to win32extra

Browse Source 
git-svn-id: trunk@23563 -
This commit is contained in:
dmitry 2010-01-27 07:12:46 +00:00
parent f9a3cc0fd2
commit 1b3f777fd0
3 changed files with 22 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -79,6 +79,7 @@ var
GetMenuBarInfo: function(hwnd: HWND; idObject: LONG; idItem: LONG; pmbi: PMENUBARINFO): BOOL; stdcall;
GetWindowInfo: function(hwnd: HWND; pwi: PWINDOWINFO): BOOL; stdcall;
SetLayout: function(dc: HDC; l: DWord): DWord; stdcall;
SetLayeredWindowAttributes: function (HWND:hwnd;crKey :COLORREF;bAlpha : byte;dwFlags : DWORD):WINBOOL; stdcall;
const
// ComCtlVersions
@ -545,6 +546,11 @@ begin
Result := GDI_ERROR;
end;
function _SetLayeredWindowAttributes(HWND:hwnd;crKey :COLORREF;bAlpha : byte;dwFlags : DWORD):WINBOOL; stdcall;
begin
Result := False;
end;
const
msimg32lib = 'msimg32.dll';
user32lib = 'user32.dll';
@ -595,6 +601,7 @@ begin
Pointer(GetComboboxInfo) := @_GetComboboxInfo;
Pointer(GetMenuBarInfo) := @_GetMenuBarInfo;
Pointer(GetWindowInfo) := @_GetWindowInfo;
Pointer(SetLayeredWindowAttributes) := @_SetLayeredWindowAttributes;
user32handle := LoadLibrary(user32lib);
if user32handle <> 0 then
@ -610,6 +617,10 @@ begin
p := GetProcAddress(user32handle, 'GetWindowInfo');
if p <> nil
then Pointer(GetWindowInfo) := p;
p := GetProcAddress(user32handle, 'SetLayeredWindowAttributes');
if p <> nil
then Pointer(SetLayout) := p;
end;
// Defaults
@ -633,6 +644,7 @@ begin
if p <> nil
then Pointer(SetLayout) := p;
end;
end;
procedure Finalize;

2
lcl/interfaces/win32/win32wsextdlgs.pp
View File

@ -96,7 +96,7 @@ type
implementation
{$r win32wsextdlgs.rc}
{.$r win32wsextdlgs.rc}
function OpenPictureDialogCallBack(hWnd: Handle; uMsg: UINT; wParam: WPARAM;
lParam: LPARAM): UINT; stdcall;

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

@ -85,7 +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;
class procedure SetAlphaBlend(const ACustomForm: TCustomForm; Alpha: single); override;
end;
{ TWin32WSForm }
@ -483,28 +483,24 @@ 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);
class procedure TWin32WSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; Alpha: single);
var
style : LongWord;
begin
if not Assigned(SetLayeredWindowAttributes_) then
Pointer(SetLayeredWindowAttributes_):=GetProcAddress(GetModuleHandle('user32.dll'), 'SetLayeredWindowAttributes');
if not Assigned(SetLayeredWindowAttributes_) then Exit;
if not WSCheckHandleAllocated(ACustomForm, 'SetAlphaBlend') then
Exit;
if Alpha<0 then Alpha:=0
else if Alpha>1 then Alpha:=1;
style:=GetWindowLong(AForm.Handle,GWL_EXSTYLE);
style:=GetWindowLong(ACustomForm.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);
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);
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);
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;