paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 09:50:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TPromptDialog: high-DPI

Browse Source 
git-svn-id: trunk@55531 -
This commit is contained in:
ondrej 2017-07-18 18:07:39 +00:00
parent 3d5bee5c9c
commit 090c69df0e
1 changed files with 29 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
lcl/include/promptdialog.inc
View File

@ -17,6 +17,9 @@ type
private
FCancelKind: TBitBtnKind;
function CreateButtons(AVerticalLayout: Boolean; ASpacing: Integer): Integer;
protected
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
public
IsSmallDevice: Boolean;
@ -92,22 +95,26 @@ end;
procedure TPromptDialog.Paint;
var
UseMaskHandle: HBitmap;
ATextStyle: TTextStyle;
begin
inherited Paint;
// Draws the text
Canvas.Font := Font;
Canvas.Font.PixelsPerInch := Font.PixelsPerInch;
Canvas.Brush := Brush;
Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MSG, TextStyle);
ATextStyle := TextStyle;
if Canvas.Font.PixelsPerInch<>Screen.PixelsPerInch then
ATextStyle.SystemFont := False;
Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MSG, ATextStyle);
// Draws the icon
if Assigned (FBitmap) and not IsSmallDevice then
begin
UseMaskHandle := FBitmap.MaskHandle;
MaskBlt(Canvas.GetUpdatedHandle([csHandleValid]),
cBitmapX, cBitmapY, FBitmap.Width, FBitmap.Height,
FBitmap.Canvas.GetUpdatedHandle([csHandleValid]),
0, 0, UseMaskHandle, 0, 0);
Canvas.StretchDraw(
Rect(cBitmapX, cBitmapY, cBitmapX+ScaleScreenToFont(FBitmap.Width), cBitmapY+ScaleScreenToFont(FBitmap.Height)),
FBitmap);
end;
end;
@ -205,6 +212,21 @@ begin
inherited destroy;
end;
procedure TPromptDialog.DoAutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy; const AXProportion,
AYProportion: Double);
begin
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
TextBox.Left := Round(TextBox.Left*AXProportion);
TextBox.Top := Round(TextBox.Top*AYProportion);
TextBox.Right := Round(TextBox.Right*AXProportion);
TextBox.Bottom := Round(TextBox.Bottom*AYProportion);
end;
end;
function TPromptDialog.GetMessageText: string;
begin
Result := MSG;