wizard.pas

源代码

      Inc(P);
    if HasDots and ((P^ = '\') or (P^ = #0)) then begin
      Result := True;
      Exit;
    end;
    { Skip to next component }
    while (P^ <> #0) and (P^ <> '\') do
      P := CharNext(P);
    if P^ = '\' then
      Inc(P);
  end;
  Result := False;
end;

function SpaceString(const S: String): String;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(S) do begin
    if S[I] = ' ' then Continue;
    if Result <> '' then Result := Result + ' ';
    Result := Result + S[I];
  end;
end;

function TWizardForm.AdjustLabelHeight(const ALabel: TNewStaticText): Integer;
{ Increases or decreases a label's height so that all text fits.
  Returns the difference in height. }
var
  W, H: Integer;
begin
  W := ALabel.Width;
  H := ALabel.Height;
  ALabel.AutoSize := True;
  ALabel.AutoSize := False;
  ALabel.Width := W;
  Result := ALabel.Height - H;
end;

procedure TWizardForm.IncTopDecHeight(const AControl: TControl; const Amount: Integer);
begin
  AControl.SetBounds(AControl.Left, AControl.Top + Amount,
    AControl.Width, AControl.Height - Amount);
end;

function TWizardForm.CheckSerialOk(): Boolean;
begin
  if NeedSerial and (CodeRunner <> nil) then begin
    WizardUserInfoName := UserInfoNameEdit.Text;
    WizardUserInfoOrg := UserInfoOrgEdit.Text;
    WizardUserInfoSerial := UserInfoSerialEdit.Text;
    Result := CodeRunner.RunBooleanFunction('CheckSerial', [UserInfoSerialEdit.Text], True, False)
  end else
    Result := True;
end;

procedure TWizardForm.CalcCurrentComponentsSpace();
var
  SelectedComponents: TStringList;
  I: Integer;
  CurFile: PSetupFileEntry;
begin
  CurrentComponentsSpace := SetupHeader.ExtraDiskSpaceRequired;

  SelectedComponents := TStringList.Create();
  GetSelectedComponents(SelectedComponents, False, False);

  //we can't simply sum component sizes because of shared files -> add file sizes
  for I := 0 to Entries[seFile].Count-1 do begin
    CurFile := PSetupFileEntry(Entries[seFile][I]);
    if ShouldProcessFileEntry(SelectedComponents, nil, CurFile, True) then begin
      with CurFile^ do begin
        if LocationEntry <> -1 then
          Inc6464(CurrentComponentsSpace, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
        else
          Inc6464(CurrentComponentsSpace, ExternalSize)
      end;
    end;
  end;

  //don't forget to add extradiskspacerequired values
  for I := 0 to Entries[seComponent].Count-1 do
    with PSetupComponentEntry(Entries[seComponent][I])^ do
      if ListContains(SelectedComponents, Name) then
        Inc6464(CurrentComponentsSpace, ExtraDiskSpaceRequired);

  SelectedComponents.Free();

  ComponentsDiskSpaceLabel.Caption := ExpandSetupMessageEx(msgComponentsDiskSpaceMBLabel,
    CurrentComponentsSpace);
end;

procedure TWizardForm.UpdateComponentSizesEnum(Index: Integer; HasChildren: Boolean; Ext: LongInt);
var
  ComponentEntry: PSetupComponentEntry;
  ComponentSize, ChildrenSize: Integer64;
begin
  ComponentEntry := PSetupComponentEntry(ComponentsList.ItemObject[Index]);

  ChildrenSize.Hi := 0;
  ChildrenSize.Lo := 0;
  if HasChildren then
    ComponentsList.EnumChildrenOf(Index, UpdateComponentSizesEnum, LongInt(@ChildrenSize));
  ComponentSize := ComponentEntry.Size;
  Inc6464(ComponentSize, ChildrenSize);
  if ComponentsList.Checked[Index] then
    Inc6464(Integer64(Pointer(Ext)^), ComponentSize);

  if (ComponentSize.Lo <> 0) or (ComponentSize.Hi <> 0) then begin
    if (MaxComponentSize.Hi = 0) and (MaxComponentSize.Lo < 1024*1024) then
      ComponentsList.ItemSubItem[Index] := FmtSetupMessage1(msgComponentSize1, IntToKBStr(ComponentSize))
    else
      ComponentsList.ItemSubItem[Index] := FmtSetupMessage1(msgComponentSize2, IntToMBStr(ComponentSize));
  end else
    ComponentsList.ItemSubItem[Index] := '';
end;

procedure TWizardForm.UpdateComponentSizes();
var
  Size: Integer64;
begin
  if shShowComponentSizes in SetupHeader.Options then begin
    Size.Hi := 0;
    Size.Lo := 0;
    ComponentsList.EnumChildrenOf(-1, UpdateComponentSizesEnum, LongInt(@Size));
  end;
end;

{ TWizardPage }

constructor TWizardPage.Create(AOwner: TComponent);
begin
  inherited;
  FWizardForm := AOwner as TWizardForm;
end;

destructor TWizardPage.Destroy;
begin
  if Assigned(FWizardForm) and Assigned(FWizardForm.FPageList) then
    FWizardForm.FPageList.Remove(Self);
  inherited;
end;

procedure TWizardPage.Activate;
begin
  if Assigned(FOnActivate) then
    FOnActivate(Self);
end;

procedure TWizardPage.BackButtonClick(var AContinue: Boolean);
begin
  if Assigned(FOnBackButtonClick) then
    AContinue := FOnBackButtonClick(Self);
end;

procedure TWizardPage.CancelButtonClick(var ACancel, AConfirm: Boolean);
begin
  if Assigned(FOnCancelButtonClick) then
    FOnCancelButtonClick(Self, ACancel, AConfirm);
end;

procedure TWizardPage.NextButtonClick(var AContinue: Boolean);
begin
  if Assigned(FOnNextButtonClick) then
    AContinue := FOnNextButtonClick(Self);
end;

procedure TWizardPage.ShouldSkipPage(var AShouldSkip: Boolean);
begin
  if Assigned(FOnShouldSkipPage) then
    AShouldSkip := FOnShouldSkipPage(Self);
end;

function TWizardPage.GetSurface: TNewNotebookPage;
begin
  if FOuterNotebookPage = FWizardForm.InnerPage then
    Result := FInnerNotebookPage
  else
    Result := FOuterNotebookPage;
end;

function TWizardPage.GetSurfaceHeight: Integer;
begin
  Result := Surface.Parent.Height;
end;

function TWizardPage.GetSurfaceWidth: Integer;
begin
  Result := Surface.Parent.Width;
end;

procedure TWizardPage.SetCaption(const Value: String);
begin
  FCaption := Value;
  SyncCaptionAndDescription;
end;

procedure TWizardPage.SetDescription(const Value: String);
begin
  FDescription := Value;
  SyncCaptionAndDescription;
end;

procedure TWizardPage.SyncCaptionAndDescription;
begin
  if FWizardForm.CurPageID = FID then begin
    FWizardForm.PageNameLabel.Caption := FCaption;
    FWizardForm.PageDescriptionLabel.Caption := FDescription;
  end;
end;

{ TWizardForm }

constructor TWizardForm.Create(AOwner: TComponent);
{ Do all initialization of the wizard form. We're overriding Create instead of
  using the FormCreate event, because if an exception is raised in FormCreate
  it's not propogated out. }

  procedure LoadSelectDirAndGroupImages;

    procedure IconToBitmapImage(const AIcon: HICON; const Ctl: TBitmapImage);
    begin
      if AIcon <> 0 then begin
        try
          with Ctl.Bitmap do begin
            Width := 32;
            Height := 32;
            Canvas.Brush.Color := clBtnFace;
            Canvas.FillRect(Rect(0, 0, 32, 32));
            DrawIconEx(Canvas.Handle, 0, 0, AIcon, 32, 32, 0, 0, DI_NORMAL);
          end;
        finally
          DestroyIcon(AIcon);
        end;
      end;
    end;

  var
    FileInfo: TSHFileInfo;
    Path: String;
  begin
    { Set sizes (overrides any scaling) }
    SelectDirBitmapImage.Width := 32;
    SelectDirBitmapImage.Height := 32;
    SelectGroupBitmapImage.Width := 32;
    SelectGroupBitmapImage.Height := 32;

    try
      { We have to extract the icons ourself using ExtractIcon because the
        icons SHGetFileInfo returns differ in size depending on whether
        "Use large icons" is turned on, and we don't want that.
        Note: We *could* avoid SHGetFileInfo altogether and pass 'shell32.dll'
        and a hard-coded index directly to ExtractIcon, but I'm worried that
        might not work in a future Windows version. }
      if (SHGetFileInfo('c:\directory', FILE_ATTRIBUTE_DIRECTORY, FileInfo,
          SizeOf(FileInfo), SHGFI_USEFILEATTRIBUTES or SHGFI_ICONLOCATION) <> 0) and
         (FileInfo.szDisplayName[0] <> #0) then
        IconToBitmapImage(ExtractIcon(HInstance, FileInfo.szDisplayName,
          FileInfo.iIcon), SelectDirBitmapImage);

      Path := GetRealShellFolder(False, sfPrograms, False);
      if Path = '' then
        Path := GetRealShellFolder(True, sfPrograms, False);
      if Path <> '' then begin
        if (SHGetFileInfo(PChar(Path), 0, FileInfo, SizeOf(FileInfo),
            SHGFI_ICONLOCATION) <> 0) and (FileInfo.szDisplayName[0] <> #0) then
          IconToBitmapImage(ExtractIcon(HInstance, FileInfo.szDisplayName,
            FileInfo.iIcon), SelectGroupBitmapImage);
      end;
    except
      { ignore any exceptions }
    end;
  end;

var
  X, W1, W2: Integer;
  SystemMenu: HMENU;
  P: String;
  I, PrevSetupTypeIndex: Integer;
  TypeEntry: PSetupTypeEntry;
  ComponentEntry: PSetupComponentEntry;
  SaveClientWidth, SaveClientHeight: Integer;
begin
  inherited;

  FPageList := TList.Create;
  InitialSelectedComponents := TStringList.Create();
  PrevSelectedComponents := TStringList.Create();
  PrevDeselectedComponents := TStringList.Create();
  PrevSelectedTasks := TStringList.Create();
  PrevDeselectedTasks := TStringList.Create();

  { Prior to scaling the form, shrink WizardSmallBitmapImage if it's currently
    larger than WizardSmallImage. This way, stretching will not occur if the
    user specifies a smaller-than-default image and WizardImageStretch=yes,
    except if the form has to be scaled (e.g. due to Large Fonts). }
  I := WizardSmallBitmapImage.Height - WizardSmallImage.Height;
  if I > 0 then begin
    WizardSmallBitmapImage.Height := WizardSmallBitmapImage.Height - I;
    WizardSmallBitmapImage.Top := WizardSmallBitmapImage.Top + (I div 2);
  end;
  I := WizardSmallBitmapImage.Width - WizardSmallImage.Width;
  if I > 0 then begin
    WizardSmallBitmapImage.Width := WizardSmallBitmapImage.Width - I;
    WizardSmallBitmapImage.Left := WizardSmallBitmapImage.Left + (I div 2);
  end;

  InitializeFont;
  if shWindowVisible in SetupHeader.Options then
    CenterInsideControl(MainForm, True)
  else
    Center;
  SetFontNameSize(WelcomeLabel1.Font, LangOptions.WelcomeFontName,
    LangOptions.WelcomeFontSize, '', 12);
  WelcomeLabel1.Font.Style := [fsBold];
  PageNameLabel.Font.Style := [fsBold];

  if shWindowVisible in SetupHeader.Options then
    Caption := SetupMessages[msgSetupAppTitle]
  else
    Caption := FmtSetupMessage1(msgSetupWindowTitle, ExpandedAppName);

  { Give it a minimize button if main window isn't visible }
  if not(shWindowVisible in SetupHeader.Options) then begin
    { Save ClientWidth/ClientHeight and restore them after changing
      BorderStyle. Needed for NT 3.x. }
    SaveClientWidth := ClientWidth;
    SaveClientHeight := ClientHeight;
    BorderIcons := BorderIcons + [biMinimize];
    BorderStyle := bsSingle;
    ClientWidth := SaveClientWidth;
    ClientHeight := SaveClientHeight;
  end;

  { Position the buttons, and scale their size }
  W1 := CalculateButtonWidth([msgButtonBack, msgButtonCancel, msgButtonFinish,
    msgButtonInstall, msgButtonNext]);  { width of each button }
  W2 := ScalePixelsX(10);  { margin, and space between Next & Cancel }

  BackButton.Width := W1;
  NextButton.Width := W1;
  CancelButton.Width := W1;
  X := ClientWidth - W2 - W1;
  CancelButton.Left := X;
  Dec(X, W2);
  Dec(X, W1);
  NextButton.Left := X;
  Dec(X, W1);
  BackButton.Left := X;