paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 21:48:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TPromptDialog: support ChangeScale

Browse Source 
git-svn-id: trunk@55533 -
This commit is contained in:
ondrej 2017-07-18 19:05:01 +00:00
parent c4c7fec236
commit 382b5e3ee7
1 changed files with 19 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lcl/include/promptdialog.inc
View File

@ -20,6 +20,8 @@ type
protected
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
procedure ChangeScale(Multiplier, Divider: Integer); override;
procedure FontChanged(Sender: TObject); override;
public
IsSmallDevice: Boolean;
@ -206,6 +208,16 @@ begin
LayoutDialog;
end;
procedure TPromptDialog.ChangeScale(Multiplier, Divider: Integer);
begin
inherited ChangeScale(Multiplier, Divider);
TextBox.Left := MulDiv(TextBox.Left, Multiplier, Divider);
TextBox.Top := MulDiv(TextBox.Top, Multiplier, Divider);
TextBox.Right := MulDiv(TextBox.Right, Multiplier, Divider);
TextBox.Bottom := MulDiv(TextBox.Bottom, Multiplier, Divider);
end;
destructor TPromptDialog.Destroy;
begin
FBitmap.Free;
@ -227,6 +239,13 @@ begin
end;
end;
procedure TPromptDialog.FontChanged(Sender: TObject);
begin
inherited FontChanged(Sender);
TextStyle.SystemFont := False;
end;
function TPromptDialog.GetMessageText: string;
begin
Result := MSG;