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

statusbar: draw themed statusbar if themes are enabled (from ThemeManager of Mike Lischke)

Browse Source 
git-svn-id: trunk@14589 -
This commit is contained in:
paul 2008-03-20 06:24:42 +00:00
parent df0c6930b5
commit f0081cc693
2 changed files with 52 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lcl/interfaces/win32/win32callback.inc
View File

@ -483,10 +483,10 @@ var
PaintMsg.DC := DC;
if not needParentPaint and not isNotebook then
begin
// send through message to allow message override
//lWinControl.EraseBackground(PaintMsg.DC);
// send through message to allow message override, moreover use SendMessage
// to allow subclass window proc override this message too
Include(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground);
lWinControl.Perform(LM_ERASEBKGND, Windows.WPARAM(PaintMsg.DC), 0);
SendMessage(lWinControl.Handle, WM_ERASEBKGND, Windows.WPARAM(PaintMsg.DC), 0);
Exclude(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground);
end;
if ParentPaintWindow <> 0 then
@ -1530,22 +1530,24 @@ begin
end;
if not GetNeedParentPaint(WindowInfo, lWinControl) or (eraseBkgndCommand = ecDoubleBufferNoRemove) then
begin
if ThemeServices.ThemesEnabled and WindowInfo^.isGroupBox
and (lWinControl <> nil) then
if ThemeServices.ThemesEnabled and WindowInfo^.isGroupBox and (lWinControl <> nil) then
begin
// Groupbox (which is a button) doesn't erase it's background properly; force repaint
lWinControl.EraseBackground(HDC(WParam));
LMessage.Result := 1;
end else begin
end
else
begin
LMessage.Msg := LM_ERASEBKGND;
LMessage.WParam := WParam;
LMessage.LParam := LParam;
end;
end else begin
end else
begin
SendPaintMessage(HDC(WParam));
LMessage.Result := 1;
end;
WinProcess := false;
WinProcess := False;
end;
WM_EXITMENULOOP:
// is it a popup menu

43
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -30,7 +30,7 @@ uses
// FCL
CommCtrl, Windows, Classes, SysUtils, Win32Extra,
// LCL
ComCtrls, LCLType, Controls, Graphics,
ComCtrls, LCLType, Controls, Graphics, Themes,
ImgList, StdCtrls,
LCLProc, InterfaceBase,
// widgetset
@ -328,6 +328,45 @@ begin
end;
end;
function StatusBarWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
var
Info: PWindowInfo;
Control: TWinControl;
Details: TThemedElementDetails;
begin
Info := GetWindowInfo(Window);
if (Info = nil) or (Info^.WinControl = nil) then
begin
Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
Exit;
end
else
Control := Info^.WinControl;
// Paul: next is a slightly modified code of TThemeManager.StatusBarWindowProc
// of Mike Lischke Theme manager library (Mike granted us permition to use his code)
case Msg of
WM_NCCALCSIZE:
begin
// We need to override the window class' CS_HREDRAW and CS_VREDRAW styles but the following
// does the job very well too.
// Note: this may produce trouble with embedded controls (e.g. progress bars).
if WParam <> 0 then
Result := CallDefaultWindowProc(Window, Msg, WParam, LParam) or WVR_REDRAW;
end;
WM_ERASEBKGND:
begin
Details := ThemeServices.GetElementDetails(tsStatusRoot);
ThemeServices.DrawElement(HDC(WParam), Details, Control.ClientRect);
Result := 1;
end;
else
Result := WindowProc(Window, Msg, WParam, LParam);
end;
end;
{ TWin32WSStatusBar }
class function TWin32WSStatusBar.CreateHandle(const AWinControl: TWinControl;
@ -342,6 +381,8 @@ begin
begin
pClassName := STATUSCLASSNAME;
WindowTitle := StrCaption;
if ThemeServices.ThemesEnabled then
SubClassWndProc := @StatusBarWndProc;
end;
// create window
FinishCreateWindow(AWinControl, Params, false);