convert LM_SETFORMICON message to interface method

git-svn-id: trunk@6002 -

lcl/include/application.inc

@@ -735,7 +735,8 @@ end;
  ------------------------------------------------------------------------------}
 procedure TApplication.IconChanged(Sender: TObject);
 begin
-  CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
+  DebugLn('TApplication.IconChanged - TODO: convert this message...no implementation in gtk or win32');
+  // CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
   // NotifyForms(CM_ICONCHANGED);
 end;
 
@@ -1339,6 +1340,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.91  2004/09/15 07:57:59  micha
+  convert LM_SETFORMICON message to interface method
+
   Revision 1.90  2004/09/11 13:38:37  micha
   convert LM_BRINGTOFRONT message to interface method
   NOTE: was only used for tapplication, not from other controls

lcl/include/customform.inc

@@ -195,7 +195,7 @@ End;
 procedure TCustomForm.IconChanged(Sender: TObject);
 begin
   if HandleAllocated then
-    CNSendMessage(LM_SETFORMICON,Self,Pointer(GetIconHandle));
+    TWSCustomForm(WidgetSetClass).SetIcon(Self, GetIconHandle);
 end;
 
 {------------------------------------------------------------------------------
@@ -1489,7 +1489,7 @@ begin
   inherited CreateWnd;
   
   if Parent=nil then begin
-    CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
+    TWSCustomFormClass(WidgetSetClass).SetIcon(Self, GetIconHandle);
     DC:=GetDC(Handle);
     FPixelsPerInch:=GetDeviceCaps(DC,LOGPIXELSX);
     ReleaseDC(Handle,DC);
@@ -1808,6 +1808,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.157  2004/09/15 07:57:59  micha
+  convert LM_SETFORMICON message to interface method
+
   Revision 1.156  2004/09/13 13:13:46  micha
   convert LM_SHOWMODAL to interface methods
 

lcl/interfaces/gtk/gtkobject.inc

@@ -3064,9 +3064,7 @@ var
   Widget      : PGtkWidget;            // pointer to gtk-widget (local use when neccessary)
   GList       : pGList;                // Only used for listboxes, replace with widget!!!!!
   ListItem    : PGtkListItem;          // currently only used for listboxes
-  FormIconGdiObject: PGdiObject;     // currently only used by LM_SETFORMICON
   Geometry    : TGdkGeometry;
-  AWindow     : PGdkWindow;
 begin
   Result := 0;   //default value just in case nothing sets it
 
@@ -3118,25 +3116,6 @@ begin
             TLMNotebookEvent(Data^).Page);
         end;
 
-      LM_SETFORMICON :
-      begin
-        if (Sender is TCustomForm) and (TCustomForm(Sender).Parent=nil) then
-        begin
-          if (Handle<>0) and (Data<>nil) then begin
-            FormIconGdiObject:=Data;
-            //DebugLn('LM_SETFORMICON ',FormIconGdiObject<>nil,' ',pgtkWidget(Handle)^.Window<>nil);
-            if (FormIconGdiObject<>nil) then begin
-              AWindow:=GetControlWindow(PGtkWidget(Handle));
-              if AWindow<>nil then begin
-                gdk_window_set_icon(AWindow, nil,
-                  FormIconGdiObject^.GDIBitmapObject,
-                  FormIconGdiObject^.GDIBitmapMaskObject);
-              end;
-            end;
-          end;
-        end;
-      end;
-
       LM_SCREENINIT :
       begin
         { Compute pixels per inch variable }
@@ -8211,6 +8190,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.568  2004/09/15 07:57:59  micha
+  convert LM_SETFORMICON message to interface method
+
   Revision 1.567  2004/09/14 15:48:28  micha
   convert LM_INVALIDATE message to interface method
 

lcl/interfaces/gtk/gtkwsforms.pp

@@ -30,7 +30,7 @@ uses
   {$IFDEF GTK2} Gtk2, Glib2, gdk2, {$ELSE} Gtk, gdk, Glib, {$ENDIF}
   SysUtils, Classes, Controls, LMessages, InterfaceBase, graphics,
   Dialogs, WSDialogs, WSLCLClasses, gtkint, gtkproc, gtkwscontrols,
-  Forms, WSForms, Math;
+  Forms, WSForms, Math, lcltype, gtkdef;
 
 type
 
@@ -74,6 +74,7 @@ type
   public
     class procedure SetFormBorderStyle(const AForm: TCustomForm;
                              const AFormBorderStyle: TFormBorderStyle); override;
