convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)

git-svn-id: trunk@6025 -

lcl/graphics.pp

@@ -1253,7 +1253,7 @@ function ReadXPMSize(XPM: PPChar; var Width, Height, ColorCount: integer
 
 var
   { Stores information about the current screen }
-  ScreenInfo: TLMScreenInit;
+  ScreenInfo: TScreenInfo;
   
   FontResourceCache: TFontHandleCache;
   PenResourceCache: TPenHandleCache;
@@ -1756,6 +1756,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.151  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.150  2004/09/14 18:02:44  mattias
   made TCanvas methods virtual
 

lcl/include/application.inc

@@ -245,8 +245,7 @@ begin
     DebugLn('ERROR: ',rsNoInterfaceObject);
     raise Exception.Create(rsNoInterfaceObject);
   end;
-  InterfaceObject.AppInit;
+  InterfaceObject.AppInit(ScreenInfo);
-  CNSendMessage(LM_SCREENINIT, nil, @ScreenInfo);
   Screen.UpdateScreen;
   // application icon
   if LazarusResources.Find('MAINICON')<>nil then begin
@@ -1340,6 +1339,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.92  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.91  2004/09/15 07:57:59  micha
   convert LM_SETFORMICON message to interface method
 

lcl/interfacebase.pp

@@ -48,7 +48,7 @@ type
     destructor Destroy; override;
     procedure HandleEvents; virtual; abstract;
     procedure WaitMessage; virtual; abstract;
-    procedure AppInit; virtual; abstract;
+    procedure AppInit(var ScreenInfo: TScreenInfo); virtual; abstract;
     procedure AppTerminate; virtual; abstract;
     procedure AppMinimize; virtual; abstract;
     procedure AppBringToFront; virtual; abstract;
@@ -119,6 +119,9 @@ end.
 
 {
   $Log$
+  Revision 1.53  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.52  2004/09/14 10:06:25  micha
   convert LM_REDRAW message to interface method (in twidgetset)
 

lcl/interfaces/gtk/gtkint.pp

@@ -284,7 +284,7 @@ type
     procedure WaitMessage; override;
     procedure SendCachedLCLMessages; override;
     procedure AppTerminate; override;
-    procedure AppInit; override;
+    procedure AppInit(var ScreenInfo: TScreenInfo); override;
     procedure AppMinimize; override;
     procedure AppBringToFront; override;
     function  DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
@@ -455,6 +455,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.207  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.206  2004/09/16 14:32:31  micha
   convert LM_SETSELMODE message to interface method
 

lcl/interfaces/gtk/gtkobject.inc

@@ -1507,11 +1507,17 @@ end;
   (is called by TApplication.Initialize which is typically after all
    finalization sections)
  ------------------------------------------------------------------------------}
-procedure TGtkWidgetSet.AppInit;
+procedure TGtkWidgetSet.AppInit(var ScreenInfo: TScreenInfo);
 begin
   If Assigned(Screen) then
     FillScreenFonts(Screen.Fonts);
   InitKeyboardTables;
+  { Compute pixels per inch variable }
+  ScreenInfo.PixelsPerInchX :=
+    RoundToInt(gdk_screen_width / (gdk_screen_width_mm / 25.4));
+  ScreenInfo.PixelsPerInchY :=
+    RoundToInt(gdk_screen_height / (gdk_screen_height_mm / 25.4));
+  ScreenInfo.ColorDepth := gdk_visual_get_system^.depth;
 end;
 
 {------------------------------------------------------------------------------
@@ -3112,16 +3118,6 @@ begin
             TLMNotebookEvent(Data^).Page);
         end;
 
-      LM_SCREENINIT :
-      begin
-        { Compute pixels per inch variable }
-        PLMScreenInit(Data)^.PixelsPerInchX:=
-          RoundToInt(gdk_screen_width / (gdk_screen_width_mm / 25.4));
-        PLMScreenInit(Data)^.PixelsPerInchY:=
-          RoundToInt(gdk_screen_height / (gdk_screen_height_mm / 25.4));
-        PLMScreenInit(Data)^.ColorDepth:= gdk_visual_get_system^.depth;
-      end;
-
       LM_SETGEOMETRY :
       begin
         if Sender is TWinControl then begin
@@ -7896,6 +7892,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.581  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.580  2004/09/18 01:18:00  mattias
   removed unneeded handle
 

lcl/interfaces/win32/win32int.pp

@@ -165,7 +165,7 @@ Type
     { Destructor of the class }
     Destructor Destroy; Override;
     { Initialize the API }
-    Procedure AppInit; Override;
+    procedure AppInit(var ScreenInfo: TScreenInfo); override;
     procedure AppMinimize; override;
     procedure AppBringToFront; override;
     procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
@@ -277,6 +277,9 @@ End.
 { =============================================================================
 
   $Log$
+  Revision 1.113  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.112  2004/09/15 17:21:22  micha
   convert LM_GETITEMINDEX and LM_SETITEMINDEX messages to interface methods
 

lcl/interfaces/win32/win32object.inc

@@ -124,19 +124,21 @@ End;
 
   Initialize Windows
  ------------------------------------------------------------------------------}
-Procedure TWin32WidgetSet.AppInit;
+procedure TWin32WidgetSet.AppInit(var ScreenInfo: TScreenInfo);
-Var
+var
+  ICC: TINITCOMMONCONTROLSEX;
   LogBrush: TLOGBRUSH;
   SysMenu: HMENU;
-  ICC: TINITCOMMONCONTROLSEX;
+  Handle: HWND;
-Begin
+  DC: HDC;
+begin
   Assert(False, 'Trace:Win32Object.Init - Start');
-  If Not WinRegister then
+  if not WinRegister then
-  Begin
+  begin
     Assert(False, 'Trace:Win32Object.Init - Register Failed');
     DebugLn('Trace:Win32Object.Init - Register Failed');
     Exit;
-  End;
+  end;
 
   //Init stock objects;
   LogBrush.lbStyle := BS_NULL;
@@ -184,8 +186,16 @@ Begin
   Windows.DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND);
   Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
   
