unit lazdialogs; {$mode objfpc}{$H+} interface uses // RTL Classes, SysUtils, math, // LCL 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: TStaticText; 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; 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.LoadFromLazarusResource('dialog_warning'); end; mtError: begin Caption:= rsMtError; image1.Picture.LoadFromLazarusResource('dialog_error'); end; mtConfirmation: begin Caption:= rsMtConfirmation; image1.Picture.LoadFromLazarusResource('dialog_confirmation'); end; mtInformation: begin Caption:= rsMtInformation; image1.Picture.LoadFromLazarusResource('dialog_information'); 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].DefaultCaption:= True; //btnList[I].AutoSize:= True; btnList[I].Left:= ButtonPos; btnList[I].Top:= Image1.Top + Image1.Height + 10; // next line is required until Autosize is implemented {btnList[I].Width:= label1.Canvas.TextExtent(btnList[I].Caption).cx + btnList[I].Glyph.Width + 16;} btnList[I].AutoSize := True; btnList[I].Visible:= True; //Application.ProcessMessages; currently not required. It may become //necessary if Autosize is set, and width computed automagically. Maybe //outside the loop (run just once) ButtonPos:= ButtonPos + btnList[I].Width + 8; end; //textWidth:= label1.Canvas.TextExtent(Label1.Caption).cx; //Label1.Width:= textWidth; label1.AutoSize := True; textWidth:= label1.Left + label1.Width; RequiredWidth:= Max(textWidth,ButtonPos); Width := RequiredWidth + 10; Height:= btnList[0].Top + btnList[0].Height + 10; 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 := TStaticText.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.