+    class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
     class procedure ShowModal(const ACustomForm: TCustomForm); override;
   end;
 
@@ -122,6 +123,28 @@ begin
   // This is Delphi compatible, so no Recreatewnd needed.
 end;
 
+procedure TGtkWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
+var
+  FormIconGdiObject: PGdiObject;
+  AWindow     : PGdkWindow;
+begin
+  if AForm.Parent = nil then
+  begin
+    if AForm.HandleAllocated and (AIcon <> 0) then begin
+      FormIconGdiObject:=PGdiObject(AIcon);
+      //DebugLn('LM_SETFORMICON ',FormIconGdiObject<>nil,' ',pgtkWidget(Handle)^.Window<>nil);
+      if (FormIconGdiObject <> nil) then begin
+        AWindow:=GetControlWindow(PGtkWidget(AForm.Handle));
+        if AWindow<>nil then begin
+          gdk_window_set_icon(AWindow, nil,
+            FormIconGdiObject^.GDIBitmapObject,
+            FormIconGdiObject^.GDIBitmapMaskObject);
+        end;
+      end;
+    end;
+  end;
+end;
+
 procedure TGtkWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
 var
   GtkWindow: PGtkWindow;

lcl/interfaces/win32/win32object.inc

@@ -330,10 +330,6 @@ Begin
         Else
           Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
       End;
-      LM_SETFORMICON:
-      Begin
-        SetClassLong(Handle, GCL_HIcon, integer(Data));
-      End;
       LM_GETITEMS :
       Begin
         If (Sender as TControl).fCompStyle = csCListBox
@@ -2239,6 +2235,9 @@ End;
 
 {
   $Log$
+  Revision 1.261  2004/09/15 07:58:00  micha
+  convert LM_SETFORMICON message to interface method
+
   Revision 1.260  2004/09/14 21:30:37  vincents
   replaced writeln by DebugLn
 

lcl/interfaces/win32/win32wsforms.pp

@@ -77,6 +77,7 @@ type
   private
   protected
   public
+    class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
     class procedure ShowModal(const ACustomForm: TCustomForm); override;
   end;
 
@@ -141,6 +142,11 @@ end;
 
 { TWin32WSCustomForm }
 
+procedure TWin32WSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
+begin
+  SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, AIcon);
+end;
+
 procedure TWin32WSCustomForm.ShowModal(const ACustomForm: TCustomForm);
 var
   FormHandle: HWND;

lcl/lmessages.pp

@@ -62,7 +62,6 @@ const
   LM_GETVALUE       = LM_ComUser+41;         // get actual value from visual object
 
   LM_RECREATEWND    = LM_COMUSER+57;
-  LM_SETFORMICON    = LM_COMUSER+58;
 
   LM_MINIMIZE       = LM_COMUSER+59;
 
@@ -831,7 +830,6 @@ begin
   LM_GETVALUE       :Result:='LM_GETVALUE';
 
   LM_RECREATEWND    :Result:='LM_RECREATEWND';
-  LM_SETFORMICON    :Result:='LM_SETFORMICON';
 
   LM_MINIMIZE       :Result:='LM_MINIMIZE';
 
@@ -961,6 +959,9 @@ end.
 
 {
   $Log$
+  Revision 1.100  2004/09/15 07:57:59  micha
+  convert LM_SETFORMICON message to interface method
+
   Revision 1.99  2004/09/14 15:48:28  micha
   convert LM_INVALIDATE message to interface method
 

lcl/widgetset/wsforms.pp

@@ -46,7 +46,7 @@ uses
 ////////////////////////////////////////////////////
   Forms,
 ////////////////////////////////////////////////////
-  WSLCLClasses, WSControls, Controls;
+  WSLCLClasses, WSControls, Controls, LCLType;
 
 type
   { TWSScrollingWinControl }
@@ -74,6 +74,7 @@ type
   TWSCustomForm = class(TWSScrollingWinControl)
     class procedure SetFormBorderStyle(const AForm: TCustomForm;
                              const AFormBorderStyle: TFormBorderStyle); virtual;
+    class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); virtual;
     class procedure ShowModal(const ACustomForm: TCustomForm); virtual;
   end;
   TWSCustomFormClass = class of TWSCustomForm;
@@ -108,7 +109,11 @@ procedure TWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
 begin
   // will be done in interface override
 end;
-
+    
+procedure TWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
+begin
+end;
+   
 procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
 begin
 end;