ScriptDlg.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059
  1. unit ScriptDlg;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2012 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. Custom wizard pages
  8. }
  9. interface
  10. {$I VERSION.INC}
  11. uses
  12. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Contnrs,
  13. Wizard, Install,
  14. NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer,
  15. BidiCtrls, TaskbarProgressFunc;
  16. type
  17. TInputQueryWizardPage = class(TWizardPage)
  18. private
  19. FEdits: TList;
  20. FPromptLabels: TList;
  21. FSubCaptionLabel: TNewStaticText;
  22. FY: Integer;
  23. function GetEdit(Index: Integer): TPasswordEdit;
  24. function GetPromptLabel(Index: Integer): TNewStaticText;
  25. function GetValue(Index: Integer): String;
  26. procedure SetValue(Index: Integer; const Value: String);
  27. public
  28. constructor Create(AOwner: TComponent); override;
  29. destructor Destroy; override;
  30. function Add(const APrompt: String; const APassword: Boolean): Integer;
  31. property Edits[Index: Integer]: TPasswordEdit read GetEdit;
  32. procedure Initialize(const SubCaption: String);
  33. property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
  34. property Values[Index: Integer]: String read GetValue write SetValue;
  35. published
  36. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  37. end;
  38. TInputOptionWizardPage = class(TWizardPage)
  39. private
  40. FCheckListBox: TNewCheckListBox;
  41. FExclusive: Boolean;
  42. FSubCaptionLabel: TNewStaticText;
  43. function GetSelectedValueIndex: Integer;
  44. function GetValue(Index: Integer): Boolean;
  45. procedure SetSelectedValueIndex(Value: Integer);
  46. procedure SetValue(Index: Integer; Value: Boolean);
  47. public
  48. function Add(const ACaption: String): Integer;
  49. function AddEx(const ACaption: String; const ALevel: Byte; const AExclusive: Boolean): Integer;
  50. procedure Initialize(const SubCaption: String; const Exclusive, ListBox: Boolean);
  51. property SelectedValueIndex: Integer read GetSelectedValueIndex write SetSelectedValueIndex;
  52. property Values[Index: Integer]: Boolean read GetValue write SetValue;
  53. published
  54. property CheckListBox: TNewCheckListBox read FCheckListBox;
  55. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  56. end;
  57. TInputDirWizardPage = class(TWizardPage)
  58. private
  59. FAppendDir: Boolean;
  60. FButtons: TList;
  61. FEdits: TList;
  62. FNewFolderName: String;
  63. FPromptLabels: TList;
  64. FSubCaptionLabel: TNewStaticText;
  65. FY: Integer;
  66. procedure ButtonClick(Sender: TObject);
  67. function GetButton(Index: Integer): TNewButton;
  68. function GetEdit(Index: Integer): TEdit;
  69. function GetPromptLabel(Index: Integer): TNewStaticText;
  70. function GetValue(Index: Integer): String;
  71. procedure SetValue(Index: Integer; const Value: String);
  72. protected
  73. procedure NextButtonClick(var Continue: Boolean); override;
  74. public
  75. constructor Create(AOwner: TComponent); override;
  76. destructor Destroy; override;
  77. function Add(const APrompt: String): Integer;
  78. property Buttons[Index: Integer]: TNewButton read GetButton;
  79. property Edits[Index: Integer]: TEdit read GetEdit;
  80. procedure Initialize(const SubCaption: String; const AppendDir: Boolean;
  81. const NewFolderName: String);
  82. property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
  83. property Values[Index: Integer]: String read GetValue write SetValue;
  84. published
  85. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  86. end;
  87. TInputFileWizardPage = class(TWizardPage)
  88. private
  89. FButtons: TList;
  90. FEdits: TList;
  91. FInputFileDefaultExtensions: TStringList;
  92. FInputFileFilters: TStringList;
  93. FPromptLabels: TList;
  94. FSubCaptionLabel: TNewStaticText;
  95. FY: Integer;
  96. procedure ButtonClick(Sender: TObject);
  97. function GetButton(Index: Integer): TNewButton;
  98. function GetEdit(Index: Integer): TEdit;
  99. function GetPromptLabel(Index: Integer): TNewStaticText;
  100. function GetValue(Index: Integer): String;
  101. procedure SetValue(Index: Integer; const Value: String);
  102. function GetIsSaveButton(Index: Integer): Boolean;
  103. procedure SetIsSaveButton(Index: Integer; const IsSaveButton: Boolean);
  104. public
  105. constructor Create(AOwner: TComponent); override;
  106. destructor Destroy; override;
  107. function Add(const APrompt, AFilter, ADefaultExtension: String): Integer;
  108. property Buttons[Index: Integer]: TNewButton read GetButton;
  109. property Edits[Index: Integer]: TEdit read GetEdit;
  110. procedure Initialize(const SubCaption: String);
  111. property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
  112. property Values[Index: Integer]: String read GetValue write SetValue;
  113. property IsSaveButton[Index: Integer]: Boolean read GetIsSaveButton write SetIsSaveButton;
  114. published
  115. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  116. end;
  117. TOutputMsgWizardPage = class(TWizardPage)
  118. private
  119. FMsgLabel: TNewStaticText;
  120. public
  121. procedure Initialize(const Msg: String);
  122. published
  123. property MsgLabel: TNewStaticText read FMsgLabel;
  124. end;
  125. TOutputMsgMemoWizardPage = class(TWizardPage)
  126. private
  127. FRichEditViewer: TRichEditViewer;
  128. FSubCaptionLabel: TNewStaticText;
  129. public
  130. procedure Initialize(const SubCaption: String; const Msg: AnsiString);
  131. published
  132. property RichEditViewer: TRichEditViewer read FRichEditViewer;
  133. property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  134. end;
  135. TOutputProgressWizardPage = class(TWizardPage)
  136. private
  137. FMsg1Label: TNewStaticText;
  138. FMsg2Label: TNewStaticText;
  139. FProgressBar: TNewProgressBar;
  140. FUseMarqueeStyle: Boolean;
  141. FSavePageID: Integer;
  142. procedure ProcessMsgs;
  143. public
  144. constructor Create(AOwner: TComponent); override;
  145. procedure Hide;
  146. procedure Initialize; virtual;
  147. procedure SetProgress(const Position, Max: Longint);
  148. procedure SetText(const Msg1, Msg2: String);
  149. procedure Show; virtual;
  150. published
  151. property Msg1Label: TNewStaticText read FMsg1Label;
  152. property Msg2Label: TNewStaticText read FMsg2Label;
  153. property ProgressBar: TNewProgressBar read FProgressBar;
  154. end;
  155. TOutputMarqueeProgressWizardPage = class(TOutputProgressWizardPage)
  156. public
  157. constructor Create(AOwner: TComponent); override;
  158. procedure Animate;
  159. procedure Initialize; override;
  160. procedure SetProgress(const Position, Max: Longint);
  161. end;
  162. {$IFNDEF PS_NOINT64}
  163. TDownloadWizardPage = class(TOutputProgressWizardPage)
  164. private
  165. FFiles: TObjectList;
  166. FOnDownloadProgress: TOnDownloadProgress;
  167. FAbortButton: TNewButton;
  168. FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
  169. procedure AbortButtonClick(Sender: TObject);
  170. function InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
  171. procedure ShowProgressControls(const AVisible: Boolean);
  172. public
  173. constructor Create(AOwner: TComponent); override;
  174. destructor Destroy; override;
  175. procedure Initialize; override;
  176. property AbortedByUser: Boolean read FAbortedByUser;
  177. procedure Add(const Url, BaseName, RequiredSHA256OfFile: String);
  178. procedure AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String);
  179. procedure Clear;
  180. function Download: Int64;
  181. property OnDownloadProgress: TOnDownloadProgress write FOnDownloadProgress;
  182. procedure Show; override;
  183. published
  184. property AbortButton: TNewButton read FAbortButton;
  185. end;
  186. {$ENDIF}
  187. implementation
  188. uses
  189. Struct, Main, SelFolderForm, Msgs, MsgIDs, PathFunc, CmnFunc, CmnFunc2,
  190. BrowseFunc, Logging, InstFunc;
  191. const
  192. DefaultLabelHeight = 14;
  193. DefaultBoxTop = 24; { relative to top of InnerNotebook }
  194. DefaultBoxBottom = DefaultBoxTop + 205;
  195. {------}
  196. procedure SetCtlParent(const AControl, AParent: TWinControl);
  197. { Like assigning to AControl.Parent, but puts the control at the *bottom* of
  198. the z-order instead of the top, for MSAA compatibility. }
  199. var
  200. OldVisible: Boolean;
  201. begin
  202. { Hide the control so the handle won't be created yet, so that unnecessary
  203. "OBJ_REORDER" MSAA events don't get sent }
  204. OldVisible := AControl.Visible;
  205. AControl.Visible := False;
  206. AControl.Parent := AParent;
  207. AControl.SendToBack;
  208. AControl.Visible := OldVisible;
  209. end;
  210. {--- InputQuery ---}
  211. constructor TInputQueryWizardPage.Create(AOwner: TComponent);
  212. begin
  213. inherited;
  214. FEdits := TList.Create;
  215. FPromptLabels := TList.Create;
  216. end;
  217. destructor TInputQueryWizardPage.Destroy;
  218. begin
  219. FPromptLabels.Free;
  220. FEdits.Free;
  221. inherited;
  222. end;
  223. procedure TInputQueryWizardPage.Initialize(const SubCaption: String);
  224. begin
  225. FSubCaptionLabel := TNewStaticText.Create(Self);
  226. with FSubCaptionLabel do begin
  227. AutoSize := False;
  228. Width := SurfaceWidth;
  229. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  230. WordWrap := True;
  231. Caption := SubCaption;
  232. Parent := Surface;
  233. end;
  234. FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
  235. end;
  236. function TInputQueryWizardPage.Add(const APrompt: String;
  237. const APassword: Boolean): Integer;
  238. var
  239. PromptLabel: TNewStaticText;
  240. Edit: TPasswordEdit;
  241. begin
  242. if APrompt <> '' then begin
  243. PromptLabel := TNewStaticText.Create(Self);
  244. with PromptLabel do begin
  245. AutoSize := False;
  246. Top := FY;
  247. Width := SurfaceWidth;
  248. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  249. Anchors := [akLeft, akTop, akRight];
  250. WordWrap := True;
  251. Caption := APrompt;
  252. end;
  253. SetCtlParent(PromptLabel, Surface);
  254. Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
  255. end else
  256. PromptLabel := nil;
  257. Edit := TPasswordEdit.Create(Self);
  258. with Edit do begin
  259. Password := APassword;
  260. Top := FY;
  261. Width := SurfaceWidth;
  262. Anchors := [akLeft, akTop, akRight];
  263. end;
  264. SetCtlParent(Edit, Surface);
  265. Inc(FY, WizardForm.ScalePixelsY(36));
  266. if PromptLabel <> nil then
  267. PromptLabel.FocusControl := Edit;
  268. FPromptLabels.Add(PromptLabel);
  269. Result := FEdits.Add(Edit);
  270. end;
  271. function TInputQueryWizardPage.GetEdit(Index: Integer): TPasswordEdit;
  272. begin
  273. Result := TPasswordEdit(FEdits[Index]);
  274. end;
  275. function TInputQueryWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
  276. begin
  277. Result := TNewStaticText(FPromptLabels[Index]);
  278. end;
  279. function TInputQueryWizardPage.GetValue(Index: Integer): String;
  280. begin
  281. Result := GetEdit(Index).Text;
  282. end;
  283. procedure TInputQueryWizardPage.SetValue(Index: Integer; const Value: String);
  284. begin
  285. GetEdit(Index).Text := Value;
  286. end;
  287. {--- InputOption ---}
  288. procedure TInputOptionWizardPage.Initialize(const SubCaption: String;
  289. const Exclusive, ListBox: Boolean);
  290. var
  291. CaptionYDiff: Integer;
  292. begin
  293. FSubCaptionLabel := TNewStaticText.Create(Self);
  294. with SubCaptionLabel do begin
  295. AutoSize := False;
  296. Width := SurfaceWidth;
  297. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  298. Anchors := [akLeft, akTop, akRight];
  299. WordWrap := True;
  300. Caption := SubCaption;
  301. Parent := Surface;
  302. end;
  303. CaptionYDiff := WizardForm.AdjustLabelHeight(SubCaptionLabel);
  304. FCheckListBox := TNewCheckListBox.Create(Self);
  305. with FCheckListBox do begin
  306. Top := CaptionYDiff + WizardForm.ScalePixelsY(DefaultBoxTop);
  307. Width := SurfaceWidth;
  308. Height := WizardForm.ScalePixelsY(DefaultBoxBottom) - Top;
  309. Anchors := [akLeft, akTop, akRight, akBottom];
  310. Flat := ListBox and (shFlatComponentsList in SetupHeader.Options);
  311. end;
  312. SetCtlParent(FCheckListBox, Surface);
  313. FExclusive := Exclusive;
  314. if not ListBox then begin
  315. FCheckListBox.BorderStyle := bsNone;
  316. FCheckListBox.Color := SurfaceColor;
  317. FCheckListBox.MinItemHeight := WizardForm.ScalePixelsY(22);
  318. FCheckListBox.WantTabs := True;
  319. end;
  320. end;
  321. function TInputOptionWizardPage.Add(const ACaption: String): Integer;
  322. begin
  323. Result := AddEx(ACaption, 0, FExclusive);
  324. end;
  325. function TInputOptionWizardPage.AddEx(const ACaption: String;
  326. const ALevel: Byte; const AExclusive: Boolean): Integer;
  327. begin
  328. if AExclusive then
  329. Result := FCheckListBox.AddRadioButton(ACaption, '', ALevel, False, True, nil)
  330. else
  331. Result := FCheckListBox.AddCheckBox(ACaption, '', ALevel, False, True, True,
  332. True, nil);
  333. end;
  334. function TInputOptionWizardPage.GetSelectedValueIndex: Integer;
  335. var
  336. I: Integer;
  337. begin
  338. for I := 0 to FCheckListBox.Items.Count-1 do
  339. if (FCheckListBox.ItemLevel[I] = 0) and FCheckListBox.Checked[I] then begin
  340. Result := I;
  341. Exit;
  342. end;
  343. Result := -1;
  344. end;
  345. function TInputOptionWizardPage.GetValue(Index: Integer): Boolean;
  346. begin
  347. Result := FCheckListBox.Checked[Index];
  348. end;
  349. procedure TInputOptionWizardPage.SetSelectedValueIndex(Value: Integer);
  350. var
  351. I: Integer;
  352. begin
  353. for I := 0 to FCheckListBox.Items.Count-1 do
  354. if FCheckListBox.ItemLevel[I] = 0 then
  355. FCheckListBox.Checked[I] := (I = Value);
  356. end;
  357. procedure TInputOptionWizardPage.SetValue(Index: Integer; Value: Boolean);
  358. begin
  359. FCheckListBox.Checked[Index] := Value;
  360. end;
  361. {--- InputDir ---}
  362. constructor TInputDirWizardPage.Create(AOwner: TComponent);
  363. begin
  364. inherited;
  365. FButtons := TList.Create;
  366. FEdits := TList.Create;
  367. FPromptLabels := TList.Create;
  368. end;
  369. destructor TInputDirWizardPage.Destroy;
  370. begin
  371. FPromptLabels.Free;
  372. FEdits.Free;
  373. FButtons.Free;
  374. inherited;
  375. end;
  376. procedure TInputDirWizardPage.ButtonClick(Sender: TObject);
  377. var
  378. I: Integer;
  379. Edit: TEdit;
  380. S: String;
  381. begin
  382. I := FButtons.IndexOf(Sender);
  383. if I <> -1 then begin
  384. Edit := TEdit(FEdits[I]);
  385. S := Edit.Text;
  386. if ShowSelectFolderDialog(False, FAppendDir, S, FNewFolderName) then
  387. Edit.Text := S;
  388. end;
  389. end;
  390. procedure TInputDirWizardPage.NextButtonClick(var Continue: Boolean);
  391. var
  392. I: Integer;
  393. Edit: TEdit;
  394. begin
  395. for I := 0 to FEdits.Count-1 do begin
  396. Edit := FEdits[I];
  397. if not ValidateCustomDirEdit(Edit, True, True, True) then begin
  398. if WizardForm.Visible then
  399. Edit.SetFocus;
  400. Continue := False;
  401. Exit;
  402. end;
  403. end;
  404. inherited;
  405. end;
  406. procedure TInputDirWizardPage.Initialize(const SubCaption: String;
  407. const AppendDir: Boolean; const NewFolderName: String);
  408. begin
  409. FSubCaptionLabel := TNewStaticText.Create(Self);
  410. with FSubCaptionLabel do begin
  411. AutoSize := False;
  412. Width := SurfaceWidth;
  413. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  414. Anchors := [akLeft, akTop, akRight];
  415. WordWrap := True;
  416. Caption := SubCaption;
  417. Parent := Surface;
  418. end;
  419. FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
  420. FAppendDir := AppendDir;
  421. FNewFolderName := NewFolderName;
  422. end;
  423. function TInputDirWizardPage.Add(const APrompt: String): Integer;
  424. var
  425. ButtonWidth: Integer;
  426. PromptLabel: TNewStaticText;
  427. Edit: TEdit;
  428. Button: TNewButton;
  429. begin
  430. ButtonWidth := WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
  431. if APrompt <> '' then begin
  432. PromptLabel := TNewStaticText.Create(Self);
  433. with PromptLabel do begin
  434. AutoSize := False;
  435. Top := FY;
  436. Width := SurfaceWidth;
  437. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  438. Anchors := [akLeft, akTop, akRight];
  439. WordWrap := True;
  440. Caption := APrompt;
  441. end;
  442. SetCtlParent(PromptLabel, Surface);
  443. Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
  444. end else
  445. PromptLabel := nil;
  446. Edit := TEdit.Create(Self);
  447. with Edit do begin
  448. Top := FY;
  449. Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
  450. Anchors := [akLeft, akTop, akRight];
  451. end;
  452. SetCtlParent(Edit, Surface);
  453. TryEnableAutoCompleteFileSystem(Edit.Handle);
  454. if PromptLabel <> nil then
  455. PromptLabel.FocusControl := Edit;
  456. Button := TNewButton.Create(Self);
  457. with Button do begin
  458. Left := SurfaceWidth-ButtonWidth;
  459. Top := Edit.Top-1;
  460. Width := ButtonWidth;
  461. Height := WizardForm.NextButton.Height;
  462. Anchors := [akTop, akRight];
  463. if FEdits.Count = 0 then
  464. Caption := SetupMessages[msgButtonWizardBrowse]
  465. else
  466. { Can't use the same accel key for secondary buttons... }
  467. Caption := RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]);
  468. OnClick := ButtonClick;
  469. end;
  470. SetCtlParent(Button, Surface);
  471. Inc(FY, WizardForm.ScalePixelsY(36));
  472. FButtons.Add(Button);
  473. FPromptLabels.Add(PromptLabel);
  474. Result := FEdits.Add(Edit);
  475. end;
  476. function TInputDirWizardPage.GetButton(Index: Integer): TNewButton;
  477. begin
  478. Result := TNewButton(FButtons[Index]);
  479. end;
  480. function TInputDirWizardPage.GetEdit(Index: Integer): TEdit;
  481. begin
  482. Result := TEdit(FEdits[Index]);
  483. end;
  484. function TInputDirWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
  485. begin
  486. Result := TNewStaticText(FPromptLabels[Index]);
  487. end;
  488. function TInputDirWizardPage.GetValue(Index: Integer): String;
  489. begin
  490. Result := GetEdit(Index).Text;
  491. end;
  492. procedure TInputDirWizardPage.SetValue(Index: Integer; const Value: String);
  493. begin
  494. GetEdit(Index).Text := RemoveBackslashUnlessRoot(PathExpand(Value));
  495. end;
  496. {--- InputFile ---}
  497. constructor TInputFileWizardPage.Create(AOwner: TComponent);
  498. begin
  499. inherited;
  500. FButtons := TList.Create;
  501. FEdits := TList.Create;
  502. FInputFileDefaultExtensions := TStringList.Create;
  503. FInputFileFilters := TStringList.Create;
  504. FPromptLabels := TList.Create;
  505. end;
  506. destructor TInputFileWizardPage.Destroy;
  507. begin
  508. FPromptLabels.Free;
  509. FInputFileFilters.Free;
  510. FInputFileDefaultExtensions.Free;
  511. FEdits.Free;
  512. FButtons.Free;
  513. inherited;
  514. end;
  515. procedure TInputFileWizardPage.ButtonClick(Sender: TObject);
  516. var
  517. I: Integer;
  518. Edit: TEdit;
  519. FileName: String;
  520. begin
  521. I := FButtons.IndexOf(Sender);
  522. if I <> -1 then begin
  523. Edit := TEdit(FEdits[I]);
  524. FileName := Edit.Text;
  525. if (not IsSaveButton[I] and NewGetOpenFileName(RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]),
  526. FileName, PathExtractPath(FileName), FInputFileFilters[I],
  527. FInputFileDefaultExtensions[I], Surface.Handle)) or
  528. (IsSaveButton[I] and NewGetSaveFileName(RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]),
  529. FileName, PathExtractPath(FileName), FInputFileFilters[I],
  530. FInputFileDefaultExtensions[I], Surface.Handle)) then
  531. Edit.Text := FileName;
  532. end;
  533. end;
  534. procedure TInputFileWizardPage.Initialize(const SubCaption: String);
  535. begin
  536. FSubCaptionLabel := TNewStaticText.Create(Self);
  537. with FSubCaptionLabel do begin
  538. AutoSize := False;
  539. Width := SurfaceWidth;
  540. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  541. Anchors := [akLeft, akTop, akRight];
  542. WordWrap := True;
  543. Caption := SubCaption;
  544. Parent := Surface;
  545. end;
  546. FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
  547. end;
  548. function TInputFileWizardPage.Add(const APrompt, AFilter,
  549. ADefaultExtension: String): Integer;
  550. var
  551. ButtonWidth: Integer;
  552. PromptLabel: TNewStaticText;
  553. Edit: TEdit;
  554. Button: TNewButton;
  555. begin
  556. ButtonWidth := WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
  557. if APrompt <> '' then begin
  558. PromptLabel := TNewStaticText.Create(Self);
  559. with PromptLabel do begin
  560. AutoSize := False;
  561. Top := FY;
  562. Width := SurfaceWidth;
  563. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  564. Anchors := [akLeft, akTop, akRight];
  565. WordWrap := True;
  566. Caption := APrompt;
  567. end;
  568. SetCtlParent(PromptLabel, Surface);
  569. Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
  570. end else
  571. PromptLabel := nil;
  572. Edit := TEdit.Create(Self);
  573. with Edit do begin
  574. Top := FY;
  575. Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
  576. Anchors := [akLeft, akTop, akRight];
  577. end;
  578. SetCtlParent(Edit, Surface);
  579. TryEnableAutoCompleteFileSystem(Edit.Handle);
  580. if PromptLabel <> nil then
  581. PromptLabel.FocusControl := Edit;
  582. Button := TNewButton.Create(Self);
  583. with Button do begin
  584. Left := SurfaceWidth-ButtonWidth;
  585. Top := Edit.Top-1;
  586. Width := ButtonWidth;
  587. Height := WizardForm.NextButton.Height;
  588. Anchors := [akTop, akRight];
  589. if FButtons.Count = 0 then
  590. Caption := SetupMessages[msgButtonWizardBrowse]
  591. else
  592. { Can't use the same accel key for secondary buttons... }
  593. Caption := RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]);
  594. OnClick := ButtonClick;
  595. end;
  596. SetCtlParent(Button, Surface);
  597. Inc(FY, WizardForm.ScalePixelsY(36));
  598. FInputFileFilters.Add(AFilter);
  599. FInputFileDefaultExtensions.Add(ADefaultExtension);
  600. FButtons.Add(Button);
  601. FPromptLabels.Add(PromptLabel);
  602. Result := FEdits.Add(Edit);
  603. end;
  604. function TInputFileWizardPage.GetButton(Index: Integer): TNewButton;
  605. begin
  606. Result := TNewButton(FButtons[Index]);
  607. end;
  608. function TInputFileWizardPage.GetEdit(Index: Integer): TEdit;
  609. begin
  610. Result := TEdit(FEdits[Index]);
  611. end;
  612. function TInputFileWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
  613. begin
  614. Result := TNewStaticText(FPromptLabels[Index]);
  615. end;
  616. function TInputFileWizardPage.GetValue(Index: Integer): String;
  617. begin
  618. Result := GetEdit(Index).Text;
  619. end;
  620. procedure TInputFileWizardPage.SetValue(Index: Integer; const Value: String);
  621. begin
  622. GetEdit(Index).Text := Value;
  623. end;
  624. function TInputFileWizardPage.GetIsSaveButton(Index: Integer): Boolean;
  625. begin
  626. Result := GetButton(Index).Tag = 1;
  627. end;
  628. procedure TInputFileWizardPage.SetIsSaveButton(Index: Integer; const IsSaveButton: Boolean);
  629. begin
  630. if IsSaveButton then
  631. GetButton(Index).Tag := 1
  632. else
  633. GetButton(Index).Tag := 0;
  634. end;
  635. {--- OutputMsg ---}
  636. procedure TOutputMsgWizardPage.Initialize(const Msg: String);
  637. begin
  638. FMsgLabel := TNewStaticText.Create(Self);
  639. with FMsgLabel do begin
  640. AutoSize := False;
  641. Width := SurfaceWidth;
  642. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  643. WordWrap := True;
  644. Caption := Msg;
  645. Parent := Surface;
  646. end;
  647. WizardForm.AdjustLabelHeight(MsgLabel);
  648. end;
  649. {--- OutputMsgMemo ---}
  650. procedure TOutputMsgMemoWizardPage.Initialize(const SubCaption: String; const Msg: AnsiString);
  651. var
  652. Y: Integer;
  653. begin
  654. Y := 0;
  655. if SubCaption <> '' then begin
  656. FSubCaptionLabel := TNewStaticText.Create(Self);
  657. with FSubCaptionLabel do begin
  658. AutoSize := False;
  659. Width := SurfaceWidth;
  660. Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
  661. Anchors := [akLeft, akTop, akRight];
  662. WordWrap := True;
  663. Caption := SubCaption;
  664. Parent := Surface;
  665. end;
  666. Inc(Y, WizardForm.ScalePixelsY(DefaultBoxTop) +
  667. WizardForm.AdjustLabelHeight(FSubCaptionLabel));
  668. end else
  669. FSubCaptionLabel := nil;
  670. FRichEditViewer := TRichEditViewer.Create(Self);
  671. with FRichEditViewer do begin
  672. Top := Y;
  673. Width := SurfaceWidth;
  674. Height := WizardForm.ScalePixelsY(DefaultBoxBottom) - Y;
  675. Anchors := [akLeft, akTop, akRight, akBottom];
  676. BevelKind := bkFlat;
  677. BorderStyle := bsNone;
  678. ReadOnly := True;
  679. ScrollBars := ssVertical;
  680. WantReturns := False;
  681. end;
  682. SetCtlParent(FRichEditViewer, Surface);
  683. with FRichEditViewer do begin
  684. UseRichEdit := True;
  685. RTFText := Msg;
  686. end;
  687. end;
  688. {--- OutputProgress ---}
  689. constructor TOutputProgressWizardPage.Create(AOwner: TComponent);
  690. begin
  691. inherited;
  692. Style := Style + [psAlwaysSkip, psNoButtons];
  693. end;
  694. procedure TOutputProgressWizardPage.Initialize;
  695. begin
  696. FMsg1Label := TNewStaticText.Create(Self);
  697. with FMsg1Label do begin
  698. AutoSize := False;
  699. ShowAccelChar := False;
  700. Width := SurfaceWidth;
  701. Anchors := [akLeft, akTop, akRight];
  702. Height := WizardForm.StatusLabel.Height;
  703. WordWrap := WizardForm.StatusLabel.WordWrap;
  704. Parent := Surface;
  705. end;
  706. FMsg2Label := TNewStaticText.Create(Self);
  707. with FMsg2Label do begin
  708. AutoSize := False;
  709. ForceLTRReading := True;
  710. ShowAccelChar := False;
  711. Top := WizardForm.ScalePixelsY(16);
  712. Width := SurfaceWidth;
  713. Height := WizardForm.FileNameLabel.Height;
  714. Anchors := [akLeft, akTop, akRight];
  715. end;
  716. SetCtlParent(FMsg2Label, Surface);
  717. FProgressBar := TNewProgressBar.Create(Self);
  718. with FProgressBar do begin
  719. Top := WizardForm.ScalePixelsY(42);
  720. Width := SurfaceWidth;
  721. Height := WizardForm.ScalePixelsY(21);
  722. Anchors := [akLeft, akTop, akRight];
  723. Visible := False;
  724. end;
  725. SetCtlParent(FProgressBar, Surface);
  726. end;
  727. procedure TOutputProgressWizardPage.Hide;
  728. begin
  729. if (WizardForm.CurPageID = ID) and (FSavePageID <> 0) then begin
  730. SetMessageBoxCallbackFunc(nil, 0);
  731. SetAppTaskbarProgressState(tpsNoProgress);
  732. WizardForm.SetCurPage(FSavePageID);
  733. FSavePageID := 0;
  734. end;
  735. end;
  736. procedure TOutputProgressWizardPage.ProcessMsgs;
  737. { Process messages to repaint and keep Windows from thinking the process is
  738. hung. This is safe; due to the psNoButtons style the user shouldn't be able
  739. to cancel or do anything else during this time. }
  740. begin
  741. if WizardForm.CurPageID = ID then
  742. Application.ProcessMessages;
  743. end;
  744. procedure TOutputProgressWizardPage.SetProgress(const Position, Max: Longint);
  745. begin
  746. if Max > 0 then begin
  747. FProgressBar.Style := npbstNormal;
  748. FProgressBar.Max := Max;
  749. FProgressBar.Position := Position;
  750. FProgressBar.Visible := True;
  751. SetAppTaskbarProgressState(tpsNormal);
  752. SetAppTaskbarProgressValue(Position, Max);
  753. end else begin
  754. if FUseMarqueeStyle then
  755. FProgressBar.Style := npbstMarquee
  756. else
  757. FProgressBar.Visible := False;
  758. SetAppTaskbarProgressState(tpsNoProgress);
  759. end;
  760. ProcessMsgs;
  761. end;
  762. procedure TOutputProgressWizardPage.SetText(const Msg1, Msg2: String);
  763. begin
  764. FMsg1Label.Caption := Msg1;
  765. FMsg2Label.Caption := MinimizePathName(Msg2, FMsg2Label.Font,
  766. FMsg2Label.Width);
  767. ProcessMsgs;
  768. end;
  769. procedure OutputProgressWizardPageMessageBoxCallback(const Flags: LongInt; const After: Boolean;
  770. const Param: LongInt);
  771. const
  772. States: array [TNewProgressBarState] of TTaskbarProgressState =
  773. (tpsNormal, tpsError, tpsPaused);
  774. var
  775. OutputProgressWizardPage: TOutputProgressWizardPage;
  776. NewState: TNewProgressBarState;
  777. begin
  778. OutputProgressWizardPage := TOutputProgressWizardPage(Param);
  779. if After then
  780. NewState := npbsNormal
  781. else if (Flags and MB_ICONSTOP) <> 0 then
  782. NewState := npbsError
  783. else
  784. NewState := npbsPaused;
  785. with OutputProgressWizardPage.ProgressBar do begin
  786. State := NewState;
  787. Invalidate;
  788. end;
  789. SetAppTaskbarProgressState(States[NewState]);
  790. end;
  791. procedure TOutputProgressWizardPage.Show;
  792. begin
  793. if WizardForm.CurPageID <> ID then begin
  794. FSavePageID := WizardForm.CurPageID;
  795. WizardForm.SetCurPage(ID);
  796. SetMessageBoxCallbackFunc(OutputProgressWizardPageMessageBoxCallback, LongInt(Self));
  797. ProcessMsgs;
  798. end;
  799. end;
  800. constructor TOutputMarqueeProgressWizardPage.Create(AOwner: TComponent);
  801. begin
  802. inherited;
  803. FUseMarqueeStyle := True;
  804. end;
  805. procedure TOutputMarqueeProgressWizardPage.Animate;
  806. begin
  807. ProcessMsgs;
  808. end;
  809. procedure TOutputMarqueeProgressWizardPage.Initialize;
  810. begin
  811. inherited;
  812. FProgressBar.Visible := True;
  813. inherited SetProgress(0, 0);
  814. end;
  815. procedure TOutputMarqueeProgressWizardPage.SetProgress(const Position, Max: Longint);
  816. begin
  817. InternalError('Cannot call TOutputMarqueeProgressWizardPage.SetProgress');
  818. end;
  819. {$IFNDEF PS_NOINT64}
  820. {--- OutputDownload ---}
  821. type
  822. TDownloadFile = class
  823. Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
  824. end;
  825. procedure TDownloadWizardPage.AbortButtonClick(Sender: TObject);
  826. begin
  827. FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopDownload], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
  828. end;
  829. function TDownloadWizardPage.InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
  830. var
  831. Progress32, ProgressMax32: LongInt;
  832. begin
  833. if FAbortedByUser then begin
  834. Log('Need to abort download.');
  835. Result := False;
  836. end else begin
  837. if ProgressMax > 0 then
  838. Log(Format(' %d of %d bytes done.', [Progress, ProgressMax]))
  839. else
  840. Log(Format(' %d bytes done.', [Progress]));
  841. FMsg2Label.Caption := Url;
  842. if ProgressMax > MaxLongInt then begin
  843. Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
  844. ProgressMax32 := MaxLongInt;
  845. end else begin
  846. Progress32 := Progress;
  847. ProgressMax32 := ProgressMax;
  848. end;
  849. SetProgress(Progress32, ProgressMax32); { This will process messages which we need for the abort button to work }
  850. if FShowProgressControlsOnNextProgress then begin
  851. ShowProgressControls(True);
  852. FShowProgressControlsOnNextProgress := False;
  853. ProcessMsgs;
  854. end;
  855. if Assigned(FOnDownloadProgress) then
  856. Result := FOnDownloadProgress(Url, BaseName, Progress, ProgressMax)
  857. else
  858. Result := True;
  859. end;
  860. end;
  861. constructor TDownloadWizardPage.Create(AOwner: TComponent);
  862. begin
  863. inherited;
  864. FUseMarqueeStyle := True;
  865. FFiles := TObjectList.Create;
  866. end;
  867. destructor TDownloadWizardPage.Destroy;
  868. begin
  869. FFiles.Free;
  870. inherited;
  871. end;
  872. procedure TDownloadWizardPage.Initialize;
  873. begin
  874. inherited;
  875. FMsg1Label.Caption := SetupMessages[msgDownloadingLabel];
  876. FAbortButton := TNewButton.Create(Self);
  877. with FAbortButton do begin
  878. Caption := SetupMessages[msgButtonStopDownload];
  879. Top := FProgressBar.Top + FProgressBar.Height + WizardForm.ScalePixelsY(8);
  880. Width := WizardForm.CalculateButtonWidth([Caption]);
  881. Anchors := [akLeft, akTop];
  882. Height := WizardForm.CancelButton.Height;
  883. OnClick := AbortButtonClick;
  884. end;
  885. SetCtlParent(FAbortButton, Surface);
  886. end;
  887. procedure TDownloadWizardPage.Show;
  888. begin
  889. if WizardForm.CurPageID <> ID then begin
  890. ShowProgressControls(False);
  891. FShowProgressControlsOnNextProgress := True;
  892. end;
  893. inherited;
  894. end;
  895. procedure TDownloadWizardPage.ShowProgressControls(const AVisible: Boolean);
  896. begin
  897. FMsg2Label.Visible := AVisible;
  898. FProgressBar.Visible := AVisible;
  899. FAbortButton.Visible := AVisible;
  900. end;
  901. procedure TDownloadWizardPage.Add(const Url, BaseName, RequiredSHA256OfFile: String);
  902. begin
  903. AddEx(Url, BaseName, RequiredSHA256OfFile, '', '');
  904. end;
  905. procedure TDownloadWizardPage.AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String);
  906. var
  907. F: TDownloadFile;
  908. begin
  909. F := TDownloadFile.Create;
  910. F.Url := Url;
  911. F.BaseName := BaseName;
  912. F.RequiredSHA256OfFile := RequiredSHA256OfFile;
  913. F.UserName := UserName;
  914. F.Password := Password;
  915. FFiles.Add(F);
  916. end;
  917. procedure TDownloadWizardPage.Clear;
  918. begin
  919. FFiles.Clear;
  920. end;
  921. function TDownloadWizardPage.Download: Int64;
  922. var
  923. F: TDownloadFile;
  924. I: Integer;
  925. begin
  926. FAbortedByUser := False;
  927. Result := 0;
  928. for I := 0 to FFiles.Count-1 do begin
  929. F := TDownloadFile(FFiles[I]);
  930. { Don't need to set DownloadTemporaryFileProcessMessages before downloading since we already process messages ourselves. }
  931. SetDownloadCredentials(F.UserName, F.Password);
  932. Result := Result + DownloadTemporaryFile(F.Url, F.BaseName, F.RequiredSHA256OfFile, InternalOnDownloadProgress);
  933. end;
  934. SetDownloadCredentials('', '');
  935. end;
  936. {$ENDIF}
  937. end.