new interface method to attach a menu to window

git-svn-id: trunk@4733 -

lcl/graphics.pp

@@ -36,7 +36,7 @@ uses
   {$IFDEF UseFPImage}
   FPImage, FPReadPNG, FPWritePNG, FPReadBMP, FPWriteBMP, IntfGraphics,
   {$ENDIF}
-  LCLStrConsts, vclGlobals, LMessages, LCLType, LCLProc, LCLIntf, LResources,
+  LCLStrConsts, vclGlobals, LMessages, LCLType, LCLProc, LResources,
   GraphType, GraphMath;
 
 type
@@ -1085,7 +1085,7 @@ const
 implementation
 
 uses
-  TypInfo;
+  TypInfo, LCLIntf;
 
 function SendIntfMessage(LM_Message : integer; Sender : TObject;
   Data : pointer) : integer;
@@ -1259,6 +1259,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.94  2003/10/26 17:34:41  micha
+  new interface method to attach a menu to window
+
   Revision 1.93  2003/10/15 20:33:36  ajgenius
   add csForm, start fixing Style matching for syscolors and fonts
 

lcl/include/interfacebase.inc

@@ -56,6 +56,10 @@ begin
   Result := True;
 end;
 
+procedure TInterfaceBase.AttachMenuToWindow(AMenu: TMenu);
+begin
+end;
+
 function TInterfaceBase.BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc;
 begin
   Result:=GetDC(Handle);
@@ -1833,6 +1837,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.105  2003/10/26 17:34:41  micha
+  new interface method to attach a menu to window
+
   Revision 1.104  2003/10/16 23:54:27  marc
   Implemented new gtk keyevent handling
 

lcl/include/menu.inc

@@ -77,6 +77,8 @@ begin
   // Note: FItems is a TMenuItem. Using HandleNeeded will create all subitems.
   for i:=0 to Items.Count-1 do
     Items[i].HandleNeeded;
+  // attach menu to window
+  InterfaceObject.AttachMenuToWindow(Self);
 end;
 
 procedure TMenu.DoChange(Source: TMenuItem; Rebuild: Boolean);
@@ -236,6 +238,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.20  2003/10/26 17:34:41  micha
+  new interface method to attach a menu to window
+
   Revision 1.19  2003/10/22 17:50:16  mattias
   updated rpm scripts
 

lcl/interfacebase.pp

@@ -42,7 +42,7 @@ interface
 
 uses
   Classes, SysUtils, LCLStrConsts, LCLType, LCLProc, VCLGlobals, LMessages,
-  GraphType, GraphMath;
+  Menus, GraphType, GraphMath;
 
 type
 
@@ -65,6 +65,7 @@ type
     procedure WaitMessage; virtual; abstract;
     procedure AppInit; virtual; abstract;
     procedure AppTerminate; virtual; abstract;
+    procedure AttachMenuToWindow(AMenu: TMenu); virtual;
     function IntSendMessage3(LM_Message : Integer; Sender : TObject; data : pointer) : integer; virtual; abstract;
 
     function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; virtual; abstract;
@@ -105,7 +106,7 @@ var
 
 implementation
 
-uses Math;
+uses Math, LCLIntf;
 
 {$I interfacebase.inc}
 
@@ -120,6 +121,9 @@ end.
 
 {
   $Log$
+  Revision 1.33  2003/10/26 17:34:41  micha
+  new interface method to attach a menu to window
+
   Revision 1.32  2003/08/18 19:24:18  mattias
   fixed TCanvas.Pie
 

lcl/interfaces/win32/win32int.pp

@@ -38,7 +38,7 @@ Interface
 Uses
   Windows, Classes, LCLStrConsts, ComCtrls, Controls, Dialogs, DynHashArray,
   ExtCtrls, Forms, GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType,
-  LMessages, StdCtrls, SysUtils, VCLGlobals, Win32Def, Graphics;
+  LMessages, StdCtrls, SysUtils, VCLGlobals, Win32Def, Graphics, Menus;
 
 Type
   { Virtual alignment-control record }
@@ -116,6 +116,7 @@ Type
     Procedure HandleEvents; Override;
     Procedure WaitMessage; Override;
     Procedure AppTerminate; Override;
+    Procedure AttachMenuToWindow(AMenu: TMenu); Override;
 
     function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
     function DestroyTimer(TimerHandle: integer) : boolean; override;
@@ -131,7 +132,7 @@ Type
 Implementation
 
 Uses
-  Arrow, Buttons, Calendar, CListBox, Menus, Spin, WinExt;
+  Arrow, Buttons, Calendar, CListBox, Spin, WinExt;
 
 Type
   TEventType = (etNotify, etKey, etKeyPress, etMouseWheeel, etMouseUpDown);
@@ -180,6 +181,9 @@ End.
 { =============================================================================
 
   $Log$
+  Revision 1.47  2003/10/26 17:34:41  micha
+  new interface method to attach a menu to window
+
   Revision 1.46  2003/10/23 07:45:49  micha
   cleanups; single parent window (single taskbar button)
 

lcl/interfaces/win32/win32object.inc

@@ -1237,6 +1237,11 @@ begin
   Assert(False,'Trace:Destroy timer Result: '+ BOOL_RESULT[result]);
 end;
 
+procedure TWin32Object.AttachMenuToWindow(AMenu: TMenu);
+begin
+  Windows.SetMenu(TWinControl(AMenu.Owner).Handle, AMenu.Handle);
+end;
+
 { Private methods (in no significant order) }
 
 {------------------------------------------------------------------------------
@@ -2092,7 +2097,6 @@ Begin
       Window := CreateMenu;
       FMenu := Window;
       Assert(False, Format('Trace:Main menu owner --> %S', [(TComponent(Sender).Owner As TWinControl).ClassName]));
-      Windows.SetMenu(TWinControl(TComponent(Sender).Owner).Handle, Window);
     End;
     csMenuItem:
     Begin
@@ -2799,6 +2803,9 @@ End;
 
 {
   $Log$
+  Revision 1.121  2003/10/26 17:34:41  micha
+  new interface method to attach a menu to window
+
   Revision 1.120  2003/10/23 07:45:49  micha
   cleanups; single parent window (single taskbar button)
 

lcl/menus.pp

@@ -45,7 +45,7 @@ interface
 {$endif}
 
 uses
-  Classes, SysUtils, LCLStrConsts, LCLIntf, LCLType, LCLProc, VCLGlobals,
+  Classes, SysUtils, LCLStrConsts, LCLType, LCLProc, VCLGlobals,
   LMessages, ActnList, Graphics, ImgList;
 
 
@@ -314,6 +314,8 @@ procedure Register;
 
 implementation
 
+uses
+  LCLIntf, InterfaceBase;
 
 { Menu command managment }
 
@@ -386,6 +388,9 @@ end.
 
 {
   $Log$
+  Revision 1.53  2003/10/26 17:34:41  micha
+  new interface method to attach a menu to window
+
   Revision 1.52  2003/10/16 23:54:27  marc
   Implemented new gtk keyevent handling