Setup.SelectFolderForm.pas 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166
  1. unit Setup.SelectFolderForm;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2025 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. "Select Folder" form
  8. }
  9. interface
  10. uses
  11. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  12. Setup.SetupForm, StdCtrls, FolderTreeView, NewStaticText, BidiCtrls;
  13. type
  14. TSelectFolderForm = class(TSetupForm)
  15. BrowseLabel: TNewStaticText;
  16. PathEdit: TEdit;
  17. NewFolderButton: TNewButton;
  18. OKButton: TNewButton;
  19. CancelButton: TNewButton;
  20. procedure PathEditChange(Sender: TObject);
  21. procedure NewFolderButtonClick(Sender: TObject);
  22. private
  23. FFolderTreeView: TCustomFolderTreeView;
  24. FNewFolderName: String;
  25. FStartMenu, FAppendDir: Boolean;
  26. procedure FolderTreeViewChange(Sender: TObject);
  27. public
  28. constructor Create(AOwner: TComponent); override;
  29. constructor Create2(AOwner: TComponent; AStartMenu: Boolean);
  30. end;
  31. function ShowSelectFolderDialog(const StartMenu, AppendDir: Boolean;
  32. var Path: String; const NewFolderName: String): Boolean;
  33. implementation
  34. uses
  35. PathFunc, SetupLdrAndSetup.Messages, Shared.SetupMessageIDs, Setup.MainFunc,
  36. Shared.SetupTypes, Setup.WizardForm, Shared.CommonFunc;
  37. {$R *.DFM}
  38. function ShowSelectFolderDialog(const StartMenu, AppendDir: Boolean;
  39. var Path: String; const NewFolderName: String): Boolean;
  40. var
  41. Form: TSelectFolderForm;
  42. begin
  43. Form := TSelectFolderForm.Create2(nil, StartMenu);
  44. try
  45. Form.FAppendDir := AppendDir;
  46. Form.FNewFolderName := NewFolderName;
  47. Form.NewFolderButton.Visible := not AppendDir and (NewFolderName <> '');
  48. if StartMenu then begin
  49. with Form.FFolderTreeView as TStartMenuFolderTreeView do
  50. SetPaths(GetShellFolder(False, sfPrograms),
  51. GetShellFolder(True, sfPrograms),
  52. GetShellFolder(False, sfStartup),
  53. GetShellFolder(True, sfStartup));
  54. TidyUpGroupName(Path);
  55. end
  56. else
  57. TidyUpDirName(Path);
  58. if AppendDir then begin
  59. if PathExtractDir(Path) <> Path then
  60. Form.FFolderTreeView.ChangeDirectory(PathExtractDir(Path), True);
  61. end
  62. else
  63. Form.FFolderTreeView.ChangeDirectory(Path, True);
  64. if StartMenu or (Form.FFolderTreeView.Directory <> '') then
  65. Form.ActiveControl := Form.FFolderTreeView;
  66. Form.PathEdit.Text := Path;
  67. Result := (Form.ShowModal = mrOK);
  68. if Result then
  69. Path := Trim(Form.PathEdit.Text);
  70. finally
  71. Form.Free;
  72. end;
  73. end;
  74. { TSelectFolderForm }
  75. constructor TSelectFolderForm.Create(AOwner: TComponent);
  76. var
  77. YDiff, W: Integer;
  78. begin
  79. inherited;
  80. if not FStartMenu then begin
  81. FFolderTreeView := TFolderTreeView.Create(Self);
  82. TFolderTreeView(FFolderTreeView).OnChange := FolderTreeViewChange;
  83. TFolderTreeView(FFolderTreeView).OnRename := WizardForm.DirTreeRename;
  84. end
  85. else begin
  86. FFolderTreeView := TStartMenuFolderTreeView.Create(Self);
  87. TStartMenuFolderTreeView(FFolderTreeView).OnChange := FolderTreeViewChange;
  88. TStartMenuFolderTreeView(FFolderTreeView).OnRename := WizardForm.GroupTreeRename;
  89. end;
  90. FFolderTreeView.SetBounds(16, 64, 317, 229);
  91. FFolderTreeView.Anchors := [akLeft, akTop, akRight, akBottom];
  92. FFolderTreeView.Visible := False;
  93. { The form needs its handle allocated before the Parent assignment,
  94. otherwise the control's width and height get reduced later. Looks like
  95. a Delphi 11 bug; the problem is seen in IS 6.3 but not 6.2.2. }
  96. HandleNeeded;
  97. FFolderTreeView.Parent := Self;
  98. PathEdit.BringToFront; { for MSAA }
  99. BrowseLabel.BringToFront; { for MSAA }
  100. FFolderTreeView.TabOrder := 2;
  101. FFolderTreeView.Visible := True;
  102. InitializeFont;
  103. Caption := SetupMessages[msgBrowseDialogTitle];
  104. BrowseLabel.Caption := SetupMessages[msgBrowseDialogLabel];
  105. YDiff := WizardForm.AdjustLabelHeight(BrowseLabel);
  106. PathEdit.Top := PathEdit.Top + YDiff;
  107. TryEnableAutoCompleteFileSystem(PathEdit.Handle);
  108. FFolderTreeView.Top := FFolderTreeView.Top + YDiff;
  109. NewFolderButton.Caption := SetupMessages[msgButtonNewFolder];
  110. NewFolderButton.Top := NewFolderButton.Top + YDiff;
  111. NewFolderButton.Width := CalculateButtonWidth([SetupMessages[msgButtonNewFolder]]);
  112. W := CalculateButtonWidth([SetupMessages[msgButtonOK], SetupMessages[msgButtonCancel]]);
  113. CancelButton.Caption := SetupMessages[msgButtonCancel];
  114. CancelButton.SetBounds(CancelButton.Left + CancelButton.Width - W,
  115. CancelButton.Top + YDiff, W, CancelButton.Height);
  116. OKButton.Caption := SetupMessages[msgButtonOK];
  117. OKButton.SetBounds(CancelButton.Left - ScalePixelsX(6) - W,
  118. OKButton.Top + YDiff, W, OKButton.Height);
  119. ClientHeight := ClientHeight + YDiff;
  120. FlipSizeAndCenterIfNeeded(True, WizardForm, False);
  121. end;
  122. constructor TSelectFolderForm.Create2(AOwner: TComponent; AStartMenu: Boolean);
  123. begin
  124. FStartMenu := AStartMenu;
  125. Create(AOwner);
  126. end;
  127. procedure TSelectFolderForm.PathEditChange(Sender: TObject);
  128. begin
  129. OKButton.Enabled := (Trim(PathEdit.Text) <> '');
  130. end;
  131. procedure TSelectFolderForm.FolderTreeViewChange(Sender: TObject);
  132. begin
  133. if FAppendDir then
  134. PathEdit.Text := AddBackslash(FFolderTreeView.Directory) + FNewFolderName
  135. else
  136. PathEdit.Text := FFolderTreeView.Directory;
  137. NewFolderButton.Enabled := FStartMenu or (FFolderTreeView.Directory <> '');
  138. end;
  139. procedure TSelectFolderForm.NewFolderButtonClick(Sender: TObject);
  140. begin
  141. FFolderTreeView.CreateNewDirectory(FNewFolderName);
  142. end;
  143. end.