| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059 |
- unit ScriptDlg;
- {
- Inno Setup
- Copyright (C) 1997-2012 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Custom wizard pages
- }
- interface
- {$I VERSION.INC}
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Contnrs,
- Wizard, Install,
- NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer,
- BidiCtrls, TaskbarProgressFunc;
- type
- TInputQueryWizardPage = class(TWizardPage)
- private
- FEdits: TList;
- FPromptLabels: TList;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- function GetEdit(Index: Integer): TPasswordEdit;
- function GetPromptLabel(Index: Integer): TNewStaticText;
- function GetValue(Index: Integer): String;
- procedure SetValue(Index: Integer; const Value: String);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt: String; const APassword: Boolean): Integer;
- property Edits[Index: Integer]: TPasswordEdit read GetEdit;
- procedure Initialize(const SubCaption: String);
- property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
- property Values[Index: Integer]: String read GetValue write SetValue;
- published
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TInputOptionWizardPage = class(TWizardPage)
- private
- FCheckListBox: TNewCheckListBox;
- FExclusive: Boolean;
- FSubCaptionLabel: TNewStaticText;
- function GetSelectedValueIndex: Integer;
- function GetValue(Index: Integer): Boolean;
- procedure SetSelectedValueIndex(Value: Integer);
- procedure SetValue(Index: Integer; Value: Boolean);
- public
- function Add(const ACaption: String): Integer;
- function AddEx(const ACaption: String; const ALevel: Byte; const AExclusive: Boolean): Integer;
- procedure Initialize(const SubCaption: String; const Exclusive, ListBox: Boolean);
- property SelectedValueIndex: Integer read GetSelectedValueIndex write SetSelectedValueIndex;
- property Values[Index: Integer]: Boolean read GetValue write SetValue;
- published
- property CheckListBox: TNewCheckListBox read FCheckListBox;
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TInputDirWizardPage = class(TWizardPage)
- private
- FAppendDir: Boolean;
- FButtons: TList;
- FEdits: TList;
- FNewFolderName: String;
- FPromptLabels: TList;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- procedure ButtonClick(Sender: TObject);
- function GetButton(Index: Integer): TNewButton;
- function GetEdit(Index: Integer): TEdit;
- function GetPromptLabel(Index: Integer): TNewStaticText;
- function GetValue(Index: Integer): String;
- procedure SetValue(Index: Integer; const Value: String);
- protected
- procedure NextButtonClick(var Continue: Boolean); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt: String): Integer;
- property Buttons[Index: Integer]: TNewButton read GetButton;
- property Edits[Index: Integer]: TEdit read GetEdit;
- procedure Initialize(const SubCaption: String; const AppendDir: Boolean;
- const NewFolderName: String);
- property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
- property Values[Index: Integer]: String read GetValue write SetValue;
- published
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TInputFileWizardPage = class(TWizardPage)
- private
- FButtons: TList;
- FEdits: TList;
- FInputFileDefaultExtensions: TStringList;
- FInputFileFilters: TStringList;
- FPromptLabels: TList;
- FSubCaptionLabel: TNewStaticText;
- FY: Integer;
- procedure ButtonClick(Sender: TObject);
- function GetButton(Index: Integer): TNewButton;
- function GetEdit(Index: Integer): TEdit;
- function GetPromptLabel(Index: Integer): TNewStaticText;
- function GetValue(Index: Integer): String;
- procedure SetValue(Index: Integer; const Value: String);
- function GetIsSaveButton(Index: Integer): Boolean;
- procedure SetIsSaveButton(Index: Integer; const IsSaveButton: Boolean);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Add(const APrompt, AFilter, ADefaultExtension: String): Integer;
- property Buttons[Index: Integer]: TNewButton read GetButton;
- property Edits[Index: Integer]: TEdit read GetEdit;
- procedure Initialize(const SubCaption: String);
- property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
- property Values[Index: Integer]: String read GetValue write SetValue;
- property IsSaveButton[Index: Integer]: Boolean read GetIsSaveButton write SetIsSaveButton;
- published
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TOutputMsgWizardPage = class(TWizardPage)
- private
- FMsgLabel: TNewStaticText;
- public
- procedure Initialize(const Msg: String);
- published
- property MsgLabel: TNewStaticText read FMsgLabel;
- end;
- TOutputMsgMemoWizardPage = class(TWizardPage)
- private
- FRichEditViewer: TRichEditViewer;
- FSubCaptionLabel: TNewStaticText;
- public
- procedure Initialize(const SubCaption: String; const Msg: AnsiString);
- published
- property RichEditViewer: TRichEditViewer read FRichEditViewer;
- property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
- end;
- TOutputProgressWizardPage = class(TWizardPage)
- private
- FMsg1Label: TNewStaticText;
- FMsg2Label: TNewStaticText;
- FProgressBar: TNewProgressBar;
- FUseMarqueeStyle: Boolean;
- FSavePageID: Integer;
- procedure ProcessMsgs;
- public
- constructor Create(AOwner: TComponent); override;
- procedure Hide;
- procedure Initialize; virtual;
- procedure SetProgress(const Position, Max: Longint);
- procedure SetText(const Msg1, Msg2: String);
- procedure Show; virtual;
- published
- property Msg1Label: TNewStaticText read FMsg1Label;
- property Msg2Label: TNewStaticText read FMsg2Label;
- property ProgressBar: TNewProgressBar read FProgressBar;
- end;
- TOutputMarqueeProgressWizardPage = class(TOutputProgressWizardPage)
- public
- constructor Create(AOwner: TComponent); override;
- procedure Animate;
- procedure Initialize; override;
- procedure SetProgress(const Position, Max: Longint);
- end;
- {$IFNDEF PS_NOINT64}
- TDownloadWizardPage = class(TOutputProgressWizardPage)
- private
- FFiles: TObjectList;
- FOnDownloadProgress: TOnDownloadProgress;
- FAbortButton: TNewButton;
- FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
- procedure AbortButtonClick(Sender: TObject);
- function InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
- procedure ShowProgressControls(const AVisible: Boolean);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Initialize; override;
- property AbortedByUser: Boolean read FAbortedByUser;
- procedure Add(const Url, BaseName, RequiredSHA256OfFile: String);
- procedure AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String);
- procedure Clear;
- function Download: Int64;
- property OnDownloadProgress: TOnDownloadProgress write FOnDownloadProgress;
- procedure Show; override;
- published
- property AbortButton: TNewButton read FAbortButton;
- end;
- {$ENDIF}
-
- implementation
- uses
- Struct, Main, SelFolderForm, Msgs, MsgIDs, PathFunc, CmnFunc, CmnFunc2,
- BrowseFunc, Logging, InstFunc;
- const
- DefaultLabelHeight = 14;
- DefaultBoxTop = 24; { relative to top of InnerNotebook }
- DefaultBoxBottom = DefaultBoxTop + 205;
- {------}
- procedure SetCtlParent(const AControl, AParent: TWinControl);
- { Like assigning to AControl.Parent, but puts the control at the *bottom* of
- the z-order instead of the top, for MSAA compatibility. }
- var
- OldVisible: Boolean;
- begin
- { Hide the control so the handle won't be created yet, so that unnecessary
- "OBJ_REORDER" MSAA events don't get sent }
- OldVisible := AControl.Visible;
- AControl.Visible := False;
- AControl.Parent := AParent;
- AControl.SendToBack;
- AControl.Visible := OldVisible;
- end;
- {--- InputQuery ---}
- constructor TInputQueryWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FEdits := TList.Create;
- FPromptLabels := TList.Create;
- end;
- destructor TInputQueryWizardPage.Destroy;
- begin
- FPromptLabels.Free;
- FEdits.Free;
- inherited;
- end;
- procedure TInputQueryWizardPage.Initialize(const SubCaption: String);
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- end;
- function TInputQueryWizardPage.Add(const APrompt: String;
- const APassword: Boolean): Integer;
- var
- PromptLabel: TNewStaticText;
- Edit: TPasswordEdit;
- begin
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParent(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- Edit := TPasswordEdit.Create(Self);
- with Edit do begin
- Password := APassword;
- Top := FY;
- Width := SurfaceWidth;
- Anchors := [akLeft, akTop, akRight];
- end;
- SetCtlParent(Edit, Surface);
- Inc(FY, WizardForm.ScalePixelsY(36));
- if PromptLabel <> nil then
- PromptLabel.FocusControl := Edit;
- FPromptLabels.Add(PromptLabel);
- Result := FEdits.Add(Edit);
- end;
- function TInputQueryWizardPage.GetEdit(Index: Integer): TPasswordEdit;
- begin
- Result := TPasswordEdit(FEdits[Index]);
- end;
- function TInputQueryWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
- begin
- Result := TNewStaticText(FPromptLabels[Index]);
- end;
- function TInputQueryWizardPage.GetValue(Index: Integer): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputQueryWizardPage.SetValue(Index: Integer; const Value: String);
- begin
- GetEdit(Index).Text := Value;
- end;
- {--- InputOption ---}
- procedure TInputOptionWizardPage.Initialize(const SubCaption: String;
- const Exclusive, ListBox: Boolean);
- var
- CaptionYDiff: Integer;
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with SubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- CaptionYDiff := WizardForm.AdjustLabelHeight(SubCaptionLabel);
- FCheckListBox := TNewCheckListBox.Create(Self);
- with FCheckListBox do begin
- Top := CaptionYDiff + WizardForm.ScalePixelsY(DefaultBoxTop);
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultBoxBottom) - Top;
- Anchors := [akLeft, akTop, akRight, akBottom];
- Flat := ListBox and (shFlatComponentsList in SetupHeader.Options);
- end;
- SetCtlParent(FCheckListBox, Surface);
- FExclusive := Exclusive;
- if not ListBox then begin
- FCheckListBox.BorderStyle := bsNone;
- FCheckListBox.Color := SurfaceColor;
- FCheckListBox.MinItemHeight := WizardForm.ScalePixelsY(22);
- FCheckListBox.WantTabs := True;
- end;
- end;
- function TInputOptionWizardPage.Add(const ACaption: String): Integer;
- begin
- Result := AddEx(ACaption, 0, FExclusive);
- end;
- function TInputOptionWizardPage.AddEx(const ACaption: String;
- const ALevel: Byte; const AExclusive: Boolean): Integer;
- begin
- if AExclusive then
- Result := FCheckListBox.AddRadioButton(ACaption, '', ALevel, False, True, nil)
- else
- Result := FCheckListBox.AddCheckBox(ACaption, '', ALevel, False, True, True,
- True, nil);
- end;
- function TInputOptionWizardPage.GetSelectedValueIndex: Integer;
- var
- I: Integer;
- begin
- for I := 0 to FCheckListBox.Items.Count-1 do
- if (FCheckListBox.ItemLevel[I] = 0) and FCheckListBox.Checked[I] then begin
- Result := I;
- Exit;
- end;
- Result := -1;
- end;
- function TInputOptionWizardPage.GetValue(Index: Integer): Boolean;
- begin
- Result := FCheckListBox.Checked[Index];
- end;
- procedure TInputOptionWizardPage.SetSelectedValueIndex(Value: Integer);
- var
- I: Integer;
- begin
- for I := 0 to FCheckListBox.Items.Count-1 do
- if FCheckListBox.ItemLevel[I] = 0 then
- FCheckListBox.Checked[I] := (I = Value);
- end;
- procedure TInputOptionWizardPage.SetValue(Index: Integer; Value: Boolean);
- begin
- FCheckListBox.Checked[Index] := Value;
- end;
- {--- InputDir ---}
- constructor TInputDirWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FButtons := TList.Create;
- FEdits := TList.Create;
- FPromptLabels := TList.Create;
- end;
- destructor TInputDirWizardPage.Destroy;
- begin
- FPromptLabels.Free;
- FEdits.Free;
- FButtons.Free;
- inherited;
- end;
- procedure TInputDirWizardPage.ButtonClick(Sender: TObject);
- var
- I: Integer;
- Edit: TEdit;
- S: String;
- begin
- I := FButtons.IndexOf(Sender);
- if I <> -1 then begin
- Edit := TEdit(FEdits[I]);
- S := Edit.Text;
- if ShowSelectFolderDialog(False, FAppendDir, S, FNewFolderName) then
- Edit.Text := S;
- end;
- end;
- procedure TInputDirWizardPage.NextButtonClick(var Continue: Boolean);
- var
- I: Integer;
- Edit: TEdit;
- begin
- for I := 0 to FEdits.Count-1 do begin
- Edit := FEdits[I];
- if not ValidateCustomDirEdit(Edit, True, True, True) then begin
- if WizardForm.Visible then
- Edit.SetFocus;
- Continue := False;
- Exit;
- end;
- end;
- inherited;
- end;
- procedure TInputDirWizardPage.Initialize(const SubCaption: String;
- const AppendDir: Boolean; const NewFolderName: String);
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- FAppendDir := AppendDir;
- FNewFolderName := NewFolderName;
- end;
- function TInputDirWizardPage.Add(const APrompt: String): Integer;
- var
- ButtonWidth: Integer;
- PromptLabel: TNewStaticText;
- Edit: TEdit;
- Button: TNewButton;
- begin
- ButtonWidth := WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParent(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- Edit := TEdit.Create(Self);
- with Edit do begin
- Top := FY;
- Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
- Anchors := [akLeft, akTop, akRight];
- end;
- SetCtlParent(Edit, Surface);
- TryEnableAutoCompleteFileSystem(Edit.Handle);
- if PromptLabel <> nil then
- PromptLabel.FocusControl := Edit;
- Button := TNewButton.Create(Self);
- with Button do begin
- Left := SurfaceWidth-ButtonWidth;
- Top := Edit.Top-1;
- Width := ButtonWidth;
- Height := WizardForm.NextButton.Height;
- Anchors := [akTop, akRight];
- if FEdits.Count = 0 then
- Caption := SetupMessages[msgButtonWizardBrowse]
- else
- { Can't use the same accel key for secondary buttons... }
- Caption := RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]);
- OnClick := ButtonClick;
- end;
- SetCtlParent(Button, Surface);
- Inc(FY, WizardForm.ScalePixelsY(36));
- FButtons.Add(Button);
- FPromptLabels.Add(PromptLabel);
- Result := FEdits.Add(Edit);
- end;
- function TInputDirWizardPage.GetButton(Index: Integer): TNewButton;
- begin
- Result := TNewButton(FButtons[Index]);
- end;
- function TInputDirWizardPage.GetEdit(Index: Integer): TEdit;
- begin
- Result := TEdit(FEdits[Index]);
- end;
- function TInputDirWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
- begin
- Result := TNewStaticText(FPromptLabels[Index]);
- end;
- function TInputDirWizardPage.GetValue(Index: Integer): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputDirWizardPage.SetValue(Index: Integer; const Value: String);
- begin
- GetEdit(Index).Text := RemoveBackslashUnlessRoot(PathExpand(Value));
- end;
- {--- InputFile ---}
- constructor TInputFileWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FButtons := TList.Create;
- FEdits := TList.Create;
- FInputFileDefaultExtensions := TStringList.Create;
- FInputFileFilters := TStringList.Create;
- FPromptLabels := TList.Create;
- end;
- destructor TInputFileWizardPage.Destroy;
- begin
- FPromptLabels.Free;
- FInputFileFilters.Free;
- FInputFileDefaultExtensions.Free;
- FEdits.Free;
- FButtons.Free;
- inherited;
- end;
- procedure TInputFileWizardPage.ButtonClick(Sender: TObject);
- var
- I: Integer;
- Edit: TEdit;
- FileName: String;
- begin
- I := FButtons.IndexOf(Sender);
- if I <> -1 then begin
- Edit := TEdit(FEdits[I]);
- FileName := Edit.Text;
- if (not IsSaveButton[I] and NewGetOpenFileName(RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]),
- FileName, PathExtractPath(FileName), FInputFileFilters[I],
- FInputFileDefaultExtensions[I], Surface.Handle)) or
- (IsSaveButton[I] and NewGetSaveFileName(RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]),
- FileName, PathExtractPath(FileName), FInputFileFilters[I],
- FInputFileDefaultExtensions[I], Surface.Handle)) then
- Edit.Text := FileName;
- end;
- end;
- procedure TInputFileWizardPage.Initialize(const SubCaption: String);
- begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- FY := WizardForm.AdjustLabelHeight(FSubCaptionLabel) + WizardForm.ScalePixelsY(DefaultBoxTop);
- end;
- function TInputFileWizardPage.Add(const APrompt, AFilter,
- ADefaultExtension: String): Integer;
- var
- ButtonWidth: Integer;
- PromptLabel: TNewStaticText;
- Edit: TEdit;
- Button: TNewButton;
- begin
- ButtonWidth := WizardForm.CalculateButtonWidth([SetupMessages[msgButtonWizardBrowse]]);
- if APrompt <> '' then begin
- PromptLabel := TNewStaticText.Create(Self);
- with PromptLabel do begin
- AutoSize := False;
- Top := FY;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := APrompt;
- end;
- SetCtlParent(PromptLabel, Surface);
- Inc(FY, WizardForm.AdjustLabelHeight(PromptLabel) + WizardForm.ScalePixelsY(16));
- end else
- PromptLabel := nil;
- Edit := TEdit.Create(Self);
- with Edit do begin
- Top := FY;
- Width := SurfaceWidth-ButtonWidth-WizardForm.ScalePixelsX(10);
- Anchors := [akLeft, akTop, akRight];
- end;
- SetCtlParent(Edit, Surface);
- TryEnableAutoCompleteFileSystem(Edit.Handle);
- if PromptLabel <> nil then
- PromptLabel.FocusControl := Edit;
- Button := TNewButton.Create(Self);
- with Button do begin
- Left := SurfaceWidth-ButtonWidth;
- Top := Edit.Top-1;
- Width := ButtonWidth;
- Height := WizardForm.NextButton.Height;
- Anchors := [akTop, akRight];
- if FButtons.Count = 0 then
- Caption := SetupMessages[msgButtonWizardBrowse]
- else
- { Can't use the same accel key for secondary buttons... }
- Caption := RemoveAccelChar(SetupMessages[msgButtonWizardBrowse]);
- OnClick := ButtonClick;
- end;
- SetCtlParent(Button, Surface);
- Inc(FY, WizardForm.ScalePixelsY(36));
- FInputFileFilters.Add(AFilter);
- FInputFileDefaultExtensions.Add(ADefaultExtension);
- FButtons.Add(Button);
- FPromptLabels.Add(PromptLabel);
- Result := FEdits.Add(Edit);
- end;
- function TInputFileWizardPage.GetButton(Index: Integer): TNewButton;
- begin
- Result := TNewButton(FButtons[Index]);
- end;
- function TInputFileWizardPage.GetEdit(Index: Integer): TEdit;
- begin
- Result := TEdit(FEdits[Index]);
- end;
- function TInputFileWizardPage.GetPromptLabel(Index: Integer): TNewStaticText;
- begin
- Result := TNewStaticText(FPromptLabels[Index]);
- end;
- function TInputFileWizardPage.GetValue(Index: Integer): String;
- begin
- Result := GetEdit(Index).Text;
- end;
- procedure TInputFileWizardPage.SetValue(Index: Integer; const Value: String);
- begin
- GetEdit(Index).Text := Value;
- end;
- function TInputFileWizardPage.GetIsSaveButton(Index: Integer): Boolean;
- begin
- Result := GetButton(Index).Tag = 1;
- end;
- procedure TInputFileWizardPage.SetIsSaveButton(Index: Integer; const IsSaveButton: Boolean);
- begin
- if IsSaveButton then
- GetButton(Index).Tag := 1
- else
- GetButton(Index).Tag := 0;
- end;
- {--- OutputMsg ---}
- procedure TOutputMsgWizardPage.Initialize(const Msg: String);
- begin
- FMsgLabel := TNewStaticText.Create(Self);
- with FMsgLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- WordWrap := True;
- Caption := Msg;
- Parent := Surface;
- end;
- WizardForm.AdjustLabelHeight(MsgLabel);
- end;
- {--- OutputMsgMemo ---}
- procedure TOutputMsgMemoWizardPage.Initialize(const SubCaption: String; const Msg: AnsiString);
- var
- Y: Integer;
- begin
- Y := 0;
- if SubCaption <> '' then begin
- FSubCaptionLabel := TNewStaticText.Create(Self);
- with FSubCaptionLabel do begin
- AutoSize := False;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultLabelHeight);
- Anchors := [akLeft, akTop, akRight];
- WordWrap := True;
- Caption := SubCaption;
- Parent := Surface;
- end;
- Inc(Y, WizardForm.ScalePixelsY(DefaultBoxTop) +
- WizardForm.AdjustLabelHeight(FSubCaptionLabel));
- end else
- FSubCaptionLabel := nil;
- FRichEditViewer := TRichEditViewer.Create(Self);
- with FRichEditViewer do begin
- Top := Y;
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(DefaultBoxBottom) - Y;
- Anchors := [akLeft, akTop, akRight, akBottom];
- BevelKind := bkFlat;
- BorderStyle := bsNone;
- ReadOnly := True;
- ScrollBars := ssVertical;
- WantReturns := False;
- end;
- SetCtlParent(FRichEditViewer, Surface);
- with FRichEditViewer do begin
- UseRichEdit := True;
- RTFText := Msg;
- end;
- end;
- {--- OutputProgress ---}
- constructor TOutputProgressWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- Style := Style + [psAlwaysSkip, psNoButtons];
- end;
- procedure TOutputProgressWizardPage.Initialize;
- begin
- FMsg1Label := TNewStaticText.Create(Self);
- with FMsg1Label do begin
- AutoSize := False;
- ShowAccelChar := False;
- Width := SurfaceWidth;
- Anchors := [akLeft, akTop, akRight];
- Height := WizardForm.StatusLabel.Height;
- WordWrap := WizardForm.StatusLabel.WordWrap;
- Parent := Surface;
- end;
- FMsg2Label := TNewStaticText.Create(Self);
- with FMsg2Label do begin
- AutoSize := False;
- ForceLTRReading := True;
- ShowAccelChar := False;
- Top := WizardForm.ScalePixelsY(16);
- Width := SurfaceWidth;
- Height := WizardForm.FileNameLabel.Height;
- Anchors := [akLeft, akTop, akRight];
- end;
- SetCtlParent(FMsg2Label, Surface);
- FProgressBar := TNewProgressBar.Create(Self);
- with FProgressBar do begin
- Top := WizardForm.ScalePixelsY(42);
- Width := SurfaceWidth;
- Height := WizardForm.ScalePixelsY(21);
- Anchors := [akLeft, akTop, akRight];
- Visible := False;
- end;
- SetCtlParent(FProgressBar, Surface);
- end;
- procedure TOutputProgressWizardPage.Hide;
- begin
- if (WizardForm.CurPageID = ID) and (FSavePageID <> 0) then begin
- SetMessageBoxCallbackFunc(nil, 0);
- SetAppTaskbarProgressState(tpsNoProgress);
- WizardForm.SetCurPage(FSavePageID);
- FSavePageID := 0;
- end;
- end;
- procedure TOutputProgressWizardPage.ProcessMsgs;
- { Process messages to repaint and keep Windows from thinking the process is
- hung. This is safe; due to the psNoButtons style the user shouldn't be able
- to cancel or do anything else during this time. }
- begin
- if WizardForm.CurPageID = ID then
- Application.ProcessMessages;
- end;
- procedure TOutputProgressWizardPage.SetProgress(const Position, Max: Longint);
- begin
- if Max > 0 then begin
- FProgressBar.Style := npbstNormal;
- FProgressBar.Max := Max;
- FProgressBar.Position := Position;
- FProgressBar.Visible := True;
- SetAppTaskbarProgressState(tpsNormal);
- SetAppTaskbarProgressValue(Position, Max);
- end else begin
- if FUseMarqueeStyle then
- FProgressBar.Style := npbstMarquee
- else
- FProgressBar.Visible := False;
- SetAppTaskbarProgressState(tpsNoProgress);
- end;
- ProcessMsgs;
- end;
- procedure TOutputProgressWizardPage.SetText(const Msg1, Msg2: String);
- begin
- FMsg1Label.Caption := Msg1;
- FMsg2Label.Caption := MinimizePathName(Msg2, FMsg2Label.Font,
- FMsg2Label.Width);
- ProcessMsgs;
- end;
- procedure OutputProgressWizardPageMessageBoxCallback(const Flags: LongInt; const After: Boolean;
- const Param: LongInt);
- const
- States: array [TNewProgressBarState] of TTaskbarProgressState =
- (tpsNormal, tpsError, tpsPaused);
- var
- OutputProgressWizardPage: TOutputProgressWizardPage;
- NewState: TNewProgressBarState;
- begin
- OutputProgressWizardPage := TOutputProgressWizardPage(Param);
- if After then
- NewState := npbsNormal
- else if (Flags and MB_ICONSTOP) <> 0 then
- NewState := npbsError
- else
- NewState := npbsPaused;
- with OutputProgressWizardPage.ProgressBar do begin
- State := NewState;
- Invalidate;
- end;
- SetAppTaskbarProgressState(States[NewState]);
- end;
- procedure TOutputProgressWizardPage.Show;
- begin
- if WizardForm.CurPageID <> ID then begin
- FSavePageID := WizardForm.CurPageID;
- WizardForm.SetCurPage(ID);
- SetMessageBoxCallbackFunc(OutputProgressWizardPageMessageBoxCallback, LongInt(Self));
- ProcessMsgs;
- end;
- end;
- constructor TOutputMarqueeProgressWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FUseMarqueeStyle := True;
- end;
- procedure TOutputMarqueeProgressWizardPage.Animate;
- begin
- ProcessMsgs;
- end;
- procedure TOutputMarqueeProgressWizardPage.Initialize;
- begin
- inherited;
- FProgressBar.Visible := True;
- inherited SetProgress(0, 0);
- end;
- procedure TOutputMarqueeProgressWizardPage.SetProgress(const Position, Max: Longint);
- begin
- InternalError('Cannot call TOutputMarqueeProgressWizardPage.SetProgress');
- end;
- {$IFNDEF PS_NOINT64}
- {--- OutputDownload ---}
- type
- TDownloadFile = class
- Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
- end;
- procedure TDownloadWizardPage.AbortButtonClick(Sender: TObject);
- begin
- FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopDownload], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
- end;
- function TDownloadWizardPage.InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
- var
- Progress32, ProgressMax32: LongInt;
- begin
- if FAbortedByUser then begin
- Log('Need to abort download.');
- Result := False;
- end else begin
- if ProgressMax > 0 then
- Log(Format(' %d of %d bytes done.', [Progress, ProgressMax]))
- else
- Log(Format(' %d bytes done.', [Progress]));
- FMsg2Label.Caption := Url;
- if ProgressMax > MaxLongInt then begin
- Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
- ProgressMax32 := MaxLongInt;
- end else begin
- Progress32 := Progress;
- ProgressMax32 := ProgressMax;
- end;
- SetProgress(Progress32, ProgressMax32); { This will process messages which we need for the abort button to work }
- if FShowProgressControlsOnNextProgress then begin
- ShowProgressControls(True);
- FShowProgressControlsOnNextProgress := False;
- ProcessMsgs;
- end;
- if Assigned(FOnDownloadProgress) then
- Result := FOnDownloadProgress(Url, BaseName, Progress, ProgressMax)
- else
- Result := True;
- end;
- end;
- constructor TDownloadWizardPage.Create(AOwner: TComponent);
- begin
- inherited;
- FUseMarqueeStyle := True;
- FFiles := TObjectList.Create;
- end;
- destructor TDownloadWizardPage.Destroy;
- begin
- FFiles.Free;
- inherited;
- end;
- procedure TDownloadWizardPage.Initialize;
- begin
- inherited;
- FMsg1Label.Caption := SetupMessages[msgDownloadingLabel];
- FAbortButton := TNewButton.Create(Self);
- with FAbortButton do begin
- Caption := SetupMessages[msgButtonStopDownload];
- Top := FProgressBar.Top + FProgressBar.Height + WizardForm.ScalePixelsY(8);
- Width := WizardForm.CalculateButtonWidth([Caption]);
- Anchors := [akLeft, akTop];
- Height := WizardForm.CancelButton.Height;
- OnClick := AbortButtonClick;
- end;
- SetCtlParent(FAbortButton, Surface);
- end;
- procedure TDownloadWizardPage.Show;
- begin
- if WizardForm.CurPageID <> ID then begin
- ShowProgressControls(False);
- FShowProgressControlsOnNextProgress := True;
- end;
- inherited;
- end;
- procedure TDownloadWizardPage.ShowProgressControls(const AVisible: Boolean);
- begin
- FMsg2Label.Visible := AVisible;
- FProgressBar.Visible := AVisible;
- FAbortButton.Visible := AVisible;
- end;
- procedure TDownloadWizardPage.Add(const Url, BaseName, RequiredSHA256OfFile: String);
- begin
- AddEx(Url, BaseName, RequiredSHA256OfFile, '', '');
- end;
- procedure TDownloadWizardPage.AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String);
- var
- F: TDownloadFile;
- begin
- F := TDownloadFile.Create;
- F.Url := Url;
- F.BaseName := BaseName;
- F.RequiredSHA256OfFile := RequiredSHA256OfFile;
- F.UserName := UserName;
- F.Password := Password;
- FFiles.Add(F);
- end;
- procedure TDownloadWizardPage.Clear;
- begin
- FFiles.Clear;
- end;
- function TDownloadWizardPage.Download: Int64;
- var
- F: TDownloadFile;
- I: Integer;
- begin
- FAbortedByUser := False;
-
- Result := 0;
- for I := 0 to FFiles.Count-1 do begin
- F := TDownloadFile(FFiles[I]);
- { Don't need to set DownloadTemporaryFileProcessMessages before downloading since we already process messages ourselves. }
- SetDownloadCredentials(F.UserName, F.Password);
- Result := Result + DownloadTemporaryFile(F.Url, F.BaseName, F.RequiredSHA256OfFile, InternalOnDownloadProgress);
- end;
- SetDownloadCredentials('', '');
- end;
- {$ENDIF}
- end.
|