paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-23 05:19:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

reduced overhead getting PixelsPerInch

Browse Source 
git-svn-id: trunk@8155 -
This commit is contained in:
mattias 2005-11-14 22:12:49 +00:00
parent f7260e298d
commit 21e9c81a84
2 changed files with 29 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/forms.pp
View File

@ -387,6 +387,7 @@ type
FRestoredHeight: integer; FRestoredHeight: integer;
FShowInTaskbar: TShowInTaskbar; FShowInTaskbar: TShowInTaskbar;
FWindowState: TWindowState; FWindowState: TWindowState;
function GetPixelsPerInch: Longint;
function IsForm : Boolean; function IsForm : Boolean;
function IsHelpFileStored: boolean; function IsHelpFileStored: boolean;
function IsIconStored: Boolean; function IsIconStored: Boolean;
@ -536,7 +537,7 @@ type
property OnShow: TNotifyEvent read FOnShow write FOnShow; property OnShow: TNotifyEvent read FOnShow write FOnShow;
property OnWindowStateChange: TNotifyEvent property OnWindowStateChange: TNotifyEvent
read fOnWindowStateChange write fOnWindowStateChange; read fOnWindowStateChange write fOnWindowStateChange;
property PixelsPerInch: Longint read FPixelsPerInch write FPixelsPerInch stored False; property PixelsPerInch: Longint read GetPixelsPerInch write FPixelsPerInch stored False;
property Position: TPosition read FPosition write SetPosition default poDesigned; property Position: TPosition read FPosition write SetPosition default poDesigned;
property RestoredLeft: integer read FRestoredLeft; property RestoredLeft: integer read FRestoredLeft;
property RestoredTop: integer read FRestoredTop; property RestoredTop: integer read FRestoredTop;

46
lcl/include/customform.inc
View File

@ -1300,15 +1300,10 @@ Begin
ParentColor := False; ParentColor := False;
ParentFont := False; ParentFont := False;
Ctl3D := True; Ctl3D := True;
// FBorderIcons := [biSystemMenu, biMinimize, biMaximize];
FWindowState := wsNormal; FWindowState := wsNormal;
// FDefaultMonitor := dmActiveForm;
FIcon := TIcon.Create; FIcon := TIcon.Create;
// FInCMParentBiDiModeChanged := False;
FKeyPreview := False; FKeyPreview := False;
Color := clBtnFace; Color := clBtnFace;
// FPixelsPerInch := Screen.PixelsPerInch;
// FPrintScale := poProportional;
FloatingDockSiteClass := TWinControlClass(ClassType); FloatingDockSiteClass := TWinControlClass(ClassType);
Screen.AddForm(Self); Screen.AddForm(Self);
EndFormUpdate; EndFormUpdate;
@ -1450,6 +1445,32 @@ begin
Result := True; Result := True;
end; end;
function TCustomForm.GetPixelsPerInch: Longint;
var
ParentForm: TCustomForm;
DC: HDC;
begin
if FPixelsPerInch=0 then begin
if Parent<>nil then begin
ParentForm:=GetParentForm(Self);
if ParentForm<>nil then begin
FPixelsPerInch:=ParentForm.PixelsPerInch;
end;
end;
if FPixelsPerInch<=0 then begin
if HandleAllocated then begin
DC:=GetDC(Handle);
FPixelsPerInch:=GetDeviceCaps(DC,LOGPIXELSX);
ReleaseDC(Handle,DC);
end else begin
FPixelsPerInch:=Screen.PixelsPerInch;
end;
end;
end;
Result:=FPixelsPerInch;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
function TCustomForm.IsHelpFileStored: boolean; function TCustomForm.IsHelpFileStored: boolean;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
@ -1611,25 +1632,12 @@ end;
Creates the interface object. Creates the interface object.
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TCustomForm.CreateWnd; procedure TCustomForm.CreateWnd;
var
DC: HDC;
ParentForm: TCustomForm;
begin begin
//DebugLn('TCustomForm.CreateWnd START ',ClassName); //DebugLn('TCustomForm.CreateWnd START ',ClassName);
FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged]; FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged];
inherited CreateWnd; inherited CreateWnd;
if Parent=nil then begin FPixelsPerInch:=0;
TWSCustomFormClass(WidgetSetClass).SetIcon(Self, GetIconHandle);
DC:=GetDC(Handle);
FPixelsPerInch:=GetDeviceCaps(DC,LOGPIXELSX);
ReleaseDC(Handle,DC);
end else begin
ParentForm:=GetParentForm(Self);
if ParentForm<>nil then begin
FPixelsPerInch:=ParentForm.PixelsPerInch;
end;
end;
Assert(False, 'Trace:[TCustomForm.CreateWnd] FMenu.HandleNeeded'); Assert(False, 'Trace:[TCustomForm.CreateWnd] FMenu.HandleNeeded');
if FMenu <> nil then if FMenu <> nil then