paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 20:56:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: forms: highDPI: set DesignTimeDPI automatically by the IDE, don't allow to change it manually.

Browse Source 
git-svn-id: trunk@53497 -
This commit is contained in:
ondrej 2016-11-30 23:27:37 +00:00
parent fae72cb0a7
commit 4bccf7cae5
3 changed files with 14 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/forms.pp
View File

@ -471,6 +471,7 @@ type
procedure SetAlphaBlend(const AValue: Boolean); procedure SetAlphaBlend(const AValue: Boolean);
procedure SetAlphaBlendValue(const AValue: Byte); procedure SetAlphaBlendValue(const AValue: Byte);
procedure SetBorderIcons(NewIcons: TBorderIcons); procedure SetBorderIcons(NewIcons: TBorderIcons);
procedure SetDesignTimeDPI(const aDesignTimeDPI: Integer);
procedure SetFormBorderStyle(NewStyle: TFormBorderStyle); procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
procedure SetCancelControl(NewControl: TControl); procedure SetCancelControl(NewControl: TControl);
procedure SetDefaultControl(NewControl: TControl); procedure SetDefaultControl(NewControl: TControl);
@ -659,7 +660,7 @@ type
property DefaultMonitor: TDefaultMonitor read FDefaultMonitor property DefaultMonitor: TDefaultMonitor read FDefaultMonitor
write FDefaultMonitor default dmActiveForm; write FDefaultMonitor default dmActiveForm;
property Designer: TIDesigner read FDesigner write FDesigner; property Designer: TIDesigner read FDesigner write FDesigner;
property DesignTimeDPI: Integer read FDesignTimeDPI write FDesignTimeDPI; property DesignTimeDPI: Integer read FDesignTimeDPI write SetDesignTimeDPI;
property EffectiveShowInTaskBar: TShowInTaskBar read GetEffectiveShowInTaskBar; property EffectiveShowInTaskBar: TShowInTaskBar read GetEffectiveShowInTaskBar;
property FormState: TFormState read FFormState; property FormState: TFormState read FFormState;
property FormStyle: TFormStyle read FFormStyle write SetFormStyle property FormStyle: TFormStyle read FFormStyle write SetFormStyle
@ -753,6 +754,7 @@ type
property Color; property Color;
property Constraints; property Constraints;
property DefaultMonitor; property DefaultMonitor;
property DesignTimeDPI;
property DockSite; property DockSite;
property DragKind; property DragKind;
property DragMode; property DragMode;

10
lcl/include/customform.inc
View File

@ -347,6 +347,14 @@ begin
end; end;
end; end;
procedure TCustomForm.SetDesignTimeDPI(const aDesignTimeDPI: Integer);
begin
if not (csLoading in ComponentState) then
raise EInvalidOperation.Create(sCannotSetDesignTimeDPI);
FDesignTimeDPI := aDesignTimeDPI;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Method: TCustomForm.SetIcon Method: TCustomForm.SetIcon
Params: the new icon Params: the new icon
@ -2680,6 +2688,8 @@ begin
//DebugLn('TCustomForm.Loaded ',Name,':',ClassName,' ',FormUpdating,' ',fsCreating in FFormState,' ',Visible,' ',fsVisible in FormState); //DebugLn('TCustomForm.Loaded ',Name,':',ClassName,' ',FormUpdating,' ',fsCreating in FFormState,' ',Visible,' ',fsVisible in FormState);
if fsVisible in FormState then if fsVisible in FormState then
Visible := True; Visible := True;
if csDesigning in ComponentState then
FDesignTimeDPI := Screen.PixelsPerInch;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------

1
lcl/lclstrconsts.pas
View File

@ -217,6 +217,7 @@ resourceString
sInvalidImageSize = 'Invalid image size'; sInvalidImageSize = 'Invalid image size';
sDuplicateMenus = 'Duplicate menus'; sDuplicateMenus = 'Duplicate menus';
sCannotFocus = 'Cannot focus a disabled or invisible window'; sCannotFocus = 'Cannot focus a disabled or invisible window';
sCannotSetDesignTimeDPI = 'Cannot set design time DPI.';
sParentRequired = 'Control "%s" has no parent window.'; sParentRequired = 'Control "%s" has no parent window.';
sInvalidCharSet = 'The char set in mask "%s" is not valid!'; sInvalidCharSet = 'The char set in mask "%s" is not valid!';
SMaskEditNoMatch = 'The current text does not match the specified mask.'; SMaskEditNoMatch = 'The current text does not match the specified mask.';