convert LM_SETFONT to interface method

git-svn-id: trunk@5978 -

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
 

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;

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
 

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);

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