diff --git a/lcl/graphics.pp b/lcl/graphics.pp index cb754185da..0c37758fd5 100644 --- a/lcl/graphics.pp +++ b/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 diff --git a/lcl/include/application.inc b/lcl/include/application.inc index ae6e855634..522ca3b0b2 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -245,8 +245,7 @@ begin DebugLn('ERROR: ',rsNoInterfaceObject); raise Exception.Create(rsNoInterfaceObject); end; - InterfaceObject.AppInit; - CNSendMessage(LM_SCREENINIT, nil, @ScreenInfo); + InterfaceObject.AppInit(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 diff --git a/lcl/interfacebase.pp b/lcl/interfacebase.pp index 19c426ce0e..792904643b 100644 --- a/lcl/interfacebase.pp +++ b/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) diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 371a6d59d9..55e456ee74 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/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 diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index 51f2699cdd..c868467033 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/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 diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index 61b9ab0ce4..40f51953de 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/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 diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 18aabfd1fb..542bc631fd 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -124,19 +124,21 @@ End; Initialize Windows ------------------------------------------------------------------------------} -Procedure TWin32WidgetSet.AppInit; -Var +procedure TWin32WidgetSet.AppInit(var ScreenInfo: TScreenInfo); +var + ICC: TINITCOMMONCONTROLSEX; LogBrush: TLOGBRUSH; SysMenu: HMENU; - ICC: TINITCOMMONCONTROLSEX; -Begin + Handle: HWND; + DC: HDC; +begin Assert(False, 'Trace:Win32Object.Init - Start'); - If Not WinRegister then - Begin + if not WinRegister then + 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 diff --git a/lcl/lcltype.pp b/lcl/lcltype.pp index f683f48bac..42436c50d6 100644 --- a/lcl/lcltype.pp +++ b/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 diff --git a/lcl/lmessages.pp b/lcl/lmessages.pp index cf56a168e0..f913b8b227 100644 --- a/lcl/lmessages.pp +++ b/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