scriptdlg.pas

源代码

unit ScriptDlg;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Custom wizard pages

  $jrsoftware: issrc/Projects/ScriptDlg.pas,v 1.48 2004/12/16 19:36:06 mlaan Exp $
}

interface

uses
  Classes, Controls, StdCtrls,
  Wizard,
  NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer;

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 SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
      property Values[Index: Integer]: String read GetValue write SetValue;
  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;
      property CheckListBox: TNewCheckListBox read FCheckListBox;
      procedure Initialize(const SubCaption: String; const Exclusive, ListBox: Boolean);
      property SelectedValueIndex: Integer read GetSelectedValueIndex write SetSelectedValueIndex;
      property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
      property Values[Index: Integer]: Boolean read GetValue write SetValue;
  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): TButton;
      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]: TButton 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 SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
      property Values[Index: Integer]: String read GetValue write SetValue;
  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): TButton;
      function GetEdit(Index: Integer): TEdit;
      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, AFilter, ADefaultExtension: String): Integer;
      property Buttons[Index: Integer]: TButton read GetButton;
      property Edits[Index: Integer]: TEdit read GetEdit;
      procedure Initialize(const SubCaption: String);
      property PromptLabels[Index: Integer]: TNewStaticText read GetPromptLabel;
      property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
      property Values[Index: Integer]: String read GetValue write SetValue;
  end;

  TOutputMsgWizardPage = class(TWizardPage)
    private
      FMsgLabel: TNewStaticText;
    public
      procedure Initialize(const Msg: String);
      property MsgLabel: TNewStaticText read FMsgLabel;
  end;

  TOutputMsgMemoWizardPage = class(TWizardPage)
    private
      FRichEditViewer: TRichEditViewer;
      FSubCaptionLabel: TNewStaticText;
    public
      procedure Initialize(const SubCaption, Msg: String);
      property RichEditViewer: TRichEditViewer read FRichEditViewer;
      property SubCaptionLabel: TNewStaticText read FSubCaptionLabel;
  end;

  TOutputProgressWizardPage = class(TWizardPage)
    private
      FMsg1Label: TNewStaticText;
      FMsg2Label: TNewStaticText;
      FProgressBar: TNewProgressBar;
      FSavePageID: Integer;
      procedure ProcessMsgs;
    public
      constructor Create(AOwner: TComponent); override;
      procedure Hide;
      procedure Initialize;
      property Msg1Label: TNewStaticText read FMsg1Label;
      property Msg2Label: TNewStaticText read FMsg2Label;
      property ProgressBar: TNewProgressBar read FProgressBar;
      procedure SetProgress(const Position, Max: Longint);
      procedure SetText(const Msg1, Msg2: String);
      procedure Show;
  end;

implementation

uses
  Forms, Graphics, SysUtils,
  Struct, Main, SelFolderForm, Msgs, MsgIDs, PathFunc, NewDisk, CmnFunc,
  CmnFunc2;

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);
      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;
  end;
  SetCtlParent(Edit, Surface);
  Inc(FY, WizardForm.ScalePixelsY(36));

  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);
    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;
    Flat := ListBox and (shFlatComponentsList in SetupHeader.Options);
  end;
  SetCtlParent(FCheckListBox, Surface);

  FExclusive := Exclusive;
  if not ListBox then begin
    FCheckListBox.BorderStyle := bsNone;
    FCheckListBox.Color := clBtnFace;
    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