paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 21:30:35 +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;
FShowInTaskbar: TShowInTaskbar;
FWindowState: TWindowState;
function GetPixelsPerInch: Longint;
function IsForm : Boolean;
function IsHelpFileStored: boolean;
function IsIconStored: Boolean;
@ -536,7 +537,7 @@ type
property OnShow: TNotifyEvent read FOnShow write FOnShow;
property OnWindowStateChange: TNotifyEvent
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 RestoredLeft: integer read FRestoredLeft;
property RestoredTop: integer read FRestoredTop;

46
lcl/include/customform.inc
View File

@ -1300,15 +1300,10 @@ Begin
ParentColor := False;
ParentFont := False;
Ctl3D := True;
// FBorderIcons := [biSystemMenu, biMinimize, biMaximize];
FWindowState := wsNormal;
// FDefaultMonitor := dmActiveForm;
FIcon := TIcon.Create;
// FInCMParentBiDiModeChanged := False;
FKeyPreview := False;
Color := clBtnFace;
// FPixelsPerInch := Screen.PixelsPerInch;
// FPrintScale := poProportional;
FloatingDockSiteClass := TWinControlClass(ClassType);
Screen.AddForm(Self);
EndFormUpdate;
@ -1450,6 +1445,32 @@ begin
Result := True;
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;
------------------------------------------------------------------------------}
@ -1611,25 +1632,12 @@ end;
Creates the interface object.
------------------------------------------------------------------------------}
procedure TCustomForm.CreateWnd;
var
DC: HDC;
ParentForm: TCustomForm;
begin
//DebugLn('TCustomForm.CreateWnd START ',ClassName);
FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged];
inherited CreateWnd;
if Parent=nil then begin
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;
FPixelsPerInch:=0;
Assert(False, 'Trace:[TCustomForm.CreateWnd] FMenu.HandleNeeded');
if FMenu <> nil then