mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 04:22:21 +01:00
518 lines
16 KiB
ObjectPascal
518 lines
16 KiB
ObjectPascal
unit LazDialogs;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
// RTL
|
|
Classes, SysUtils, math,
|
|
// LCL
|
|
Graphics, Forms, ShellCtrls, Buttons, StdCtrls, ExtCtrls, FileCtrl, ComCtrls,
|
|
Dialogs, ButtonPanel, LCLStrConsts, FileUtil, Controls;
|
|
|
|
type
|
|
TLazFileDialogKind = (
|
|
ldkOpenDesktop, ldkSaveDesktop, ldkOpenPDA, ldkSavePDA, ldkSelectDirectory);
|
|
|
|
{ TLazarusFileDialogForm }
|
|
|
|
TLazarusFileDialogForm = class(TForm)
|
|
private
|
|
FKind: TLazFileDialogKind;
|
|
procedure SetFilter(AFilter: string);
|
|
public
|
|
// User interface
|
|
ButtonPanel: TButtonPanel;
|
|
ShellTreeView: TShellTreeView;
|
|
ShellListView: TShellListView;
|
|
SaveEdit: TEdit;
|
|
FilterComboBox: TFilterComboBox;
|
|
// input/output
|
|
FileName: string;
|
|
Filter: string;
|
|
InitialDir: string;
|
|
Title: string;
|
|
//
|
|
constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
|
|
procedure Initialize(AKind: TLazFileDialogKind);
|
|
procedure HandleOkClick(ASender: TObject);
|
|
procedure HandleCancelClick(ASender: TObject);
|
|
procedure HandleCloseQuery(Sender : TObject; var CanClose : boolean);
|
|
procedure HandleEditChange(ASender: TObject);
|
|
procedure HandleSelectItem(Sender: TObject;
|
|
Item: TListItem; Selected: Boolean);
|
|
procedure HandleTreeViewSelectionChanged(ASender: TObject);
|
|
end;
|
|
|
|
{ TLazOpenDialog }
|
|
|
|
TLazOpenDialog = class(TOpenDialog)
|
|
protected
|
|
FForm: TLazarusFileDialogForm;
|
|
class procedure WSRegisterClass; override;
|
|
function DoExecute: boolean; override;
|
|
procedure DoInitialize; virtual;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
end;
|
|
|
|
{ TLazSaveDialog }
|
|
|
|
TLazSaveDialog = class(TLazOpenDialog)
|
|
protected
|
|
procedure DoInitialize; override;
|
|
end;
|
|
|
|
{ TLazSelectDirectoryDialog }
|
|
|
|
TLazSelectDirectoryDialog = class(TLazOpenDialog)
|
|
protected
|
|
procedure DoInitialize; override;
|
|
end;
|
|
|
|
{ TLazMessageDialog }
|
|
TLazMessageDialog = class(TForm)
|
|
private
|
|
Image1: TImage;
|
|
Label1: TLabel; // we need a TLabel to be able to resize it properly
|
|
btnList: array [0..11] of TBitBtn;
|
|
NumButtons: Integer;
|
|
public
|
|
constructor CreateNew(TheOwner: TComponent; Num: Integer = 0); override;
|
|
end;
|
|
|
|
function LazMessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
|
|
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
|
|
function LazMessageDlg(const aMsg: string; DlgType: TMsgDlgType;
|
|
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
|
|
|
|
implementation
|
|
|
|
var
|
|
{ Declared here for the time being to make it possibly work with LCLCustodrawn}
|
|
LazMessageDialog: TLazMessageDialog;
|
|
|
|
{ TLazarusFileDialogForm }
|
|
|
|
procedure TLazarusFileDialogForm.SetFilter(AFilter: string);
|
|
begin
|
|
if AFilter = '' then
|
|
FilterComboBox.Filter := Format(rsAllFiles,[GetAllFilesMask, GetAllFilesMask,''])
|
|
else
|
|
FilterComboBox.Filter := AFilter;
|
|
end;
|
|
|
|
{
|
|
The size of the window is determined only when creating the
|
|
handle, so any reference to TForm.Width and TForm.Height
|
|
here doesnt correspond to the final value.
|
|
}
|
|
constructor TLazarusFileDialogForm.CreateNew(AOwner: TComponent; Num: Integer = 0);
|
|
begin
|
|
inherited CreateNew(AOwner, Num);
|
|
|
|
Self.Position := poScreenCenter;
|
|
end;
|
|
|
|
procedure TLazarusFileDialogForm.Initialize(AKind: TLazFileDialogKind);
|
|
begin
|
|
FKind := AKind;
|
|
|
|
ButtonPanel := TButtonPanel.Create(Self);
|
|
ButtonPanel.Parent := Self;
|
|
ButtonPanel.Left := 0;
|
|
ButtonPanel.Height := 20;
|
|
ButtonPanel.Top := Height - ButtonPanel.Height;
|
|
ButtonPanel.Width := Width;
|
|
ButtonPanel.Align := alBottom;
|
|
ButtonPanel.ShowButtons := [pbOK, pbCancel];
|
|
ButtonPanel.OKButton.OnClick := @HandleOkClick;
|
|
ButtonPanel.CancelButton.OnClick := @HandleCancelClick;
|
|
|
|
if AKind in [ldkOpenDesktop, ldkSaveDesktop, ldkOpenPDA, ldkSavePDA] then
|
|
begin
|
|
// Add the ShellTreeView to the dialog
|
|
ShellTreeView := TShellTreeView.Create(Self);
|
|
ShellTreeView.Parent := Self;
|
|
ShellTreeView.Left := 0;
|
|
ShellTreeView.Top := 0;
|
|
ShellTreeView.Width := Width;
|
|
ShellTreeView.Height := 100;
|
|
ShellTreeView.Align := alTop;
|
|
|
|
// Add the ShellListView to the dialog
|
|
ShellListView := TShellListView.Create(Self);
|
|
ShellListView.Parent := Self;
|
|
ShellListView.Left := 0;
|
|
ShellListView.Top := ShellTreeView.Height;
|
|
ShellListView.Width := Width;
|
|
ShellListView.Height := Height - ShellTreeView.Height - ButtonPanel.Height;
|
|
ShellListView.Align := alClient;
|
|
ShellListView.ShellTreeView := ShellTreeView;
|
|
ShellListView.ScrollBars := ssVertical;
|
|
ShellListView.OnSelectItem := @HandleSelectItem;
|
|
|
|
// TEdit for save dialog
|
|
if AKind in [ldkSaveDesktop, ldkSavePDA] then
|
|
begin
|
|
SaveEdit := TEdit.Create(Self);
|
|
SaveEdit.Parent := Self;
|
|
SaveEdit.Left := 0;
|
|
SaveEdit.Height := 20;
|
|
SaveEdit.Top := Height - ButtonPanel.Height - SaveEdit.Height;
|
|
SaveEdit.Width := Width;
|
|
SaveEdit.Align := alBottom;
|
|
SaveEdit.Text := SysUtils.ExtractFileName(FileName);
|
|
SaveEdit.OnChange := @HandleEditChange;
|
|
end;
|
|
|
|
// TFilterComboBox
|
|
FilterComboBox := TFilterComboBox.Create(Self);
|
|
FilterComboBox.Parent := Self;
|
|
FilterComboBox.Left := 0;
|
|
FilterComboBox.Height := 20;
|
|
FilterComboBox.Top := Height - ButtonPanel.Height - FilterComboBox.Height;
|
|
if SaveEdit <> nil then
|
|
FilterComboBox.Top := FilterComboBox.Top - SaveEdit.Height;
|
|
FilterComboBox.Width := Width;
|
|
FilterComboBox.Align := alBottom;
|
|
SetFilter(Filter);
|
|
FilterComboBox.ShellListView := ShellListView;
|
|
|
|
// In the save dialog it is enabled when there is a text in the TEdit
|
|
if AKind in [ldkSaveDesktop, ldkSavePDA] then
|
|
ButtonPanel.OKButton.Enabled := SaveEdit.Text <> ''
|
|
// In a TOpenDialog the Ok button is only enabled when a file is selected
|
|
else
|
|
ButtonPanel.OkButton.Enabled := False;
|
|
end
|
|
else if FKind = ldkSelectDirectory then
|
|
begin
|
|
// Add the ShellTreeView to the dialog
|
|
ShellTreeView := TShellTreeView.Create(Self);
|
|
ShellTreeView.Parent := Self;
|
|
ShellTreeView.Left := 0;
|
|
ShellTreeView.Top := 0;
|
|
ShellTreeView.Align := alClient;
|
|
ShellTreeView.OnSelectionChanged := @HandleTreeViewSelectionChanged;
|
|
|
|
ButtonPanel.OKButton.Enabled := False;
|
|
end;
|
|
|
|
// Form events
|
|
OnCloseQuery := @HandleCloseQuery;
|
|
end;
|
|
|
|
// The Ok button code should be only a simple mrOk,
|
|
// because there is the dialog Ok button, which will
|
|
// always be active and will set the ModalResult to mrOk
|
|
// so the code needs to affect it too, and this can be
|
|
// done in CloseQuery
|
|
procedure TLazarusFileDialogForm.HandleOkClick(ASender: TObject);
|
|
begin
|
|
ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure TLazarusFileDialogForm.HandleCancelClick(ASender: TObject);
|
|
begin
|
|
ModalResult := mrCancel;
|
|
end;
|
|
|
|
procedure TLazarusFileDialogForm.HandleCloseQuery(Sender: TObject;
|
|
var CanClose: boolean);
|
|
begin
|
|
if ModalResult = mrCancel then
|
|
begin
|
|
CanClose := True;
|
|
Exit;
|
|
end;
|
|
|
|
CanClose := False;
|
|
|
|
if FKind in [ldkSaveDesktop, ldkSavePDA] then
|
|
begin
|
|
if SaveEdit.Text = '' then Exit;
|
|
|
|
FileName := ShellTreeView.GetPathFromNode(ShellTreeView.Selected);
|
|
FileName := IncludeTrailingPathDelimiter(FileName);
|
|
FileName := FileName + SaveEdit.Text;
|
|
CanClose := True;
|
|
end
|
|
else if FKind in [ldkOpenDesktop, ldkOpenPDA] then
|
|
begin
|
|
if ShellListView.Selected = nil then Exit;
|
|
|
|
FileName := ShellListView.GetPathFromItem(ShellListView.Selected);
|
|
CanClose := True;
|
|
end
|
|
else
|
|
begin
|
|
if ShellTreeView.Selected = nil then Exit;
|
|
|
|
FileName := ShellTreeView.GetPathFromNode(ShellTreeView.Selected);
|
|
CanClose := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TLazarusFileDialogForm.HandleEditChange(ASender: TObject);
|
|
begin
|
|
ButtonPanel.OkButton.Enabled := SaveEdit.Text <> '';
|
|
end;
|
|
|
|
procedure TLazarusFileDialogForm.HandleSelectItem(Sender: TObject;
|
|
Item: TListItem; Selected: Boolean);
|
|
begin
|
|
// Selecting an item changes the filename in the TEdit
|
|
// in save dialogs
|
|
if (FKind in [ldkSaveDesktop, ldkSavePDA]) and Selected then
|
|
begin
|
|
SaveEdit.Text := Item.Caption;
|
|
end
|
|
// In the OpenDialog the state of the Ok button is dependent
|
|
// on the selection of an item
|
|
else
|
|
begin
|
|
ButtonPanel.OkButton.Enabled := Selected;
|
|
end;
|
|
end;
|
|
|
|
// Used only in the TLazSelectDirectoryDialog
|
|
procedure TLazarusFileDialogForm.HandleTreeViewSelectionChanged(ASender: TObject);
|
|
begin
|
|
ButtonPanel.OKButton.Enabled := True;
|
|
end;
|
|
|
|
{ TLazOpenDialog }
|
|
|
|
class procedure TLazOpenDialog.WSRegisterClass;
|
|
begin
|
|
// Do nothing, because this dialog doesn't require a WS implementation
|
|
end;
|
|
|
|
function TLazOpenDialog.DoExecute: boolean;
|
|
begin
|
|
Result := FForm.ShowModal <> mrCancel;
|
|
FileName := FForm.FileName;
|
|
end;
|
|
|
|
procedure TLazOpenDialog.DoInitialize;
|
|
begin
|
|
FForm.Initialize(ldkOpenDesktop);
|
|
end;
|
|
|
|
constructor TLazOpenDialog.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
FForm := TLazarusFileDialogForm.CreateNew(Self);
|
|
FForm.FileName := FileName;
|
|
FForm.Filter := Filter;
|
|
FForm.Title := Title;
|
|
DoInitialize;
|
|
FForm.Hide;
|
|
end;
|
|
|
|
{ TLazSaveDialog }
|
|
|
|
procedure TLazSaveDialog.DoInitialize;
|
|
begin
|
|
FForm.Initialize(ldkSaveDesktop);
|
|
end;
|
|
|
|
{ TLazSelectDirectoryDialog }
|
|
|
|
procedure TLazSelectDirectoryDialog.DoInitialize;
|
|
begin
|
|
FForm.Initialize(ldkSelectDirectory);
|
|
end;
|
|
{ Dialog Functions }
|
|
|
|
function LazMessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
|
|
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
|
|
Var
|
|
I: Integer;
|
|
textWidth: Integer;
|
|
ButtonPos: Integer;
|
|
RequiredWidth: Integer;
|
|
BlankRight: Integer; // blank space at the right of last button
|
|
begin
|
|
{$ifdef LCLCustomdrawn} if not assigned(LazMessageDialog) then {$endif}
|
|
LazMessageDialog:= TLazMessageDialog.CreateNew(Application);
|
|
with LazMessageDialog do begin
|
|
Label1.Caption:= aMsg;
|
|
Label1.Parent:= LazMessageDialog;
|
|
{Select Image (and Caption) from DlgType}
|
|
case DlgType of
|
|
mtWarning: begin
|
|
Caption:= rsMtWarning;
|
|
image1.Picture.LoadFromResourceName(hInstance, 'dialog_warning', TPortableNetworkGraphic);
|
|
end;
|
|
mtError: begin
|
|
Caption:= rsMtError;
|
|
image1.Picture.LoadFromResourceName(hInstance, 'dialog_error', TPortableNetworkGraphic);
|
|
end;
|
|
mtConfirmation: begin
|
|
Caption:= rsMtConfirmation;
|
|
image1.Picture.LoadFromResourceName(hInstance, 'dialog_confirmation', TPortableNetworkGraphic);
|
|
end;
|
|
mtInformation: begin
|
|
Caption:= rsMtInformation;
|
|
image1.Picture.LoadFromResourceName(hInstance, 'dialog_information', TPortableNetworkGraphic);
|
|
end;
|
|
mtCustom: begin
|
|
Caption:= ApplicationName;
|
|
Image1.Width:= 8;
|
|
Image1.Hide;
|
|
end;
|
|
end;
|
|
Image1.Parent := LazMessageDialog;
|
|
|
|
if aCaption <> '' then //A custom dialog caption has been required
|
|
Caption:= aCaption;
|
|
Label1.Left:= Image1.Left + Image1.Width + 8;
|
|
|
|
{Select Buttons from Buttons}
|
|
if (Buttons = []) or (Buttons = [mbHelp]) then
|
|
Buttons:= Buttons + [mbOK]; // the dialog must provide a modal result
|
|
NumButtons:= 0;
|
|
{ The order of Buttons is the same as in Qt - Totally different from GTK2}
|
|
if mbHelp in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkHelp;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbYes in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkYes;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbYesToAll in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkYesToAll;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbNo in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkNo;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbNoToAll in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkNoToAll;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbAll in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkAll;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbOK in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkOK;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbRetry in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkRetry;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbIgnore in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkIgnore;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbCancel in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkCancel;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbAbort in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkAbort;
|
|
inc(NumButtons);
|
|
end;
|
|
if mbClose in Buttons then begin
|
|
btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
|
|
btnList[NumButtons].Parent := LazMessageDialog;
|
|
btnList[NumButtons].Kind:= bkClose;
|
|
inc(NumButtons);
|
|
end;
|
|
|
|
ButtonPos:= Image1.Left;
|
|
for I:= 0 to NumButtons -1 do begin
|
|
btnList[I].Constraints.MinHeight:= 25;
|
|
btnList[I].Constraints.MinWidth:= 75;
|
|
btnList[I].Left:= ButtonPos;
|
|
btnList[I].Top:= Image1.Top + Image1.Height + 10;
|
|
{next line is required because even if Auyosize is true,
|
|
width property is changed only when the button is
|
|
painted. Either we wait (but Application.ProcessMessages is not enough)
|
|
or we force the actual width. We may safely use form canvas, because our
|
|
components inherit the font from the form (ParentFont = true by default)}
|
|
btnList[I].Width:= LazMessageDialog.Canvas.TextExtent(btnList[I].Caption).cx
|
|
+ btnList[I].Glyph.Width + 20;
|
|
|
|
btnList[I].Visible:= True;
|
|
ButtonPos:= ButtonPos + btnList[I].Width + 8;
|
|
end;
|
|
|
|
{ See comment above for width property. Static Text apparently doesn't behave
|
|
properly when Text is changed at run time. The width is set as appropriate, but
|
|
the text is written only up to the previous width. Therefore we must use a TLabel}
|
|
textWidth:= LazMessageDialog.Canvas.TextExtent(Label1.Caption).cx;
|
|
|
|
Label1.Width:= textWidth;
|
|
textWidth:= label1.Left + label1.Width;
|
|
RequiredWidth:= Max(textWidth,ButtonPos);
|
|
Width := RequiredWidth + 10;
|
|
Height:= btnList[0].Top + btnList[0].Height + 10;
|
|
// now let's move our buttons to the right side of dialog, if appropriate
|
|
BlankRight:= Width - ButtonPos;
|
|
if BlankRight > 10 then
|
|
for I:= 0 to NumButtons-1 do btnList[I].Left:= btnList[I].Left+BlankRight ;
|
|
end;
|
|
result := LazMessageDialog.ShowModal;
|
|
{$ifndef LCLCustomdrawn}LazMessageDialog.Release;{$endif}
|
|
end;
|
|
|
|
function LazMessageDlg(const aMsg: string; DlgType: TMsgDlgType;
|
|
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
|
|
begin
|
|
result := LazMessageDlg('',aMsg,DlgType,Buttons,HelpCtx);
|
|
end;
|
|
|
|
{ TLazMessageDialog }
|
|
|
|
constructor TLazMessageDialog.CreateNew(TheOwner: TComponent; Num: Integer = 0);
|
|
begin
|
|
inherited CreateNew(TheOwner);
|
|
FormStyle:= fsStayOnTop;
|
|
Position:= poMainFormCenter;
|
|
Image1 := TImage.Create(Self);
|
|
Image1.Top:= 10;
|
|
Image1.Left:= 10;
|
|
Image1.Width:= 48;
|
|
Image1.Height:= 48;
|
|
Label1 := TLabel.Create(Self);
|
|
Label1.Top:= Image1.Top;
|
|
Label1.Left:= Image1.Left + Image1.Width + 10;
|
|
Label1.Caption:= 'Label1';
|
|
Width:= Image1.Width + Label1.Width + 20;
|
|
Height:= Image1.Height + 20;
|
|
end;
|
|
|
|
|
|
end.
|
|
|