mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-19 18:48:15 +02:00
956 lines
27 KiB
PHP
956 lines
27 KiB
PHP
{%MainUnit ../dialogs.pp}
|
|
|
|
{
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
|
|
type
|
|
|
|
{ TPromptDialog }
|
|
|
|
TPromptDialog = class(TForm)
|
|
procedure PromptDialogKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
private
|
|
function CreateButtons(AVerticalLayout: Boolean; ASpacing: Integer
|
|
): Integer;
|
|
public
|
|
IsSmallDevice: Boolean;
|
|
|
|
TheDefaultIndex : Longint;
|
|
|
|
FBitmap: TCustomBitmap;
|
|
MSG : AnsiString;
|
|
NumButtons : Longint;
|
|
Buttons : PLongint;
|
|
|
|
TextBox : TRect;
|
|
TextStyle : TTextStyle;
|
|
|
|
procedure LayoutDialog;
|
|
procedure LayoutDialogSmallDevice;
|
|
procedure Paint; override;
|
|
constructor CreateMessageDialog(const ACaption, aMsg: string;
|
|
DialogType : longint; TheButtons: PLongint; ButtonCount, DefaultIndex : Longint);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
procedure TPromptDialog.PromptDialogKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
var
|
|
OldFocusControl, NewFocusControl: TWinControl;
|
|
i: integer;
|
|
begin
|
|
if (Key=VK_Escape) then
|
|
ModalResult := -1;
|
|
|
|
if (Key=VK_LEFT) or (Key=VK_RIGHT) then begin
|
|
// focus the next button to the left or right
|
|
|
|
// search old focused button
|
|
OldFocusControl:=FindOwnerControl(LCLIntf.GetFocus);
|
|
if (OldFocusControl=nil) or (GetParentForm(OldFocusControl)<>Self)
|
|
or (not (OldFocusControl is TCustomButton)) then
|
|
begin
|
|
OldFocusControl:=nil;
|
|
for i:=0 to ComponentCount-1 do
|
|
if (Components[i] is TCustomButton)
|
|
and (TCustomButton(Components[i]).Default) then
|
|
begin
|
|
OldFocusControl:=TCustomButton(Components[i]);
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
// find next focused button
|
|
if (OldFocusControl<>nil) then begin
|
|
i:=ComponentCount-1;
|
|
while i>=0 do begin
|
|
if Components[i]=OldFocusControl then
|
|
break
|
|
else
|
|
dec(i);
|
|
end;
|
|
if i<0 then exit;
|
|
NewFocusControl:=nil;
|
|
repeat
|
|
if Key=VK_LEFT then begin
|
|
dec(i);
|
|
if i<0 then i:=ComponentCount-1;
|
|
end else begin
|
|
inc(i);
|
|
if i>=ComponentCount then i:=0;
|
|
end;
|
|
if Components[i] is TCustomButton then begin
|
|
NewFocusControl:=TWinControl(Components[i]);
|
|
break;
|
|
end;
|
|
until false;
|
|
ActiveControl:=NewFocusControl;
|
|
Key:=VK_UNKNOWN;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TPromptDialog.CreateButtons(AVerticalLayout: Boolean;
|
|
ASpacing: Integer): Integer;
|
|
var
|
|
curBtn : Longint; // variable to loop through TMsgDlgButtons
|
|
ButtonIndex : integer;
|
|
CurButton: TBitBtn;
|
|
begin
|
|
Result := 0;
|
|
|
|
ButtonIndex := -1;
|
|
for curBtn := 0 to NumButtons - 1 do
|
|
begin
|
|
If (Buttons[curBtn] >= Low(DialogButtonKind)) and
|
|
(Buttons[curBtn] <= High(DialogButtonKind))
|
|
then
|
|
begin
|
|
inc(ButtonIndex);
|
|
|
|
CurButton := TBitBtn.Create(Self);
|
|
with CurButton do
|
|
begin
|
|
Parent:= Self;
|
|
Layout := blGlyphLeft;
|
|
OnKeyDown := @PromptDialogKeyDown;
|
|
|
|
Kind := DialogButtonKind[Buttons[curBtn]];
|
|
|
|
if Height < Glyph.Height + 5 then
|
|
Height := Glyph.Height + 5;
|
|
|
|
if ButtonIndex = TheDefaultIndex then
|
|
Default := true;
|
|
|
|
Inc(Result, ASpacing);
|
|
|
|
if AVerticalLayout then Inc(Result, Height)
|
|
else
|
|
begin
|
|
{ CurBtnSize:=GetButtonSize(CurButton);
|
|
Inc(Result, CurBtnSize.X);}
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPromptDialog.Paint;
|
|
var
|
|
UseMaskHandle: HBitmap;
|
|
begin
|
|
inherited Paint;
|
|
|
|
// Draws the text
|
|
Canvas.Brush := Brush;
|
|
Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MSG, TextStyle);
|
|
|
|
// 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);
|
|
end;
|
|
end;
|
|
|
|
constructor TPromptDialog.CreateMessageDialog(const ACaption, aMsg: string;
|
|
DialogType : longint; TheButtons: PLongint; ButtonCount, DefaultIndex : Longint);
|
|
begin
|
|
inherited Create(nil);
|
|
|
|
IsSmallDevice := (Screen.Width <= 300);
|
|
|
|
AutoScroll:=false;
|
|
OnKeyDown :=@PromptDialogKeyDown;
|
|
//debugln('TPromptDialog.CreateMessageDialog A ButtonCount=',dbgs(ButtonCount));
|
|
|
|
ControlStyle:= ControlStyle-[csSetCaption];
|
|
BorderStyle := bsDialog;
|
|
Position := poScreenCenter;
|
|
SetInitialBounds(0,0,200,100);
|
|
MSG := AMSG;
|
|
Buttons := nil;
|
|
FBitmap := nil;
|
|
case DialogType of
|
|
idDialogConfirm,
|
|
idDialogInfo,
|
|
idDialogWarning,
|
|
idDialogError :
|
|
begin
|
|
FBitmap := GetDialogIcon(DialogType);
|
|
|
|
if ACaption <> '' then
|
|
Caption := ACaption
|
|
else
|
|
Caption := GetDialogCaption(DialogType);
|
|
end;
|
|
else
|
|
begin
|
|
FBitmap := GetDialogIcon(idDialogInfo);
|
|
if ACaption <> '' then
|
|
Caption := ACaption
|
|
else
|
|
Caption := Application.Title;
|
|
end
|
|
end;
|
|
NumButtons := ButtonCount;
|
|
Buttons := TheButtons;
|
|
|
|
if (DefaultIndex >= ButtonCount) or
|
|
(DefaultIndex < 0)
|
|
then
|
|
TheDefaultIndex := 0
|
|
else
|
|
theDefaultIndex := DefaultIndex;
|
|
|
|
// Assures a minimum text size
|
|
if MSG = '' then MSG := ' ';
|
|
|
|
// Initialize TextStyle
|
|
FillChar(TextStyle, SizeOf(TTextStyle), 0);
|
|
|
|
with TextStyle do
|
|
begin
|
|
Clipping := True;
|
|
Wordbreak := True;
|
|
SystemFont := True;
|
|
Opaque := False;
|
|
ShowPrefix := True;
|
|
end;
|
|
|
|
if IsSmallDevice then
|
|
LayoutDialogSmallDevice()
|
|
else
|
|
LayoutDialog();
|
|
end;
|
|
|
|
destructor TPromptDialog.Destroy;
|
|
begin
|
|
FBitmap.Free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
procedure TPromptDialog.LayoutDialog;
|
|
Const
|
|
cBtnCalcWidth = 50;
|
|
cBtnCalcHeight = 13;
|
|
cBtnCalcSpace = 4;
|
|
cBtnCalcBorder = 4;
|
|
cBtnDist = 10;
|
|
var
|
|
curBtn : Longint; // variable to loop through TMsgDlgButtons
|
|
cMinLeft,
|
|
ButtonLeft : integer; // left position of button(s)
|
|
TextLeft : integer; // left position of text
|
|
reqBtnWidth : integer; // width neccessary to display buttons
|
|
reqWidth, reqHeight : integer; // width and height neccessary to display all
|
|
i : integer;
|
|
ButtonIndex : integer;
|
|
MinBtnWidth: Integer; // minimum width for a single button
|
|
MinBtnHeight: Integer; // minimum height for a single button
|
|
CurButton: TBitBtn;
|
|
ButtonTop: Integer;
|
|
CurBtnSize: TPoint;
|
|
|
|
function GetButtonSize(AButton: TBitBtn): TPoint;
|
|
begin
|
|
AButton.HandleNeeded;
|
|
TBitBtnAccess(AButton).CalculatePreferredSize(Result.x, Result.y, True);
|
|
if MinBtnHeight < Result.y then
|
|
MinBtnHeight := Result.y
|
|
else
|
|
if Result.y < MinBtnHeight then
|
|
Result.y := MinBtnHeight;
|
|
if Result.x < MinBtnWidth then
|
|
Result.x := MinBtnWidth;
|
|
end;
|
|
|
|
begin
|
|
// calculate the width & height we need to display the Message
|
|
|
|
// calculate the needed size for the text
|
|
TextBox := Rect(0, 0, Screen.Width div 2, Screen.Height - 100);
|
|
SelectObject(Canvas.Handle, Screen.SystemFont.Reference.Handle);
|
|
DrawText(Canvas.Handle, PChar(MSG), Length(MSG),
|
|
TextBox, DT_WORDBREAK or DT_INTERNAL or DT_CALCRECT);
|
|
|
|
// calculate the width we need to display the buttons
|
|
MinBtnWidth:=Max(25,MinimumDialogButtonWidth);
|
|
MinBtnHeight:=Max(15,MinimumDialogButtonHeight);
|
|
reqBtnWidth := 0;
|
|
|
|
// create the buttons, without positioning
|
|
ButtonIndex := -1;
|
|
for curBtn := 0 to NumButtons - 1 do
|
|
begin
|
|
if (Buttons[curBtn] >= Low(DialogButtonKind)) and
|
|
(Buttons[curBtn] <= High(DialogButtonKind)) then
|
|
begin
|
|
inc(ButtonIndex);
|
|
|
|
CurButton := TBitBtn.Create(Self);
|
|
with CurButton do
|
|
begin
|
|
Parent:= Self;
|
|
Layout := blGlyphLeft;
|
|
OnKeyDown := @PromptDialogKeyDown;
|
|
Kind := DialogButtonKind[Buttons[curBtn]];
|
|
if Height < Glyph.Height + 5 then
|
|
Height := Glyph.Height + 5;
|
|
|
|
if ButtonIndex = TheDefaultIndex then
|
|
Default := true;
|
|
|
|
CurBtnSize:=GetButtonSize(CurButton);
|
|
if reqBtnWidth > 0 then inc(reqBtnWidth, cBtnDist);
|
|
Inc(reqBtnWidth, CurBtnSize.X);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// calculate the minimum text offset from left
|
|
if FBitmap <> nil then
|
|
cMinLeft := cBitmapX + max(32, FBitmap.Width) + cLabelSpacing
|
|
else
|
|
cMinLeft := 0;
|
|
|
|
// calculate required width for the text
|
|
reqWidth := cMinLeft + TextBox.Right;
|
|
|
|
// if buttons require more space than the text, center the text
|
|
// as much as possible
|
|
if reqWidth < reqBtnWidth then
|
|
begin
|
|
reqWidth := reqBtnWidth;
|
|
TextLeft := max(cMinLeft, cLabelSpacing + (reqWidth - TextBox.Right) div 2);
|
|
end
|
|
else
|
|
TextLeft := (cMinLeft + reqWidth - TextBox.Right) div 2;
|
|
|
|
// position the text
|
|
OffsetRect(TextBox, TextLeft, cLabelSpacing);
|
|
|
|
// calculate the height of the text+icon
|
|
reqHeight:= max(TextBox.Bottom, 32);
|
|
if (FBitmap <> nil) and (FBitmap.Height > reqHeight) then
|
|
reqHeight := FBitmap.Height;
|
|
|
|
// set size of form
|
|
SetBounds(Left, Top, reqWidth + 2 * cLabelSpacing,
|
|
3 * cLabelSpacing + reqHeight + MinBtnHeight);
|
|
|
|
// calculate the left of the buttons
|
|
ButtonLeft := ((reqWidth - reqBtnWidth) div 2) + cLabelSpacing;
|
|
ButtonTop := reqHeight + 2*cLabelSpacing;
|
|
|
|
// position buttons and activate default
|
|
for i := 0 to ComponentCount-1 do
|
|
begin
|
|
if (Components[i] is TBitBtn) then
|
|
begin
|
|
CurButton := TBitBtn(Components[i]);
|
|
CurBtnSize := GetButtonSize(CurButton);
|
|
CurButton.SetBounds(ButtonLeft, ButtonTop, CurBtnSize.X, CurBtnSize.Y);
|
|
inc(ButtonLeft, CurButton.Width + cBtnDist);
|
|
|
|
if (CurButton.Default) then
|
|
begin
|
|
ActiveControl := CurButton;
|
|
DefaultControl := CurButton;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{
|
|
Executes the layout of TPromptDialog for small devices
|
|
|
|
Two layout options are present, both to optimize space if
|
|
only 1 button is present and also to allow many buttons.
|
|
|
|
If only 1 button is present:
|
|
|
|
====================
|
|
Caption
|
|
====================
|
|
Button 1 > button in the middle
|
|
Some text and so on
|
|
... ...
|
|
... ...
|
|
====================
|
|
|
|
If more buttons are present:
|
|
|
|
====================
|
|
Caption
|
|
====================
|
|
Icon Button 1
|
|
Some text Button 2
|
|
... ...
|
|
... ...
|
|
====================
|
|
|
|
< > cTextWidth
|
|
< > cButtonWidth
|
|
<> cSpacing
|
|
}
|
|
procedure TPromptDialog.LayoutDialogSmallDevice;
|
|
Const
|
|
cDialogWidth = 200;
|
|
cDialogHalfWidth = cDialogWidth div 2;
|
|
cTextWidth = 100;
|
|
cHorizontalSpacing = 5;
|
|
cVerticalSpacing = 5;
|
|
cButtonWidth = cDialogWidth - cTextWidth - 3 * cHorizontalSpacing;
|
|
cOneButtonTextWidth = cTextWidth + cHorizontalSpacing + cButtonWidth;
|
|
var
|
|
i : integer;
|
|
CurButton: TBitBtn;
|
|
|
|
ButtonLeft, ButtonTop: Integer;
|
|
|
|
MinHeightForText,
|
|
MinHeightForButtons,
|
|
reqHeight: Integer;
|
|
begin
|
|
// Create buttons without positioning and
|
|
// Calculate the minimum size for the buttons
|
|
// First thing so that ComponentCount is updated
|
|
MinHeightForButtons := CreateButtons(True, cVerticalSpacing);
|
|
|
|
// calculate the width & height we need to display the Message
|
|
|
|
// calculate the needed size for the text
|
|
if ComponentCount = 1 then { one button layout }
|
|
TextBox := Rect(0, 0, cOneButtonTextWidth, Screen.Height - 100)
|
|
else
|
|
TextBox := Rect(0, 0, cTextWidth, Screen.Height - 100);
|
|
|
|
DrawText(Canvas.Handle, PChar(MSG), Length(MSG),
|
|
TextBox, DT_WORDBREAK or DT_CALCRECT);
|
|
|
|
// calculate the height of the text+icon
|
|
MinHeightForText := TextBox.Bottom;
|
|
|
|
if ComponentCount = 1 then { one button layout }
|
|
begin
|
|
TextBox.Top := 2*cVerticalSpacing + MinHeightForButtons;
|
|
Inc(TextBox.Bottom, TextBox.Top);
|
|
TextBox.Left := cHorizontalSpacing;
|
|
TextBox.Right := cOneButtonTextWidth + TextBox.Left;
|
|
end
|
|
else
|
|
begin
|
|
TextBox.Top := cVerticalSpacing;
|
|
Inc(TextBox.Bottom, TextBox.Top);
|
|
TextBox.Left := cHorizontalSpacing;
|
|
TextBox.Right := cTextWidth + TextBox.Left;
|
|
end;
|
|
|
|
reqHeight := Max(MinHeightForText, MinHeightForButtons);
|
|
|
|
if ComponentCount = 1 then { one button layout }
|
|
begin
|
|
// set size of form
|
|
Height := (TextBox.Bottom - TextBox.Top) + 3*cVerticalSpacing + MinHeightForButtons;
|
|
Width := 200;
|
|
|
|
// position buttons and activate default
|
|
if (Components[0] is TBitBtn) then
|
|
begin
|
|
CurButton:=TBitBtn(Components[0]);
|
|
CurButton.Left := cDialogHalfWidth - cButtonWidth div 2;
|
|
CurButton.Top := cVerticalSpacing;
|
|
CurButton.Width := cButtonWidth;
|
|
if (CurButton.Default) then
|
|
begin
|
|
ActiveControl:=CurButton;
|
|
DefaultControl:=CurButton;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// set size of form
|
|
Height := reqHeight + cVerticalSpacing;
|
|
Width := 200;
|
|
|
|
// calculate the left of the buttons
|
|
ButtonLeft := cTextWidth + 2 * cHorizontalSpacing;
|
|
ButtonTop := cVerticalSpacing;
|
|
|
|
// position buttons and activate default
|
|
for i:=0 to ComponentCount-1 do
|
|
begin
|
|
if (Components[i] is TBitBtn) then
|
|
begin
|
|
CurButton:=TBitBtn(Components[i]);
|
|
CurButton.Left := ButtonLeft;
|
|
CurButton.Top := ButtonTop;
|
|
CurButton.Width := cButtonWidth;
|
|
|
|
inc(ButtonTop, CurButton.Height + cVerticalSpacing);
|
|
|
|
if (CurButton.Default) then
|
|
begin
|
|
ActiveControl:=CurButton;
|
|
DefaultControl:=CurButton;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// We need to avoid a too high dialog which would go out
|
|
// of the screen and be maybe impossible to close
|
|
if Height > Screen.Height - 50 then
|
|
Height := Screen.Height - 50;
|
|
end;
|
|
|
|
|
|
function ShowPromptDialog(const DialogCaption,
|
|
DialogMessage: String;
|
|
DialogType: longint; Buttons: PLongint;
|
|
ButtonCount, DefaultIndex, EscapeResult: Longint;
|
|
UseDefaultPos: boolean;
|
|
X, Y: Longint): Longint;
|
|
var
|
|
theModalResult: longint;
|
|
begin
|
|
with TPromptDialog.CreateMessageDialog (DialogCaption, DialogMessage,
|
|
DialogType, Buttons, ButtonCount, DefaultIndex)
|
|
do
|
|
try
|
|
if not UseDefaultPos then
|
|
begin
|
|
Position := poDesigned;
|
|
Left := X;
|
|
Top := Y;
|
|
end;
|
|
theModalResult := ShowModal;
|
|
case theModalResult of
|
|
-1 : Result := EscapeResult
|
|
else
|
|
Result := DialogResult[theModalResult];
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
function CreateMessageDialog(const Msg: string; DlgType: TMsgDlgType;
|
|
Buttons: TMsgDlgButtons): TForm;
|
|
var PDlg: TPromptDialog;
|
|
aCaption: String;
|
|
Btns: PLongInt;
|
|
CancelValue, DefaultIndex, ButtonCount: Longint;
|
|
begin
|
|
if DlgType <> mtCustom then
|
|
aCaption := MsgDlgCaptions[DlgType]
|
|
else
|
|
aCaption := Application.Title;
|
|
Btns := GetPromptUserButtons(Buttons, CancelValue, DefaultIndex, ButtonCount,
|
|
False, mbOk);
|
|
PDlg := TPromptDialog.CreateMessageDialog(aCaption, Msg, DialogIds[DlgType], Btns, ButtonCount, DefaultIndex);
|
|
Result := TForm(PDlg);
|
|
ReallocMem(Btns, 0);
|
|
end;
|
|
|
|
|
|
|
|
type
|
|
|
|
{ TQuestionDlg }
|
|
|
|
TQuestionDlg = class(TForm)
|
|
procedure ButtonKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
private
|
|
FButtons: TList;
|
|
FBitmap: TCustomBitmap;
|
|
FBitmapX, FBitmapY: Integer;
|
|
public
|
|
TextBox : TRect;
|
|
TextStyle : TTextStyle;
|
|
MessageTxt: String;
|
|
constructor CreateQuestionDlg(const aCaption, aMsg: string;
|
|
DlgType: TMsgDlgType; Buttons: array of const; HelpCtx: Longint);
|
|
destructor Destroy; override;
|
|
procedure Paint; override;
|
|
procedure LayoutDialog;
|
|
function ShowModal: TModalResult; override;
|
|
function FindButton(Order: array of TModalResult): TBitBtn;
|
|
end;
|
|
|
|
{ TQuestionDlg }
|
|
|
|
procedure TQuestionDlg.Paint;
|
|
var
|
|
UseMaskHandle: HBitmap;
|
|
begin
|
|
inherited Paint;
|
|
Canvas.TextRect(TextBox, TextBox.Left, TextBox.Top, MessageTxt, TextStyle);
|
|
if Assigned (FBitmap) then
|
|
begin
|
|
UseMaskHandle := FBitmap.MaskHandle;
|
|
MaskBlt(Canvas.GetUpdatedHandle([csHandleValid]),
|
|
cBitmapX, cBitmapY, FBitmap.Width, FBitmap.Height,
|
|
FBitmap.Canvas.GetUpdatedHandle([csHandleValid]),
|
|
0, 0, UseMaskHandle, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TQuestionDlg.LayoutDialog;
|
|
const
|
|
cBtnDist = 10; // distance between buttons
|
|
cLabelSpacing = 8; // space around label
|
|
var
|
|
Flags: Cardinal;
|
|
i: Integer;
|
|
CurButton: TBitBtn;
|
|
reqBtnWidth: Integer;
|
|
reqWidth: LongInt;
|
|
cMinLeft: Integer;
|
|
ButtonLeft: Integer;
|
|
reqHeight: LongInt;
|
|
CurBtnPos: Integer;
|
|
CurBtnSize: TPoint;
|
|
MinBtnWidth: Integer; // minimum width for a single button
|
|
MinBtnHeight: Integer; // minimum height for a single button
|
|
|
|
function GetButtonSize(AButton: TBitBtn): TPoint;
|
|
begin
|
|
AButton.HandleNeeded;
|
|
TBitBtnAccess(AButton).CalculatePreferredSize(Result.x, Result.y, True);
|
|
if MinBtnHeight < Result.y then
|
|
MinBtnHeight := Result.y
|
|
else
|
|
if Result.y < MinBtnHeight then
|
|
Result.y := MinBtnHeight;
|
|
if Result.x < MinBtnWidth then
|
|
Result.x := MinBtnWidth;
|
|
end;
|
|
|
|
begin
|
|
FillChar(TextStyle, SizeOf(TTextStyle), 0);
|
|
|
|
with TextStyle do
|
|
begin
|
|
Clipping := True;
|
|
Wordbreak := True;
|
|
SystemFont := True;
|
|
Opaque := False;
|
|
ShowPrefix := True;
|
|
end;
|
|
|
|
// calculate the width & height we need to display the Message
|
|
if MessageTxt = '' then
|
|
MessageTxt := ' ';
|
|
TextBox := Rect(0, 0, Screen.Width div 2, Screen.Height - 100);
|
|
Flags := DT_CalcRect or DT_INTERNAL or DT_WordBreak;
|
|
SelectObject(Canvas.Handle, Screen.SystemFont.Reference.Handle);
|
|
DrawText(Canvas.Handle, PChar(MessageTxt), Length(MessageTxt), TextBox, Flags);
|
|
|
|
// calculate the width we need to display the buttons
|
|
MinBtnWidth:=Max(25,MinimumDialogButtonWidth);
|
|
MinBtnHeight:=Max(15,MinimumDialogButtonHeight);
|
|
reqBtnWidth := 0;
|
|
|
|
if FButtons <> nil then
|
|
for i := 0 to FButtons.Count - 1 do
|
|
begin
|
|
CurButton := TBitBtn(FButtons[i]);
|
|
CurBtnSize:=GetButtonSize(CurButton);
|
|
if i > 0 then Inc(reqBtnWidth, cBtnDist);
|
|
Inc(reqBtnWidth, CurBtnSize.X);
|
|
end;
|
|
|
|
// calculate the width of the dialog
|
|
if FBitmap <> nil then
|
|
cMinLeft := cLabelSpacing + max(20, FBitmap.Width) + cLabelSpacing
|
|
else
|
|
cMinLeft := cLabelSpacing;
|
|
reqWidth:= reqBtnWidth + 2 * cBtnDist;
|
|
if reqWidth < (TextBox.Right + cMinLeft + cLabelSpacing) then
|
|
reqWidth:= TextBox.Right + cMinLeft + cLabelSpacing;
|
|
ButtonLeft := ((reqWidth - reqBtnWidth) div 2);
|
|
|
|
// calculate the height of the dialog
|
|
reqHeight:= TextBox.Bottom;
|
|
if (FBitmap <> nil) and (FBitmap.Height > reqHeight) then
|
|
reqHeight := FBitmap.Height;
|
|
inc(reqHeight, CurBtnSize.Y + 3 * cLabelSpacing);
|
|
|
|
// calculate the text position
|
|
OffsetRect(TextBox,
|
|
((reqWidth-cMinLeft-TextBox.Right-cLabelSpacing) div 2) + cMinLeft,
|
|
cLabelSpacing);
|
|
|
|
// calculate the icon position
|
|
if FBitmap <> nil then
|
|
begin
|
|
FBitmapX := cLabelSpacing;
|
|
FBitmapY := (reqHeight - CurBtnSize.Y - FBitmap.Height - cLabelSpacing) div 2;
|
|
end;
|
|
|
|
// set size of form
|
|
SetBounds((Screen.Width - reqWidth-10) div 2, (Screen.Height - reqHeight-50) div 2,
|
|
reqWidth, reqHeight);
|
|
|
|
// position buttons
|
|
CurBtnPos := ButtonLeft;
|
|
if FButtons <> nil then
|
|
for i := 0 to FButtons.Count-1 do
|
|
begin
|
|
CurButton := TBitBtn(Components[i]);
|
|
CurBtnSize := GetButtonSize(CurButton);
|
|
CurButton.SetBounds(CurBtnPos, ClientHeight - CurBtnSize.Y - cLabelSpacing,
|
|
CurBtnSize.X, CurBtnSize.Y);
|
|
inc(CurBtnPos, CurButton.Width + cBtnDist);
|
|
end;
|
|
end;
|
|
|
|
function TQuestionDlg.ShowModal: TModalResult;
|
|
begin
|
|
LayoutDialog;
|
|
Result := inherited ShowModal;
|
|
end;
|
|
|
|
function TQuestionDlg.FindButton(Order: array of TModalResult): TBitBtn;
|
|
var
|
|
i: Integer;
|
|
CurValue: TModalResult;
|
|
j: Integer;
|
|
begin
|
|
if FButtons=nil then begin
|
|
Result:=nil;
|
|
exit;
|
|
end;
|
|
for i:=Low(Order) to High(Order) do begin
|
|
CurValue:=Order[i];
|
|
for j:=0 to FButtons.Count-1 do begin
|
|
Result:=TBitBtn(FButtons[j]);
|
|
if Result.ModalResult=CurValue then exit;
|
|
end;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
procedure TQuestionDlg.ButtonKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
var
|
|
Handled: Boolean;
|
|
begin
|
|
if Shift<>[] then exit;
|
|
Handled:=true;
|
|
if (Key=VK_ESCAPE) and (CancelControl<>nil) then
|
|
CancelControl.ExecuteCancelAction
|
|
else if (Key in [VK_RETURN,VK_SPACE]) and (Sender is TBitBtn) then
|
|
ModalResult:=TBitBtn(Sender).ModalResult
|
|
else if (Key=VK_RETURN) and (DefaultControl<>nil) then
|
|
DefaultControl.ExecuteDefaultAction
|
|
else if (Key=VK_LEFT) then
|
|
TWinControl(Sender).PerformTab(false)
|
|
else if (Key=VK_RIGHT) then
|
|
TWinControl(Sender).PerformTab(true)
|
|
else
|
|
Handled:=false;
|
|
if Handled then Key:=VK_UNKNOWN;
|
|
end;
|
|
|
|
constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
|
|
DlgType: TMsgDlgType; Buttons: array of const; HelpCtx: Longint);
|
|
var
|
|
i: Integer;
|
|
CurBtnValue: TModalResult;
|
|
CurBtnCaption: String;
|
|
NewButton: TBitBtn;
|
|
NewKind: TBitBtnKind;
|
|
NewCaption: String;
|
|
dlgId: LongInt;
|
|
ok: Boolean;
|
|
begin
|
|
inherited Create(nil);
|
|
BorderStyle := bsDialog;
|
|
Position := poScreenCenter;
|
|
MessageTxt := aMsg;
|
|
HelpContext := HelpCtx;
|
|
OnKeyDown := @ButtonKeyDown;
|
|
ok := false;
|
|
try
|
|
i:=Low(Buttons);
|
|
while i<=High(Buttons) do begin
|
|
if Buttons[i].VType<>vtInteger then
|
|
RaiseGDBException('TQuestionDlg.CreateQuestionDlg integer expected at '
|
|
+IntToStr(i)+' but '+IntToStr(ord(Buttons[i].VType))+' found.');
|
|
if Buttons[i].VType=vtInteger then begin
|
|
// get TModalResult
|
|
CurBtnValue:=Buttons[i].VInteger;
|
|
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' CurBtnValue=',dbgs(CurBtnValue));
|
|
inc(i);
|
|
|
|
// get button caption
|
|
CurBtnCaption:='';
|
|
if (i<=High(Buttons)) then begin
|
|
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
|
|
case Buttons[i].VType of
|
|
vtString: CurBtnCaption:=Buttons[i].VString^;
|
|
vtAnsiString: CurBtnCaption:=AnsiString(Buttons[i].VAnsiString);
|
|
vtChar: CurBtnCaption:=Buttons[i].VChar;
|
|
vtPChar: CurBtnCaption:=Buttons[i].VPChar;
|
|
vtPWideChar: CurBtnCaption:=Buttons[i].VPWideChar;
|
|
vtWideChar: CurBtnCaption:=Buttons[i].VWideChar;
|
|
vtWidestring: CurBtnCaption:=WideString(Buttons[i].VWideString);
|
|
else
|
|
dec(i); // prevent the following inc(i)
|
|
end;
|
|
inc(i);
|
|
end;
|
|
//DebugLn('TQuestionDlg.CreateQuestionDlg CurBtnCaption=',CurBtnCaption);
|
|
if CurBtnCaption='' then begin
|
|
// find default caption
|
|
case CurBtnValue of
|
|
mrOk : CurBtnCaption:=rsmbOk;
|
|
mrCancel : CurBtnCaption:=rsmbCancel;
|
|
mrYes : CurBtnCaption:=rsmbYes;
|
|
mrNo : CurBtnCaption:=rsmbNo;
|
|
mrAbort : CurBtnCaption:=rsmbAbort;
|
|
mrRetry : CurBtnCaption:=rsmbRetry;
|
|
mrIgnore : CurBtnCaption:=rsmbIgnore;
|
|
mrAll : CurBtnCaption:=rsmbAll;
|
|
mrYesToAll : CurBtnCaption:=rsmbYesToAll;
|
|
mrNoToAll : CurBtnCaption:=rsmbNoToAll;
|
|
end;
|
|
end;
|
|
if CurBtnCaption='' then begin
|
|
raise Exception.Create(
|
|
'TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
|
|
end;
|
|
|
|
// get button kind
|
|
case curBtnValue of
|
|
mrOk: NewKind:=bkOK;
|
|
mrCancel: NewKind:=bkCancel;
|
|
mrYes: NewKind:=bkYes;
|
|
mrNo: NewKind:=bkNo;
|
|
mrAbort: NewKind:=bkAbort;
|
|
mrRetry: NewKind:=bkRetry;
|
|
mrIgnore: NewKind:=bkIgnore;
|
|
mrAll: NewKind:=bkAll;
|
|
mrNoToAll: NewKind:=bkNoToAll;
|
|
mrYesToAll: NewKind:=bkYesToAll;
|
|
else NewKind:=bkCustom;
|
|
end;
|
|
|
|
// add button
|
|
if FButtons=nil then FButtons:=TList.Create;
|
|
NewButton:=TBitBtn.Create(Self);
|
|
with NewButton do begin
|
|
AutoSize:=false;
|
|
Anchors:=[akLeft, akBottom];
|
|
ModalResult:=curBtnValue;
|
|
Layout:=blGlyphLeft;
|
|
Kind:=NewKind;
|
|
Caption:=curBtnCaption;
|
|
Parent:=Self;
|
|
OnKeyDown:=@ButtonKeyDown;
|
|
end;
|
|
FButtons.Add(NewButton);
|
|
end else
|
|
raise Exception.Create(
|
|
'TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));
|
|
end;
|
|
ok:=true;
|
|
finally
|
|
if not Ok then
|
|
FreeAndNil(FButtons);
|
|
end;
|
|
|
|
FBitmap := nil;
|
|
NewCaption:=ACaption;
|
|
case DlgType of
|
|
mtWarning, mtError, mtInformation, mtConfirmation:
|
|
begin
|
|
dlgId := DialogIds[DlgType];
|
|
FBitmap := GetDialogIcon(dlgId);
|
|
if NewCaption='' then
|
|
NewCaption := GetDialogCaption(dlgId);
|
|
end;
|
|
else
|
|
FBitmap := GetDialogIcon(idDialogInfo);
|
|
end;
|
|
if NewCaption='' then
|
|
NewCaption := Application.Title;
|
|
Caption:=NewCaption;
|
|
|
|
// find default and cancel button
|
|
DefaultControl:=FindButton([mrYes,mrOk,mrYesToAll,mrAll,mrRetry,mrCancel,
|
|
mrNo,mrNoToAll,mrAbort,mrIgnore]);
|
|
CancelControl:=FindButton([mrAbort,mrCancel,mrNo,mrIgnore,mrNoToAll,mrYes,
|
|
mrOk,mrRetry,mrAll,mrYesToAll])
|
|
end;
|
|
|
|
destructor TQuestionDlg.Destroy;
|
|
begin
|
|
FreeAndNil(FButtons);
|
|
FreeAndNil(FBitmap);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
|
|
Buttons: array of const; HelpCtx: Longint): TModalResult;
|
|
{ Show a dialog with aCaption as Title, aMsg as Text, DlgType as Icon,
|
|
HelpCtx as Help context and Buttons to define the shown buttons and their
|
|
TModalResult.
|
|
Buttons is a list of TModalResult and strings. For each number a button is
|
|
created. To set a custom caption, add a string after a button.
|
|
The default TModalResults defined in controls.pp (mrNone..mrLast) don't need
|
|
a caption. The default captions will be used.
|
|
|
|
Examples for Buttons:
|
|
[mrOk,mrCancel,'Cancel now',mrIgnore,300,'Do it']
|
|
This will result in 4 buttons:
|
|
'Ok' returning mrOk
|
|
'Cancel now' returning mrCancel
|
|
'Ignore' returning mrIgnore
|
|
'Do it' returning 300
|
|
}
|
|
var
|
|
QuestionDialog: TQuestionDlg;
|
|
begin
|
|
QuestionDialog:=TQuestionDlg.CreateQuestionDlg(aCaption,aMsg,DlgType,Buttons,
|
|
HelpCtx);
|
|
try
|
|
Result:=QuestionDialog.ShowModal;
|
|
finally
|
|
QuestionDialog.Free;
|
|
end;
|
|
end;
|
|
|
|
function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
|
|
Buttons: array of const; const HelpKeyword: string): TModalResult;
|
|
begin
|
|
// TODO: handle HelpKeyword
|
|
Result:=QuestionDlg(aCaption,aMsg,DlgType,Buttons,0);
|
|
end;
|
|
|
|
// included by dialogs.pp
|