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

lcl: implement TControl.DesktopFont, add support for CM_SYSFONTCHANGED

Browse Source 
git-svn-id: trunk@29879 -
This commit is contained in:
paul 2011-03-17 02:31:57 +00:00
parent 28fcb60f75
commit af80e73948
3 changed files with 26 additions and 2 deletions

6
lcl/controls.pp
View File

@ -886,6 +886,7 @@ type
FControlFlags: TControlFlags;
FControlHandlers: array[TControlHandlerType] of TMethodList;
FControlStyle: TControlStyle;
FDesktopFont: Boolean;
FDockOrientation: TDockOrientation;
FDragCursor: TCursor;
FDragKind: TDragKind;
@ -998,6 +999,7 @@ type
procedure SetClientSize(const Value: TPoint);
procedure SetClientWidth(Value: Integer);
procedure SetConstraints(const Value: TSizeConstraints);
procedure SetDesktopFont(const AValue: Boolean);
procedure SetDragCursor(const AValue: TCursor);
procedure SetFont(Value: TFont);
procedure SetHeight(Value: Integer);
@ -1107,6 +1109,7 @@ type
procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
procedure LMCaptureChanged(var Message: TLMessage); message LM_CaptureChanged;
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
procedure CMSysFontChanged(var Message: TLMessage); message CM_SYSFONTCHANGED;
procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
procedure CMHitTest(var Message: TCMHittest) ; message CM_HITTEST;
procedure CMMouseEnter(var Message :TLMessage); message CM_MOUSEENTER;
@ -1213,9 +1216,10 @@ type
protected
// optional properties (not every descendent supports them)
property ActionLink: TControlActionLink read FActionLink write FActionLink;
property DesktopFont: Boolean read FDesktopFont write SetDesktopFont;
property DragCursor: TCursor read FDragCursor write SetDragCursor default crDrag;
property DragKind: TDragKind read FDragKind write FDragKind default dkDrag;
property DragMode: TDragMode read fDragMode write SetDragMode default dmManual;
property DragMode: TDragMode read FDragMode write SetDragMode default dmManual;
property MouseCapture: Boolean read GetMouseCapture write SetMouseCapture;
property ParentColor: Boolean read FParentColor write SetParentColor default True;
property ParentFont: Boolean read FParentFont write SetParentFont default True;

20
lcl/include/control.inc
View File

@ -283,6 +283,7 @@ end;
procedure TControl.FontChanged(Sender: TObject);
begin
FParentFont := False;
FDesktopFont := False;
Invalidate;
Perform(CM_FONTCHANGED, 0, 0);
if AutoSize then
@ -3214,6 +3215,15 @@ begin
FConstraints.Assign(Value);
end;
procedure TControl.SetDesktopFont(const AValue: Boolean);
begin
if FDesktopFont <> AValue then
begin
FDesktopFont := AValue;
Perform(CM_SYSFONTCHANGED, 0, 0);
end;
end;
{------------------------------------------------------------------------------
TControl SetAlign
------------------------------------------------------------------------------}
@ -4288,6 +4298,7 @@ begin
FParentBidiMode := True;
FParentColor := True;
FParentFont := True;
FDesktopFont := True;
FParentShowHint := True;
FWindowProc := @WndProc;
FCursor := crDefault;
@ -4958,6 +4969,15 @@ begin
Invalidate;
end;
procedure TControl.CMSysFontChanged(var Message: TLMessage);
begin
if FDesktopFont then
begin
Font := Screen.SystemFont;
FDesktopFont := True;
end;
end;
{------------------------------------------------------------------------------
TControl.CMParentBidiModeChanged

2
lcl/lmessages.pp
View File

@ -287,7 +287,7 @@ const
CM_ISTOOLCONTROL = CM_BASE + 50 unimplemented;
CM_RECREATEWND = CM_BASE + 51 unimplemented;
CM_INVALIDATE = CM_BASE + 52 unimplemented;
CM_SYSFONTCHANGED = CM_BASE + 53 unimplemented;
CM_SYSFONTCHANGED = CM_BASE + 53;
CM_CONTROLCHANGE = CM_BASE + 54;
CM_CHANGED = CM_BASE + 55;
CM_DOCKCLIENT = CM_BASE + 56 unimplemented; //Method TWinControl.DoDockClientMsg()