paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-31 06:12:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@6025 -
This commit is contained in:
micha 2004-09-18 10:52:48 +00:00
parent a73fcef8dd
commit f0eb9c47ac
9 changed files with 64 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/graphics.pp
View File

@ -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

6
lcl/include/application.inc
View File

@ -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

5
lcl/interfacebase.pp
View File

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

5
lcl/interfaces/gtk/gtkint.pp
View File

@ -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

21
lcl/interfaces/gtk/gtkobject.inc
View File

@ -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

5
lcl/interfaces/win32/win32int.pp
View File

@ -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

42
lcl/interfaces/win32/win32object.inc
View File

@ -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

10
lcl/lcltype.pp
View File

@ -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

13
lcl/lmessages.pp
View File

@ -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