paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 13:20:21 +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 private
FCancelKind: TBitBtnKind; FCancelKind: TBitBtnKind;
function CreateButtons(AVerticalLayout: Boolean; ASpacing: Integer): Integer; function CreateButtons(AVerticalLayout: Boolean; ASpacing: Integer): Integer;
protected
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
public public
IsSmallDevice: Boolean; IsSmallDevice: Boolean;
@ -92,22 +95,26 @@ end;
procedure TPromptDialog.Paint; procedure TPromptDialog.Paint;
var var
UseMaskHandle: HBitmap; ATextStyle: TTextStyle;
begin begin
inherited Paint; inherited Paint;
// Draws the text // Draws the text
Canvas.Font := Font;
Canvas.Font.PixelsPerInch := Font.PixelsPerInch;
Canvas.Brush := Brush; 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 // Draws the icon
if Assigned (FBitmap) and not IsSmallDevice then if Assigned (FBitmap) and not IsSmallDevice then
begin begin
UseMaskHandle := FBitmap.MaskHandle; Canvas.StretchDraw(
MaskBlt(Canvas.GetUpdatedHandle([csHandleValid]), Rect(cBitmapX, cBitmapY, cBitmapX+ScaleScreenToFont(FBitmap.Width), cBitmapY+ScaleScreenToFont(FBitmap.Height)),
cBitmapX, cBitmapY, FBitmap.Width, FBitmap.Height, FBitmap);
FBitmap.Canvas.GetUpdatedHandle([csHandleValid]),
0, 0, UseMaskHandle, 0, 0);
end; end;
end; end;
@ -205,6 +212,21 @@ begin
inherited destroy; inherited destroy;
end; 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; function TPromptDialog.GetMessageText: string;
begin begin
Result := MSG; Result := MSG;