+  // initialize ScreenInfo
+  Handle := GetDesktopWindow;
+  DC := Windows.GetDC(Handle);
+  ScreenInfo.PixelsPerInchX := GetDeviceCaps(DC, LOGPIXELSX);
+  ScreenInfo.PixelsPerInchY := GetDeviceCaps(DC, LOGPIXELSY);
+  ScreenInfo.ColorDepth := GetDeviceCaps(DC, BITSPIXEL);
+  ReleaseDC(Handle, DC);
+
   Assert(False, 'Trace:Win32Object.Init - Exit');
-End;
+end;
 
 {------------------------------------------------------------------------------
   Method: TWin32WidgetSet.AppMinimize
@@ -251,7 +261,6 @@ Function TWin32WidgetSet.IntSendMessage3(LM_Message: Integer; Sender: TObject; D
 Var
   //Bitmap: HBITMAP; // Pixel map type image
   //CBI: COMBOBOXINFO;
-  DC: HDC;
   Handle: HWND;
   AMenu: TMenu;
   AccelTable: HACCEL;
@@ -274,18 +283,6 @@ Begin
     LM_RECREATEWND:
       Result := RecreateWnd(TWinControl(Sender));
         //SH: think of TBitmap.handle!!!!
-    LM_SCREENINIT:
-    Begin
-      if Sender=nil then Handle := GetDesktopWindow
-      else Handle := ObjectToHwnd(Sender);
-      DC := Windows.GetDC(Handle);
-      //WriteLn('LM_SCREENINIT called --> should go to TWin32WidgetSet.Init');
-      //WriteLn('TODO: check this');
-      PLMScreenInit(Data)^.PixelsPerInchX := GetDeviceCaps(DC, LogPixelsX);
-      PLMScreenInit(Data)^.PixelsPerInchY := GetDeviceCaps(DC, LogPixelsY);
-      PLMScreenInit(Data)^.ColorDepth := GetDeviceCaps(DC, BitsPixel);
-      ReleaseDC(Handle, DC);
-    End;
   Else
   Begin
     Handle := ObjectToHWND(Sender);
@@ -2072,6 +2069,9 @@ End;
 
 {
   $Log$
+  Revision 1.272  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.271  2004/09/17 10:56:25  micha
   convert LM_SHORTCUT message to interface methods
 

lcl/lcltype.pp

@@ -845,6 +845,13 @@ type
   TNMHdr = tagNMHDR;
   NMHDR = tagNMHDR;
 
+  PScreenInfo = ^TScreenInfo;
+  TScreenInfo = record
+    PixelsPerInchX : Integer;
+    PixelsPerInchY : Integer;
+    ColorDepth : Integer;
+  end;
+
 {painting stuff}
 
   PDrawItemStruct = ^TDrawItemStruct;
@@ -2241,6 +2248,9 @@ end.
 
 {
   $Log$
+  Revision 1.67  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.66  2004/09/02 09:16:59  mattias
   improved double byte char fonts for gtk1, started synedit UTF8 support
 

lcl/lmessages.pp

@@ -138,7 +138,6 @@ const
   //LM_MOUSEBTNPRESS  = LM_USER+41;
   //LM_MOUSEBTNRELEASE  = LM_USER+42;
   LM_EXIT           = LM_USER+60;
-  LM_SCREENINIT     = LM_USER+61;
   LM_CLOSEQUERY     = LM_USER+62;
   LM_DRAGSTART      = LM_USER+63;
   LM_DEACTIVATE     = LM_USER+64;  //used when a form is no longer in front
@@ -339,14 +338,6 @@ type
   TLMNoParams = TWMNoParams;
 {$endif}
 
-  TLMScreenInit = record
-    PixelsPerInchX : Integer;
-    PixelsPerInchY : Integer;
-    ColorDepth : Integer;
-  end;
-
-  PLMScreenInit = ^TLMScreenInit;
-
   TLMCanvasCreate = Record
      pparent : Pointer;
      pCanvas : Pointer;
@@ -869,7 +860,6 @@ begin
   //LM_MOUSEBTNPRESS  :Result:='LM_MOUSEBTNPRESS';
   //LM_MOUSEBTNRELEASE  :Result:='LM_MOUSEBTNRELEASE';
   LM_EXIT           :Result:='LM_EXIT';
-  LM_SCREENINIT     :Result:='LM_SCREENINIT';
   LM_CLOSEQUERY     :Result:='LM_CLOSEQUERY';
   LM_DRAGSTART      :Result:='LM_DRAGSTART';
   LM_DEACTIVATE     :Result:='LM_DEACTIVATE';
@@ -911,6 +901,9 @@ end.
 
 {
   $Log$
+  Revision 1.111  2004/09/18 10:52:48  micha
+  convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)
+
   Revision 1.110  2004/09/17 10:56:24  micha
   convert LM_SHORTCUT message to interface methods