From 3f5685bc67c887bab052430e7c4b59562113153a Mon Sep 17 00:00:00 2001 From: micha Date: Sun, 12 Sep 2004 13:52:26 +0000 Subject: [PATCH] convert LM_SETFONT to interface method git-svn-id: trunk@5978 - --- lcl/include/wincontrol.inc | 5 ++++- lcl/interfaces/gtk/gtkwscontrols.pp | 9 ++++++++- lcl/interfaces/win32/win32object.inc | 9 +++------ lcl/interfaces/win32/win32wscontrols.pp | 8 +++++++- lcl/widgetset/wscontrols.pp | 7 ++++++- 5 files changed, 28 insertions(+), 10 deletions(-) diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index c4cf26fdcd..4b9442fe7d 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -1421,7 +1421,7 @@ procedure TWinControl.FontChanged(Sender: TObject); begin if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then begin - CNSendMessage(LM_SETFONT, Self, Pointer(Font.Handle)); + TWSWinControlClass(WidgetSetClass).SetFont(Self, Font); Exclude(FFlags,wcfFontChanged); //NotifyControls(CM_ ...); end else @@ -3912,6 +3912,9 @@ end; { ============================================================================= $Log$ + Revision 1.276 2004/09/12 13:52:26 micha + convert LM_SETFONT to interface method + Revision 1.275 2004/09/10 16:28:50 mattias implemented very rudimentary TTabControl diff --git a/lcl/interfaces/gtk/gtkwscontrols.pp b/lcl/interfaces/gtk/gtkwscontrols.pp index cfb2d76437..902e0e5e44 100644 --- a/lcl/interfaces/gtk/gtkwscontrols.pp +++ b/lcl/interfaces/gtk/gtkwscontrols.pp @@ -29,7 +29,7 @@ interface uses {$IFDEF GTK2} Gtk2, Glib2, {$ELSE} Gtk, Glib, {$ENDIF} SysUtils, Classes, Controls, LMessages, InterfaceBase, - WSControls, WSLCLClasses; + WSControls, WSLCLClasses, Graphics; type @@ -63,6 +63,7 @@ type class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override; class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override; + class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override; class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); override; class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override; class procedure SetCursor(const AControl: TControl; const ACursor: TCursor); override; @@ -221,6 +222,12 @@ begin GtkProc.SetCursor(AControl as TWinControl, ACursor); end; +procedure TGtkWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont); +begin + DebugLn('TGtkWSWinControl.SetFont: implement me!'); + // TODO: implement me! +end; + procedure TGtkWSWinControl.SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); var Widget: PGtkWidget; diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 0401a08d3f..506de09843 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -336,12 +336,6 @@ Begin Else Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName])); End; - LM_SETFONT: - begin - if Sender is TControl then begin - Windows.SendMessage(Handle, WM_SETFONT, windows.wParam(integer(data)), 1); - end; - end; LM_SETSIZE: Begin If (Sender Is TWinControl) Then // Handle is already tested --> see above @@ -2499,6 +2493,9 @@ End; { $Log$ + Revision 1.250 2004/09/12 13:52:26 micha + convert LM_SETFONT to interface method + Revision 1.249 2004/09/12 13:30:13 micha remove handling of LM_SETFOCUS in interface, as it is never sent from LCL diff --git a/lcl/interfaces/win32/win32wscontrols.pp b/lcl/interfaces/win32/win32wscontrols.pp index e34520095d..3cabb8505a 100644 --- a/lcl/interfaces/win32/win32wscontrols.pp +++ b/lcl/interfaces/win32/win32wscontrols.pp @@ -33,7 +33,7 @@ uses // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// - Controls, + Controls, Graphics, //////////////////////////////////////////////////// WSControls, WSLCLClasses, SysUtils, { TODO: needs to move } @@ -69,6 +69,7 @@ type class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override; class procedure SetColor(const AWinControl: TWinControl); override; + class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override; class procedure SetText(const AWinControl: TWinControl; const AText: string); override; class procedure ShowHide(const AWinControl: TWinControl); override; @@ -181,6 +182,11 @@ begin // TODO: to be implemented, had no implementation in LM_SETCOLOR message end; +procedure TWin32WSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont); +begin + Windows.SendMessage(AWinControl.Handle, WM_SETFONT, Windows.WParam(AFont.Handle), 1); +end; + procedure TWin32WSWinControl.SetText(const AWinControl: TWinControl; const AText: string); procedure SetPageCaption(const Page:TCustomPage); diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index f10fcb1aa1..ae691429df 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/lcl/widgetset/wscontrols.pp @@ -44,7 +44,7 @@ uses // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// - Controls, + Controls, Graphics, //////////////////////////////////////////////////// WSLCLClasses, WSImgList; @@ -71,6 +71,7 @@ type class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); virtual; class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); virtual; + class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); virtual; class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); virtual; class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); virtual; class procedure SetText(const AWinControl: TWinControl; const AText: String); virtual; @@ -139,6 +140,10 @@ end; procedure TWSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); begin end; + +procedure TWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont); +begin +end; procedure TWSWinControl.SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); begin