doublecmd/src/uShowMsg.pas
2022-06-14 19:24:19 +03:00

885 lines
27 KiB
ObjectPascal

{
Double commander
-------------------------------------------------------------------------
Implementing of Showing messages with localization
Copyright (C) 2007-2020 Alexander Koblov (alexx2000@mail.ru)
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This library 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. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this library. If not, see <http://www.gnu.org/licenses/>.
}
{
Seksi Commander
----------------------------
Implementing of Showing messages with localization
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
contributors:
Koblov Alexander (Alexx2000@mail.ru)
}
unit uShowMsg;
{$mode delphi}{$H+}
interface
uses
Forms, Classes, DCBasicTypes;
type
TMyMsgResult=(mmrOK, mmrNo, mmrYes, mmrCancel, mmrNone,
mmrAppend, mmrResume, mmrCopyInto, mmrCopyIntoAll,
mmrOverwrite, mmrOverwriteAll, mmrOverwriteOlder,
mmrOverwriteSmaller, mmrOverwriteLarger, mmrAutoRenameSource, mmrAutoRenameTarget, mmrRenameSource,
mmrSkip, mmrSkipAll, mmrIgnore, mmrIgnoreAll, mmrAll, mmrRetry, mmrAbort, mmrRetryAdmin,
mmrUnlock);
TMyMsgButton=(msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone,
msmbAppend, msmbResume, msmbCopyInto, msmbCopyIntoAll,
msmbOverwrite, msmbOverwriteAll, msmbOverwriteOlder,
msmbOverwriteSmaller, msmbOverwriteLarger, msmbAutoRenameSource, msmbAutoRenameTarget, msmbRenameSource,
msmbSkip, msmbSkipAll, msmbIgnore, msmbIgnoreAll, msmbAll, msmbRetry, msmbAbort, msmbRetryAdmin,
msmbUnlock,
// Actions, they do not close the form and therefore have no corresponding result value:
msmbCompare);
TMyMsgActionButton = msmbCompare..High(TMyMsgButton);
TMyMsgActionHandler = procedure(Button: TMyMsgActionButton) of object;
{ TDialogMainThread }
TDialogMainThread = class
private
procedure SyncMsgBox;
procedure SyncMessageBox;
procedure SyncInputQuery;
procedure SyncMessageChoiceBox;
protected
FThread: TThread;
FCaption,
FMessage,
FValue: String;
FMaskInput: Boolean;
FFlags: Longint;
FButtons: array of TMyMsgButton;
FButDefault,
FButEscape: TMyMsgButton;
FInputQueryResult: Boolean;
FMsgBoxResult: TMyMsgResult;
FMessageBoxResult: LongInt;
FChoices: TDynamicStringArray;
public
constructor Create(AThread: TThread);
destructor Destroy;override;
function ShowMsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton) : TMyMsgResult;
function ShowMessageBox(const AText, ACaption: String; Flags: LongInt): LongInt;
function ShowMessageChoiceBox(const Message: String; Buttons: TDynamicStringArray): Integer;
function ShowInputQuery(const ACaption, APrompt: String; MaskInput: Boolean; var Value: String) : Boolean;
end;
function msgYesNo(const sMsg: String; ButDefault: TMyMsgButton = msmbYes): Boolean; overload;
function msgYesNo(Thread: TThread; const sMsg: String): Boolean; overload;
function msgYesNoCancel(const sMsg: String; ButDefault: TMyMsgButton = msmbYes):TMyMsgResult; overload;
function msgYesNoCancel(Thread: TThread; const sMsg: String): TMyMsgResult; overload;
procedure msgOK(const sMsg: String); overload;
procedure msgOK(Thread: TThread; const sMsg: String); overload;
procedure msgWarning(const sMsg: String); overload;
procedure msgWarning(Thread: TThread; const sMsg: String); overload;
procedure msgError(const sMsg: String); overload;
procedure msgError(Thread: TThread; const sMsg: String); overload;
function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult; overload;
function MsgBox(Thread: TThread; const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
function MsgTest:TMyMsgResult;
function MsgChoiceBox(const Message: String; Buttons: TDynamicStringArray): Integer; overload;
function MsgChoiceBox(Thread: TThread; const Message: String; Buttons: TDynamicStringArray): Integer; overload;
function ShowMessageBox(const AText, ACaption: String; Flags: LongInt): LongInt; overload;
function ShowMessageBox(Thread: TThread; const AText, ACaption: String; Flags: LongInt): LongInt; overload;
function ShowInputQuery(const ACaption, APrompt: String; MaskInput: Boolean; var Value: String): Boolean; overload;
function ShowInputQuery(Thread: TThread; const ACaption, APrompt: String; MaskInput: Boolean; var Value: String): Boolean; overload;
function ShowInputQuery(const ACaption, APrompt: String; var Value: String): Boolean; overload;
function ShowInputQuery(Thread: TThread; const ACaption, APrompt: String; var Value: String): Boolean; overload;
function ShowInputComboBox(const sCaption, sPrompt : String; slValueList : TStringList; var sValue : String) : Boolean;
function ShowInputListBox(const sCaption, sPrompt : String; slValueList : TStringList; var sValue : String; var SelectedChoice:integer) : Boolean;
function ShowInputMultiSelectListBox(const sCaption, sPrompt : String; slValueList, slOutputIndexSelected : TStringList) : Boolean;
procedure msgLoadLng;
implementation
uses
LCLIntf, SysUtils, StdCtrls, Graphics, Math, typinfo, Menus,
fMsg, uLng, Buttons, Controls, uLog, uGlobs, uDebug;
const
cMsgName = 'Double Commander';
var
cLngButton: array[TMyMsgButton] of String;
{ TDialogMainThread }
procedure TDialogMainThread.SyncMsgBox;
begin
FMsgBoxResult:= MsgBox(FMessage, FButtons, FButDefault, FButEscape);
end;
procedure TDialogMainThread.SyncMessageBox;
begin
FMessageBoxResult:= MessageBoxFunction(PAnsiChar(FMessage), PAnsiChar(FCaption), FFlags);
end;
procedure TDialogMainThread.SyncInputQuery;
begin
FInputQueryResult := LCLIntf.RequestInput(FCaption, FMessage, FMaskInput, FValue);
end;
procedure TDialogMainThread.SyncMessageChoiceBox;
begin
FMessageBoxResult:= MsgChoiceBox(FMessage, FChoices);
end;
constructor TDialogMainThread.Create(AThread : TThread);
begin
FThread:= AThread;
end;
destructor TDialogMainThread.Destroy;
begin
FButtons:= nil;
inherited Destroy;
end;
function TDialogMainThread.ShowMsgBox(const sMsg: String;
const Buttons: array of TMyMsgButton; ButDefault,
ButEscape: TMyMsgButton) : TMyMsgResult;
var
I : Integer;
begin
FMessage := sMsg;
SetLength(FButtons, Length(Buttons));
for I := Low(Buttons) to High(Buttons) do
FButtons[I] := Buttons[I];
FButDefault := ButDefault;
FButEscape := ButEscape;
TThread.Synchronize(FThread, SyncMsgBox);
Result := FMsgBoxResult;
end;
function TDialogMainThread.ShowMessageBox(const AText, ACaption: String; Flags: LongInt): LongInt;
begin
FCaption:= ACaption;
FMessage:= AText;
FFlags:= Flags;
TThread.Synchronize(FThread, SyncMessageBox);
Result:= FMessageBoxResult;
end;
function TDialogMainThread.ShowMessageChoiceBox(const Message: String;
Buttons: TDynamicStringArray): Integer;
begin
FMessage:= Message;
FChoices:= Buttons;
TThread.Synchronize(FThread, SyncMessageChoiceBox);
Result:= FMessageBoxResult;
end;
function TDialogMainThread.ShowInputQuery(const ACaption, APrompt: String;
MaskInput: Boolean; var Value: String): Boolean;
begin
FCaption:= ACaption;
FMessage:= APrompt;
FMaskInput:= MaskInput;
FValue:= Value;
TThread.Synchronize(FThread, SyncInputQuery);
Value:= FValue;
Result:= FInputQueryResult;
end;
procedure SetMsgBoxParams(var frmMsg: TfrmMsg; const sMsg: String;
const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton);
procedure FormShowEvent(Self, Sender: TCustomForm);
begin
if (Self.Tag <> 0) and (TObject(Self.Tag) is TButton) then
SendMessage(TButton(Self.Tag).Handle, $160C, 0, 1);
end;
const
cButtonCount = 8;
cButtonSpace = 8;
var
iIndex: Integer;
iCount: Integer;
Handler: TMethod;
MenuItem: TMenuItem;
CaptionWidth: Integer;
More: Boolean = False;
MinButtonWidth: Integer;
iIndexDefault : Integer = -1;
begin
Assert(Assigned(frmMsg));
frmMsg.Position:= poScreenCenter;
frmMsg.BorderStyle:= bsSingle;
frmMsg.BorderIcons:= [biSystemMenu];
frmMsg.Caption:= cMsgName;
frmMsg.lblMsg.Caption:= sMsg;
// Get default button width
with TButton.Create(nil) do
begin
MinButtonWidth:= GetDefaultWidth;
Free;
end;
// Determine number of buttons
iCount:= High(Buttons);
if iCount > cButtonCount then
begin
More:= True;
iCount:= cButtonCount - 1;
CaptionWidth:= frmMsg.Canvas.TextWidth(rsDlgButtonOther);
if CaptionWidth >= (MinButtonWidth - cButtonSpace) then
MinButtonWidth:= CaptionWidth + cButtonSpace;
end;
// Calculate minimum button width
for iIndex:= Low(Buttons) to iCount do
begin
CaptionWidth:= frmMsg.Canvas.TextWidth(cLngButton[Buttons[iIndex]]);
if CaptionWidth >= (MinButtonWidth - cButtonSpace) then
MinButtonWidth:= CaptionWidth + cButtonSpace;
end;
// Add first 9 items as buttons
for iIndex:= Low(Buttons) to iCount do
begin
with TButton.Create(frmMsg) do
begin
AutoSize:= True;
Caption:= cLngButton[Buttons[iIndex]];
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
if Buttons[iIndex] >= Low(TMyMsgActionButton) then
Tag:= -2-iIndex
else
Tag:= iIndex;
if Buttons[iIndex] = msmbRetryAdmin then
begin
Handler.Data:= frmMsg;
frmMsg.Tag:= GetHashCode;
Handler.Code:= @FormShowEvent;
frmMsg.OnShow:= TNotifyEvent(Handler);
Constraints.MinWidth:= MinButtonWidth + GetSystemMetrics(49);
end;
OnClick:= frmMsg.ButtonClick;
OnMouseUp:= frmMsg.MouseUpEvent;
if Buttons[iIndex] = ButDefault then
begin
Default:= True;
iIndexDefault:=iIndex;
end;
if Buttons[iIndex] = ButEscape then
frmMsg.Escape:= iIndex;
end;
end;
//Once the buttons has been added, let's set the correct "TabOrder" in such way:
//1o) The one with the default is "TabOrder=0"
//2o) If we press "TAB" key, it keeps moving to the right
//Let's determine what should be the "TabOrder" initial value so
//1. The default button will have tab order 0
//2. When moving with "tab" key, it will move from left to right
//"TabOrder" need to be set *after* all the buttons are there
if iIndexDefault<>-1 then
begin
for iIndex:= 0 to pred(frmMsg.ComponentCount) do
begin
if frmMsg.Components[iIndex] is TButton then
with frmMsg.Components[iIndex] as TButton do
begin
if Tag >= 0 then
TabOrder:= (Tag+(iCount+1)-iIndexDefault) mod (iCount+1) //Tricky but it does it, no "if", no negative after to check, etc.
else
TabOrder:= (-2-Tag+(iCount+1)-iIndexDefault) mod (iCount+1);
end;
end;
end;
// More add as popup menu
if More then
begin
// Add button with popup menu
with TButton.Create(frmMsg) do
begin
AutoSize:= True;
Caption:= rsDlgButtonOther;
Parent:= frmMsg.pnlButtons;
Constraints.MinWidth:= MinButtonWidth;
OnClick:= frmMsg.ButtonOtherClick;
end;
// Fill popup menu
for iIndex:= cButtonCount to High(Buttons) do
begin
MenuItem:= TMenuItem.Create(frmMsg.mnuOther);
with MenuItem do
begin
if Buttons[iIndex] >= Low(TMyMsgActionButton) then
Tag:= -2-iIndex
else
Tag:= iIndex;
Caption:= cLngButton[Buttons[iIndex]];
OnClick:= frmMsg.ButtonClick;
frmMsg.mnuOther.Items.Add(MenuItem);
end;
end;
end;
end;
type TMsgBoxHelper = class
Buttons: array of TMyMsgButton;
ActionHandler: TMyMsgActionHandler;
procedure MsgBoxActionHandler(Tag: PtrInt);
end;
procedure TMsgBoxHelper.MsgBoxActionHandler(Tag: PtrInt);
begin
ActionHandler(Buttons[-Tag-2]);
end;
function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton; ActionHandler: TMyMsgActionHandler = nil): TMyMsgResult;
var
frmMsg:TfrmMsg;
MsgBoxHelper: TMsgBoxHelper = nil;
I: Integer;
begin
frmMsg:=TfrmMsg.Create(Application);
try
MsgBoxHelper := TMsgBoxHelper.Create();
SetLength(MsgBoxHelper.Buttons, Length(Buttons));
for I := Low(Buttons) to High(Buttons) do
MsgBoxHelper.Buttons[I] := Buttons[I];
MsgBoxHelper.ActionHandler := ActionHandler;
frmMsg.ActionHandler := MsgBoxHelper.MsgBoxActionHandler;
SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
frmMsg.ShowModal;
if (frmMsg.iSelected)=-1 then
Result:=mmrNone
else
{ TODO : not safe code because of direct typecast from one enumeration to another,
better to use array lookup }
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
finally
frmMsg.Free;
MsgBoxHelper.Free;
end;
end;
function MsgBox(Thread: TThread; const sMsg: String;
const Buttons: array of TMyMsgButton; ButDefault,
ButEscape: TMyMsgButton): TMyMsgResult;
var
DialogMainThread : TDialogMainThread;
begin
Result := mmrNone;
DialogMainThread := TDialogMainThread.Create(Thread);
try
Result := DialogMainThread.ShowMsgBox(sMsg, Buttons, ButDefault, ButEscape);
finally
DialogMainThread.Free;
end;
end;
Function MsgTest:TMyMsgResult;
begin
Result:= MsgBox('test language of msg subsystem'#10'Second line',[msmbOK, msmbNO, msmbYes, msmbCancel, msmbNone,
msmbAppend, msmbOverwrite, msmbOverwriteAll],msmbOK, msmbNO);
end;
function msgYesNo(const sMsg: String; ButDefault: TMyMsgButton = msmbYes):Boolean;
begin
Result:= MsgBox(nil, sMsg,[msmbYes, msmbNo], ButDefault, msmbNo )= mmrYes;
end;
function msgYesNo(Thread: TThread; const sMsg: String): Boolean;
begin
Result:= MsgBox(Thread, sMsg,[msmbYes, msmbNo], msmbYes, msmbNo )= mmrYes;
end;
function msgYesNoCancel(const sMsg: String; ButDefault: TMyMsgButton = msmbYes):TMyMsgResult;
begin
Result:= MsgBox(sMsg,[msmbYes, msmbNo, msmbCancel], ButDefault, msmbCancel);
end;
function msgYesNoCancel(Thread: TThread; const sMsg: String): TMyMsgResult;
begin
Result:= MsgBox(Thread, sMsg,[msmbYes, msmbNo, msmbCancel], msmbYes, msmbCancel);
end;
procedure msgOK(const sMsg: String);
begin
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK);
end;
procedure msgOK(Thread: TThread; const sMsg: String);
begin
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK);
end;
procedure msgError(const sMsg: String);
begin
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK);
end;
procedure msgError(Thread: TThread; const sMsg: String);
begin
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK)
end;
procedure msgWarning(const sMsg: String);
begin
if gShowWarningMessages then
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK)
else
begin
if gLogWindow then // if log window enabled then write error to it
logWrite(sMsg, lmtError)
else
Beep;
end;
end;
procedure msgWarning(Thread: TThread; const sMsg: String);
begin
if gShowWarningMessages then
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK)
else
begin
if gLogWindow then // if log window enabled then write error to it
logWrite(Thread, sMsg, lmtError)
else
Beep;
end;
end;
function ShowMessageBox(const AText, ACaption: String; Flags: LongInt): LongInt;
begin
Result:= ShowMessageBox(nil, AText, ACaption, Flags);
end;
function ShowMessageBox(Thread: TThread; const AText, ACaption: String;
Flags: LongInt): LongInt;
var
DialogMainThread : TDialogMainThread;
begin
Result:= 0;
DialogMainThread:= TDialogMainThread.Create(Thread);
try
Result:= DialogMainThread.ShowMessageBox(AText, ACaption, Flags);
finally
DialogMainThread.Free;
end;
end;
function ShowInputQuery(const ACaption, APrompt: String;
MaskInput: Boolean; var Value: String): Boolean; overload;
begin
Result:= ShowInputQuery(nil, ACaption, APrompt, MaskInput, Value);
end;
function ShowInputQuery(Thread: TThread; const ACaption, APrompt: String;
MaskInput: Boolean; var Value: String): Boolean;
var
DialogMainThread : TDialogMainThread;
begin
Result := False;
DialogMainThread:= TDialogMainThread.Create(Thread);
try
Result:= DialogMainThread.ShowInputQuery(ACaption, APrompt, MaskInput, Value);
finally
DialogMainThread.Free;
end;
end;
function ShowInputQuery(const ACaption, APrompt: String;
var Value: String): Boolean; overload;
begin
Result:= ShowInputQuery(nil, ACaption, APrompt, False, Value);
end;
function ShowInputQuery(Thread: TThread; const ACaption, APrompt: String;
var Value: String): Boolean;
begin
Result:= ShowInputQuery(Thread, ACaption, APrompt, False, Value);
end;
function ShowInputComboBox(const sCaption, sPrompt : String; slValueList : TStringList;
var sValue : String) : Boolean;
var
Index: Integer;
frmDialog : TForm;
lblPrompt : TLabel;
cbValue : TComboBox;
bbtnOK,
bbtnCancel : TBitBtn;
begin
frmDialog := TForm.CreateNew(nil, 0);
with frmDialog do
try
BorderStyle := bsDialog;
Position := poScreenCenter;
AutoSize := True;
Height := 120;
ChildSizing.TopBottomSpacing := 8;
ChildSizing.LeftRightSpacing := 8;
Caption := sCaption;
lblPrompt := TLabel.Create(frmDialog);
with lblPrompt do
begin
Parent := frmDialog;
Caption := sPrompt;
Top := 6;
Left := 6;
end;
cbValue := TComboBox.Create(frmDialog);
with cbValue do
begin
Parent := frmDialog;
Items.Assign(slValueList);
Text := sValue;
Left := 6;
AnchorToNeighbour(akTop, 6, lblPrompt);
Constraints.MinWidth := max(280, Screen.Width div 4);
end;
bbtnCancel := TBitBtn.Create(frmDialog);
with bbtnCancel do
begin
Parent := frmDialog;
Kind := bkCancel;
Cancel := True;
Left := 6;
Width:= 90;
Anchors := [akTop, akRight];
AnchorToNeighbour(akTop, 18, cbValue);
AnchorSide[akRight].Control := cbValue;
AnchorSide[akRight].Side := asrRight;
end;
bbtnOK := TBitBtn.Create(frmDialog);
with bbtnOK do
begin
Parent := frmDialog;
Kind := bkOk;
Default := True;
Width:= 90;
Anchors := [akTop, akRight];
AnchorToNeighbour(akTop, 18, cbValue);
AnchorToNeighbour(akRight, 6, bbtnCancel);
end;
Result := (ShowModal = mrOK);
if Result then
begin
Index:= slValueList.IndexOf(cbValue.Text);
if Index < 0 then
slValueList.Add(cbValue.Text)
else begin
slValueList.Move(Index, 0);
end;
sValue := cbValue.Text;
end;
finally
FreeAndNil(frmDialog);
end; // with frmDialog
end;
type
TProcedureHolder=class(TObject)
public
procedure ListBoxDblClick(Sender: TObject);
end;
procedure TProcedureHolder.ListBoxDblClick(Sender: TObject);
begin
TForm(TComponent(Sender).Owner).ModalResult:=mrOk;
end;
function InnerShowInputListBox(const sCaption, sPrompt: String; bMultiSelect:boolean; slValueList,slOutputIndexSelected:TStringList; var sValue: String; var SelectedChoice:integer) : Boolean;
var
frmDialog : TForm;
lblPrompt : TLabel;
lbValue : TListBox;
bbtnOK, bbtnCancel, bbtnSelectAll : TBitBtn;
iIndex, iModalResult: integer;
ProcedureHolder:TProcedureHolder;
begin
SelectedChoice:=-1;
ProcedureHolder:=TProcedureHolder.Create;
try
frmDialog := TForm.CreateNew(nil, 0);
with frmDialog do
try
BorderStyle := bsDialog;
Position := poScreenCenter;
AutoSize := True;
Height := 120;
ChildSizing.TopBottomSpacing := 8;
ChildSizing.LeftRightSpacing := 8;
Caption := sCaption;
lblPrompt := TLabel.Create(frmDialog);
with lblPrompt do
begin
Parent := frmDialog;
Caption := sPrompt;
Top := 6;
Left := 6;
end;
lbValue := TListBox.Create(frmDialog);
with lbValue do
begin
Parent := frmDialog;
Height := (slValueList.Count*15)+50;
if height=0 then Height:=150 else
if height > (screen.Height div 2) then
height := (Screen.Height div 2);
Items.Assign(slValueList);
ItemIndex:=Items.IndexOf(sValue);
lbValue.MultiSelect:=bMultiSelect;
if (ItemIndex=-1) AND (Items.count>0) then ItemIndex:=0;
Left := 6;
AnchorToNeighbour(akTop, 6, lblPrompt);
Constraints.MinWidth := max(280, Screen.Width div 4);
OnDblClick:= ProcedureHolder.ListBoxDblClick;
end;
if bMultiSelect then
begin
bbtnSelectAll := TBitBtn.Create(frmDialog);
with bbtnSelectAll do
begin
Parent := frmDialog;
Kind := bkAll;
Cancel := True;
Left := 6;
Width:= 90;
Anchors := [akTop, akLeft];
AnchorToNeighbour(akTop, 18, lbValue);
AnchorSide[akLeft].Control := lbValue;
AnchorSide[akLeft].Side := asrLeft;
end;
end;
bbtnCancel := TBitBtn.Create(frmDialog);
with bbtnCancel do
begin
Parent := frmDialog;
Kind := bkCancel;
Cancel := True;
Left := 6;
Width:= 90;
Anchors := [akTop, akRight];
AnchorToNeighbour(akTop, 18, lbValue);
AnchorSide[akRight].Control := lbValue;
AnchorSide[akRight].Side := asrRight;
end;
bbtnOK := TBitBtn.Create(frmDialog);
with bbtnOK do
begin
Parent := frmDialog;
Kind := bkOk;
Default := True;
Width:= 90;
Anchors := [akTop, akRight];
AnchorToNeighbour(akTop, 18, lbValue);
AnchorToNeighbour(akRight, 6, bbtnCancel);
end;
iModalResult:=ShowModal;
Result := (iModalResult = mrOK) AND (lbValue.ItemIndex<>-1);
if (not Result) AND (bMultiSelect) AND (iModalResult = mrAll) then
begin
lbValue.SelectAll;
Result:=True;
end;
if Result then
begin
sValue:=lbValue.Items.Strings[lbValue.ItemIndex];
SelectedChoice:=lbValue.ItemIndex;
if bMultiSelect then
for iIndex:=0 to pred(lbValue.Items.count) do
if lbValue.Selected[iIndex] then
slOutputIndexSelected.Add(IntToStr(iIndex));
end;
finally
FreeAndNil(frmDialog);
end; // with frmDialog
finally
ProcedureHolder.Free;
end;
end;
function ShowInputListBox(const sCaption, sPrompt : String; slValueList : TStringList; var sValue : String; var SelectedChoice:integer) : Boolean;
begin
result := InnerShowInputListBox(sCaption, sPrompt, False, slValueList, nil, sValue, SelectedChoice);
end;
function ShowInputMultiSelectListBox(const sCaption, sPrompt : String; slValueList, slOutputIndexSelected : TStringList) : Boolean;
var
sDummyValue:string;
iDummySelectedChoice:integer;
begin
if slValueList.Count>0 then sDummyValue := slValueList.Strings[0];
result := InnerShowInputListBox(sCaption, sPrompt, True, slValueList, slOutputIndexSelected, sDummyValue, iDummySelectedChoice);
end;
function MsgChoiceBox(const Message: String; Buttons: TDynamicStringArray): Integer;
const
cButtonSpace = 8;
var
Index: Integer;
frmMsg: TfrmMsg;
CaptionWidth: Integer;
MinButtonWidth: Integer;
begin
frmMsg:= TfrmMsg.Create(Application);
try
frmMsg.BorderStyle:= bsSingle;
frmMsg.Position:= poScreenCenter;
frmMsg.BorderIcons:= [biSystemMenu];
frmMsg.Caption:= Application.Title;
frmMsg.lblMsg.WordWrap:= True;
frmMsg.lblMsg.Caption:= Message;
frmMsg.Constraints.MaxWidth:= 600;
// Get default button width
with TButton.Create(nil) do
begin
MinButtonWidth:= GetDefaultWidth;
Free;
end;
// Calculate minimum button width
for Index:= Low(Buttons) to High(Buttons) do
begin
CaptionWidth:= frmMsg.Canvas.TextWidth(Buttons[Index]);
if CaptionWidth >= (MinButtonWidth - cButtonSpace) then
MinButtonWidth:= CaptionWidth + cButtonSpace;
end;
// Add all buttons
for Index:= Low(Buttons) to High(Buttons) do
begin
with TButton.Create(frmMsg) do
begin
Tag:= Index;
AutoSize:= True;
Caption:= Buttons[Index];
Parent:= frmMsg.pnlButtons;
OnClick:= frmMsg.ButtonClick;
Constraints.MinWidth:= MinButtonWidth;
end;
end;
frmMsg.ShowModal;
Result:= frmMsg.iSelected;
finally
frmMsg.Free;
end;
end;
function MsgChoiceBox(Thread: TThread; const Message: String;
Buttons: TDynamicStringArray): Integer;
var
DialogMainThread : TDialogMainThread;
begin
Result := -1;
DialogMainThread:= TDialogMainThread.Create(Thread);
try
Result:= DialogMainThread.ShowMessageChoiceBox(Message, Buttons);
finally
DialogMainThread.Free;
end;
end;
procedure msgLoadLng;
var
I: TMyMsgButton;
begin
cLngButton[msmbOK] := rsDlgButtonOK;
cLngButton[msmbNo] := rsDlgButtonNo;
cLngButton[msmbYes] := rsDlgButtonYes;
cLngButton[msmbCancel] := rsDlgButtonCancel;
cLngButton[msmbNone] := rsDlgButtonNone;
cLngButton[msmbAppend] := rsDlgButtonAppend;
cLngButton[msmbResume] := rsDlgButtonResume;
cLngButton[msmbCopyInto] := rsDlgButtonCopyInto;
cLngButton[msmbCopyIntoAll] := rsDlgButtonCopyIntoAll;
cLngButton[msmbOverwrite] := rsDlgButtonOverwrite;
cLngButton[msmbOverwriteAll] := rsDlgButtonOverwriteAll;
cLngButton[msmbOverwriteOlder] := rsDlgButtonOverwriteOlder;
cLngButton[msmbOverwriteSmaller] := rsDlgButtonOverwriteSmaller;
cLngButton[msmbOverwriteLarger] := rsDlgButtonOverwriteLarger;
cLngButton[msmbAutoRenameSource] := rsDlgButtonAutoRenameSource;
cLngButton[msmbAutoRenameTarget] := rsDlgButtonAutoRenameTarget;
cLngButton[msmbRenameSource] := rsDlgButtonRename;
cLngButton[msmbSkip] := rsDlgButtonSkip;
cLngButton[msmbSkipAll] := rsDlgButtonSkipAll;
cLngButton[msmbIgnore] := rsDlgButtonIgnore;
cLngButton[msmbIgnoreAll] := rsDlgButtonIgnoreAll;
cLngButton[msmbAll] := rsDlgButtonAll;
cLngButton[msmbRetry] := rsDlgButtonRetry;
cLngButton[msmbAbort] := rsDlgButtonAbort;
cLngButton[msmbRetryAdmin] := rsDlgButtonRetryAdmin;
cLngButton[msmbUnlock] := rsDlgButtonUnlock;
cLngButton[msmbCompare] := rsDlgButtonCompare;
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
begin
// A reminder in case someone forgots to assign text.
if cLngButton[I] = EmptyStr then
DCDebug('Warning: MsgBox button ' + GetEnumName(TypeInfo(TMyMsgButton), Integer(I)) + ' caption not set.');
end;
end;
end.