mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-15 15:10:47 +01:00
LCL: task dialog: high-DPI support
This commit is contained in:
Ondrej Pokorny
parent
a3b65673ed
commit
49647626a5
@ -127,12 +127,12 @@ interface
|
||||
|
||||
uses
|
||||
{$IFDEF MSWINDOWS}
|
||||
Windows,
|
||||
Windows, ctypes,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils,
|
||||
LazUTF8,
|
||||
LCLType, LCLStrConsts, LCLIntf, InterfaceBase,
|
||||
LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons;
|
||||
LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList,
|
||||
LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, DialogRes;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
var
|
||||
@ -415,9 +415,7 @@ function DefaultFont: TFont;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Dialogs,
|
||||
ImgList;
|
||||
Function LoadIconWithScaleDown( hinst:HINST; pszName:LPCWStr;cx:cint;cy:cint;var phico: HICON ):HRESULT; stdcall; external 'comctl32.dll' name 'LoadIconWithScaleDown';
|
||||
|
||||
var
|
||||
LDefaultFont: TFont;
|
||||
@ -458,7 +456,6 @@ begin
|
||||
cbCancel: result := @rsMbCancel;
|
||||
cbRetry: result := @rsMbRetry;
|
||||
cbClose: result := @rsMbClose;
|
||||
else result := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -495,37 +492,16 @@ end;
|
||||
|
||||
|
||||
const
|
||||
LAZ_ICONS: array[TTaskDialogIcon] of string = (
|
||||
'', 'dialog_warning', 'dialog_confirmation', 'dialog_error', 'dialog_information', '', 'dialog_shield');
|
||||
LAZ_FOOTERICONS: array[TTaskDialogFooterIcon] of string = (
|
||||
'', 'dialog_warning', 'dialog_confirmation', 'dialog_error', 'dialog_information', 'dialog_shield');
|
||||
LCL_IMAGES: array[TTaskDialogIcon] of Integer = (
|
||||
0, idDialogWarning, idDialogConfirm, idDialogError, idDialogInfo, 0, idDialogShield);
|
||||
LCL_FOOTERIMAGES: array[TTaskDialogFooterIcon] of Integer = (
|
||||
0, idDialogWarning, idDialogConfirm, idDialogError, idDialogInfo, idDialogShield);
|
||||
{$IFDEF MSWINDOWS}
|
||||
const
|
||||
{$EXTERNALSYM IDI_HAND}
|
||||
IDI_HAND = MakeIntResource(32513);
|
||||
{$EXTERNALSYM IDI_QUESTION}
|
||||
IDI_QUESTION = MakeIntResource(32514);
|
||||
{$EXTERNALSYM IDI_EXCLAMATION}
|
||||
IDI_EXCLAMATION = MakeIntResource(32515);
|
||||
{$EXTERNALSYM IDI_ASTERISK}
|
||||
IDI_ASTERISK = MakeIntResource(32516);
|
||||
{$EXTERNALSYM IDI_WINLOGO}
|
||||
IDI_WINLOGO = MakeIntResource(32517);
|
||||
{$EXTERNALSYM IDI_WARNING}
|
||||
IDI_WARNING = IDI_EXCLAMATION;
|
||||
{$EXTERNALSYM IDI_ERROR}
|
||||
IDI_ERROR = IDI_HAND;
|
||||
{$EXTERNALSYM IDI_INFORMATION}
|
||||
IDI_INFORMATION = IDI_ASTERISK;
|
||||
|
||||
TD_ICONS: array[TTaskDialogIcon] of integer = (
|
||||
0, 84, 99, 98, 81, 0, 78);
|
||||
TD_FOOTERICONS: array[TTaskDialogFooterIcon] of integer = (
|
||||
0, 84, 99, 98, 65533, 65532);
|
||||
WIN_ICONS: array[TTaskDialogIcon] of PChar = (
|
||||
nil, IDI_WARNING, IDI_QUESTION, IDI_ERROR, IDI_INFORMATION, nil, nil);
|
||||
WIN_FOOTERICONS: array[TTaskDialogFooterIcon] of PChar = (
|
||||
nil, IDI_WARNING, IDI_QUESTION, IDI_ERROR, IDI_INFORMATION, nil);
|
||||
{$ENDIF MSWINDOWS}
|
||||
|
||||
function IconMessage(Icon: TTaskDialogIcon): string;
|
||||
@ -654,7 +630,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
var aHint: string;
|
||||
var
|
||||
aHint: string;
|
||||
|
||||
function NoCR(const aText: string): string;
|
||||
var i: integer;
|
||||
@ -673,7 +650,8 @@ var RU: array of Ws;
|
||||
RUCount: integer;
|
||||
But: array of TTASKDIALOG_BUTTON;
|
||||
procedure AddRU(Text: string; var n: integer; firstID: integer);
|
||||
var P: PChar;
|
||||
var
|
||||
P: PChar;
|
||||
begin
|
||||
if Text='' then
|
||||
exit;
|
||||
@ -694,18 +672,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
{$IFDEF MSWINDOWS}
|
||||
Config: TTASKDIALOGCONFIG;
|
||||
{$ENDIF}
|
||||
Pic: TPortableNetworkGraphic;
|
||||
Ico: TIcon;
|
||||
Bmp: TBitmap;
|
||||
i, X, Y, XB, IconBorder, FontHeight: integer;
|
||||
Par: TWinControl;
|
||||
Panel: TPanel;
|
||||
CurrTabOrder: TTabOrder;
|
||||
Image: TImage;
|
||||
Image: TImageListImage;
|
||||
List: TStrings;
|
||||
B: TCommonButton;
|
||||
CommandLink: TBitBtn;
|
||||
@ -717,7 +693,6 @@ var R: TRect;
|
||||
begin
|
||||
result := TLabel.Create(Dialog.Form);
|
||||
result.Parent := Par;
|
||||
result.Font.PixelsPerInch := 96;
|
||||
result.WordWrap := true;
|
||||
if BigFont then begin
|
||||
if aEmulateClassicStyle then begin
|
||||
@ -743,7 +718,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure AddBevel;
|
||||
var BX: integer;
|
||||
var
|
||||
BX: integer;
|
||||
begin
|
||||
with TBevel.Create(Dialog.Form) do begin
|
||||
Parent := Par;
|
||||
@ -756,7 +732,8 @@ begin
|
||||
end;
|
||||
|
||||
function AddButton(const s: string; ModalResult: integer): TButton;
|
||||
var WB: integer;
|
||||
var
|
||||
WB: integer;
|
||||
begin
|
||||
WB := Dialog.Form.Canvas.TextWidth(s)+52;
|
||||
dec(XB,WB);
|
||||
@ -766,7 +743,6 @@ begin
|
||||
end;
|
||||
result := TButton.Create(Dialog.Form);
|
||||
result.Parent := Par;
|
||||
result.Font.PixelsPerInch := 96;
|
||||
if aEmulateClassicStyle then
|
||||
result.SetBounds(XB,Y,WB-10,22)
|
||||
else
|
||||
@ -787,49 +763,8 @@ begin
|
||||
Dialog.Form.ActiveControl := result;
|
||||
end;
|
||||
|
||||
procedure AddImages(AImgList: TCustomImageList; AResName: String);
|
||||
var
|
||||
img100, img150, img200: TCustomBitmap;
|
||||
begin
|
||||
img100 := TPortableNetworkGraphic.Create;
|
||||
img150 := TPortableNetworkGraphic.Create;
|
||||
img200 := TPortableNetworkGraphic.Create;
|
||||
try
|
||||
img100.LoadFromResourceName(HInstance, AResName);
|
||||
img150.LoadFromResourceName(HInstance, AResName + '_150');
|
||||
img200.LoadFromResourceName(HInstance, AResName + '_200');
|
||||
AImgList.AddMultipleResolutions([img100, img150, img200]);
|
||||
finally
|
||||
img100.Free;
|
||||
img150.Free;
|
||||
img200.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
imgList: TLCLGlyphs;
|
||||
|
||||
procedure PrepareImages;
|
||||
var
|
||||
di: TTaskDialogIcon;
|
||||
begin
|
||||
imgList := TLCLGlyphs.Create(Dialog.Form);
|
||||
imgList.MissingResources := gmrOneMustExist;
|
||||
imgList.Scaled := true;
|
||||
imgList.Width := 32;
|
||||
imgList.Height := 32;
|
||||
imgList.RegisterResolutions([16, 24, 32, 48, 64]);
|
||||
for di in TTaskDialogIcon do
|
||||
if LAZ_ICONS[di] <> '' then
|
||||
AddImages(imgList, LAZ_ICONS[di]);
|
||||
// Since footer icons use the same image resources we do not add them again.
|
||||
end;
|
||||
|
||||
var
|
||||
IconHandle: HICON;
|
||||
ARadioOffset: integer;
|
||||
imgIndex: Integer;
|
||||
imgRes: TScaledImageListResolution;
|
||||
begin
|
||||
if (byte(aCommonButtons)=0) and (Buttons='') then begin
|
||||
aCommonButtons := [cbOk];
|
||||
@ -896,7 +831,7 @@ begin
|
||||
Dialog.Form.Owner := @Self;
|
||||
|
||||
// initialize form properties
|
||||
Dialog.Form.PixelsPerInch := 96; // for scaling later
|
||||
Dialog.Form.PixelsPerInch := 96; // we are using 96 PPI in the code, scale it automatically at ShowModal
|
||||
Dialog.Form.Font.PixelsPerInch := 96;
|
||||
Dialog.Form.BorderStyle := bsDialog;
|
||||
if tdfAllowDialogCancellation in aFlags then
|
||||
@ -922,10 +857,6 @@ begin
|
||||
Dialog.Form.ClientWidth := aWidth;
|
||||
Dialog.Form.Height := 200;
|
||||
Dialog.Form.Caption := Title;
|
||||
|
||||
// Prepare image list
|
||||
PrepareImages;
|
||||
|
||||
// create a white panel for the main dialog part
|
||||
Panel := TPanel.Create(Dialog.Form);
|
||||
Panel.Parent := Dialog.Form;
|
||||
@ -943,35 +874,13 @@ begin
|
||||
else
|
||||
IconBorder := 24;
|
||||
|
||||
if (LAZ_ICONS[aDialogIcon]<>'') {$IFDEF MSWINDOWS}or
|
||||
((WidgetSet.GetLCLCapability(lcNativeTaskDialog) = LCL_CAPABILITY_YES) and (WIN_ICONS[aDialogIcon]<>nil)){$ENDIF} then
|
||||
if (LCL_IMAGES[aDialogIcon]<>0) then
|
||||
begin
|
||||
Image := TImage.Create(Dialog.Form);
|
||||
Image := TImageListImage.Create(Dialog.Form);
|
||||
Image.Parent := Par;
|
||||
{$IFDEF MSWINDOWS}
|
||||
if (WidgetSet.GetLCLCapability(lcNativeTaskDialog) = LCL_CAPABILITY_YES) and
|
||||
(WIN_ICONS[aDialogIcon]<>nil) then
|
||||
IconHandle := LoadIcon(0,WIN_ICONS[aDialogIcon])
|
||||
else
|
||||
IconHandle := 0;
|
||||
{$ELSE}
|
||||
IconHandle := 0;
|
||||
{$ENDIF}
|
||||
if IconHandle<>0 then
|
||||
Image.Picture.Icon.Handle := IconHandle
|
||||
else if LAZ_ICONS[aDialogIcon]<>'' then
|
||||
begin
|
||||
imgRes := imgList.ResolutionForPPI[32, Screen.PixelsPerInch, Dialog.Form.GetCanvasScaleFactor];
|
||||
imgIndex := imgList.GetImageIndex(LAZ_ICONS[aDialogIcon]);
|
||||
Pic := TPortableNetworkGraphic.Create;
|
||||
try
|
||||
imgRes.GetBitmap(imgIndex, Pic);
|
||||
Image.Picture.Assign(Pic);
|
||||
finally
|
||||
Pic.Free;
|
||||
end;
|
||||
end;
|
||||
Image.SetBounds(IconBorder,IconBorder,Image.Picture.Icon.Width,Image.Picture.Icon.Height);
|
||||
Image.Images := GetDialogImages;
|
||||
Image.ImageIndex := GetDialogImages.DialogIndexes[LCL_IMAGES[aDialogIcon]];
|
||||
Image.SetBounds(IconBorder,IconBorder, 32, 32);
|
||||
X := Image.Width+IconBorder*2;
|
||||
Y := Image.Top;
|
||||
if aEmulateClassicStyle then
|
||||
@ -1011,6 +920,7 @@ begin
|
||||
Rad[i] := TRadioButton.Create(Dialog.Form);
|
||||
with Rad[i] do begin
|
||||
Parent := Par;
|
||||
AutoSize := False;
|
||||
SetBounds(X+16,Y,aWidth-32-X, (6-FontHeight) + ARadioOffset);
|
||||
Caption := NoCR(Strings[i]);
|
||||
if aHint<>'' then begin
|
||||
@ -1065,8 +975,8 @@ begin
|
||||
end;
|
||||
if not (tdfUseCommandLinksNoIcon in aFlags) then
|
||||
begin
|
||||
Images := imgList;
|
||||
ImageIndex := imgList.GetImageIndex('btn_arrowright');
|
||||
Images := LCLGlyphs;
|
||||
ImageIndex := LCLGlyphs.GetImageIndex('btn_arrowright');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1158,62 +1068,15 @@ begin
|
||||
AddBevel
|
||||
else
|
||||
inc(Y,16);
|
||||
if (LAZ_FOOTERICONS[aFooterIcon]<>'') {$IFDEF MSWINDOWS}or ((WidgetSet.GetLCLCapability(lcNativeTaskDialog) = LCL_CAPABILITY_YES) and (WIN_FOOTERICONS[aFooterIcon]<>nil)){$ENDIF} then
|
||||
if (LCL_FOOTERIMAGES[aFooterIcon]<>0) then
|
||||
begin
|
||||
Image := TImage.Create(Dialog.Form);
|
||||
Image := TImageListImage.Create(Dialog.Form);
|
||||
Image.Parent := Par;
|
||||
Pic := nil;
|
||||
Ico := nil;
|
||||
Bmp := TBitmap.Create;
|
||||
try
|
||||
Bmp.Transparent := true;
|
||||
{$IFDEF MSWINDOWS}
|
||||
if (WIN_FOOTERICONS[aFooterIcon]<>nil) and (WidgetSet.GetLCLCapability(lcNativeTaskDialog) = LCL_CAPABILITY_YES) then
|
||||
begin
|
||||
IconHandle := LoadIcon(0,WIN_FOOTERICONS[aFooterIcon]);
|
||||
if IconHandle<>0 then
|
||||
begin
|
||||
Ico := TIcon.Create;
|
||||
Ico.Handle := IconHandle;
|
||||
Bmp.Width := Ico.Width shr 1;
|
||||
Bmp.Height := Ico.Height shr 1;
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
if (Ico=nil) and (LAZ_FOOTERICONS[aFooterIcon]<>'') then
|
||||
begin
|
||||
Pic := TPortableNetworkGraphic.Create;
|
||||
imgIndex := imgList.GetImageIndex(LAZ_FOOTERICONS[aFooterIcon]);
|
||||
imgRes := imgList.ResolutionForPPI[16, Screen.PixelsPerInch, Dialog.Form.GetCanvasScaleFactor];
|
||||
imgRes.GetBitmap(imgIndex, Pic);
|
||||
Bmp.Width := Pic.Width;
|
||||
Bmp.Height := Pic.Height;
|
||||
end;
|
||||
if (Ico<>nil) or (Pic<>nil) then
|
||||
begin
|
||||
Bmp.Canvas.Brush.Color := Dialog.Form.Color;
|
||||
if Bmp.Canvas.Brush.Color = clDefault then
|
||||
Bmp.Canvas.Brush.Color := clBtnFace;
|
||||
Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
|
||||
if Pic<>nil then
|
||||
Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), Pic)
|
||||
else
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
if (WidgetSet.GetLCLCapability(lcNativeTaskDialog) = LCL_CAPABILITY_YES) then
|
||||
DrawIconEx(Bmp.Canvas.Handle,0,0,Ico.Handle,Bmp.Width,Bmp.Height,0,
|
||||
Bmp.Canvas.Brush.{%H-}Handle,DI_NORMAL);
|
||||
{$ENDIF}
|
||||
end;
|
||||
Image.Picture.Bitmap := Bmp;
|
||||
Image.SetBounds(24,Y,Bmp.Width,Bmp.Height);
|
||||
X := 40+Bmp.Width;
|
||||
end;
|
||||
finally
|
||||
Bmp.Free;
|
||||
Pic.Free;
|
||||
Ico.Free;
|
||||
end;
|
||||
Image.Images := GetDialogImages;
|
||||
Image.ImageWidth := 16;
|
||||
Image.ImageIndex := GetDialogImages.DialogIndexes[LCL_FOOTERIMAGES[aFooterIcon]];
|
||||
Image.SetBounds(24,Y,16,16);
|
||||
X := 40+Image.Width;
|
||||
end else
|
||||
begin
|
||||
X := 24;
|
||||
@ -1236,13 +1099,7 @@ begin
|
||||
if Assigned(Dialog.Form.PopupParent) then
|
||||
Dialog.Form.PopupMode := pmExplicit;
|
||||
|
||||
|
||||
// Scale the dialog
|
||||
// Dialog.Form.AutoAdjustLayout(lapAutoAdjustForDPI, 96, Screen.PixelsPerInch, 0, 0);
|
||||
Dialog.Form.AutoScale;
|
||||
|
||||
// retrieve the results
|
||||
|
||||
// show the dialog - it will scale automatically in ShowModal
|
||||
result := Dialog.Form.ShowModal;
|
||||
if Dialog.Form.Combo<>nil then begin
|
||||
SelectionRes := Dialog.Form.Combo.ItemIndex;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user