paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

richmemo: win32 theme drawing. #21347. The implementation is based on the patch (by unknown contributor - see the bug tacker issue). But, thank you!

Browse Source 
The way to override the implementation is provided. 

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4154 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz 2015-05-26 16:48:41 +00:00
parent 8592b112fd
commit 6ac1c63457
1 changed files with 51 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
components/richmemo/win32/win32richmemo.pas
View File

@ -30,7 +30,7 @@ uses
Classes, SysUtils,
// LCL headers
LCLType, LCLIntf, LCLProc, WSLCLClasses,
Graphics, Controls, StdCtrls, Printers,
Graphics, Controls, StdCtrls, Printers, Themes,
// Win32WidgetSet
Win32WSControls, Win32Int, Win32WSStdCtrls, win32proc,
// RichMemo headers
@ -145,6 +145,17 @@ var
// doesn't overprint the selected text (until the end of the line).
// No info is found online, about the bug
FixPrintSelRange : Boolean = true;
type
// the function is called during WM_NCPAINT message handling
// Handled must be set to "true" to prevent Windows default handling of the message
// if set to true, the resulting value of the function would be used as result for message handler
TNCPaintProc = function (AHandle: Windows.HANDLE; RichMemo: TCustomRichMemo; WParam: WParam; LParam: LParam; var Handled: Boolean): LResult;
var
// the value can be set to nil to use system-native drawing only.
// or set it to whatever function desired
NCPaint : TNCPaintProc = nil;
implementation
@ -254,13 +265,32 @@ end;
function RichEditProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
begin
var
WindowInfo : PWin32WindowInfo;
NcHandled : Boolean; // NCPaint has painted by itself
begin
case Msg of
WM_PAINT : begin
//todo: LCL WM_PAINT handling prevents richedit from drawing correctly
Result := CallDefaultWindowProc(Window, Msg, WParam, LParam)
//Result := WindowProc(Window, Msg, WParam, LParam)
end;
//When theming is enabled, and the component should have a border around it,
WM_NCPAINT: begin
if Assigned(NCPaint) then begin
NcHandled :=false;
WindowInfo := GetWin32WindowInfo(Window);
if WindowInfo^.WinControl is TCustomRichMemo then
try
Result:=NCPaint(Window, TCustomRichMemo(WindowInfo^.WinControl), WParam, LParam, NcHandled);
except
end;
// not handled by LCL pass it to WinAPI
if not NcHandled then
Result:=WindowProc(Window, Msg, WParam, LParam);
end else
Result:=WindowProc(Window, Msg, WParam, LParam);
end;
else
Result := WindowProc(Window, Msg, WParam, LParam);
end;
@ -1251,6 +1281,25 @@ begin
ReleaseDC(hnd, Rng.hdc);
end;
end;
// The function doesn't use Windows 7 (Vista?) animations. And should.
function ThemedNCPaint(AWindow: Windows.HANDLE; RichMemo: TCustomRichMemo; WParam: WParam; LParam: LParam; var Handled: Boolean): LResult;
var
hdc : Windows.HDC;
begin
// When theming is enabled, and the component should have a border around it,
// let the theme manager handle it
Handled:=(GetWindowLong(AWindow, GWL_EXSTYLE) and WS_EX_CLIENTEDGE <> 0) and (ThemeServices.ThemesEnabled);
if Handled then begin
// Paint into this DC
ThemeServices.PaintBorder(RichMemo, True);
Result := 0;
end;
end;
initialization
NCPaint := @ThemedNCPaint;
end.