| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206 |
- unit Setup.UninstallProgressForm;
- {
- Inno Setup
- Copyright (C) 1997-2025 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Uninstaller progress form
- }
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- Setup.SetupForm, StdCtrls, ExtCtrls, BitmapImage, NewProgressBar, NewStaticText,
- NewNotebook, NewCtrls;
- type
- TUninstallProgressForm = class(TSetupForm)
- FOuterNotebook: TNewNotebook;
- FInnerPage: TNewNotebookPage;
- FInnerNotebook: TNewNotebook;
- FInstallingPage: TNewNotebookPage;
- FMainPanel: TPanel;
- FPageNameLabel: TNewStaticText;
- FPageDescriptionLabel: TNewStaticText;
- FWizardSmallBitmapImage: TBitmapImage;
- FBevel1: TBevel;
- FStatusLabel: TNewStaticText;
- FProgressBar: TNewProgressBar;
- FBeveledLabel: TNewStaticText;
- FBevel: TBevel;
- FCancelButton: TNewButton;
- protected
- procedure CreateParams(var Params: TCreateParams); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Initialize(const ATitle, AAppName: String);
- procedure UpdateProgress(const AProgress, ARange: Integer);
- published
- property OuterNotebook: TNewNotebook read FOuterNotebook;
- property InnerPage: TNewNotebookPage read FInnerPage;
- property InnerNotebook: TNewNotebook read FInnerNotebook;
- property InstallingPage: TNewNotebookPage read FInstallingPage;
- property MainPanel: TPanel read FMainPanel;
- property PageNameLabel: TNewStaticText read FPageNameLabel;
- property PageDescriptionLabel: TNewStaticText read FPageDescriptionLabel;
- property WizardSmallBitmapImage: TBitmapImage read FWizardSmallBitmapImage;
- property Bevel1: TBevel read FBevel1;
- property StatusLabel: TNewStaticText read FStatusLabel;
- property ProgressBar: TNewProgressBar read FProgressBar;
- property BeveledLabel: TNewStaticText read FBeveledLabel;
- property Bevel: TBevel read FBevel;
- property CancelButton: TNewButton read FCancelButton;
- end;
- var
- UninstallProgressForm: TUninstallProgressForm;
- implementation
- uses
- Themes,
- TaskbarProgressFunc,
- Shared.SetupMessageIDs, Shared.CommonFunc.Vcl, Shared.Struct,
- SetupLdrAndSetup.Messages,
- Setup.MainForm, Setup.MainFunc, Setup.InstFunc;
- {$R *.DFM}
- { TUninstallProgressForm }
- procedure UninstallMessageBoxCallback(const Flags: Cardinal; const After: Boolean;
- const Param: LongInt);
- const
- States: array [TNewProgressBarState] of TTaskbarProgressState =
- (tpsNormal, tpsError, tpsPaused);
- var
- UninstallProgressForm: TUninstallProgressForm;
- NewState: TNewProgressBarState;
- begin
- UninstallProgressForm := TUninstallProgressForm(Param);
- if After then
- NewState := npbsNormal
- else if (Flags and MB_ICONSTOP) <> 0 then
- NewState := npbsError
- else
- NewState := npbsPaused;
- with UninstallProgressForm.ProgressBar do begin
- State := NewState;
- Invalidate;
- end;
- SetAppTaskbarProgressState(States[NewState]);
- end;
- constructor TUninstallProgressForm.Create(AOwner: TComponent);
- begin
- inherited;
- SetMessageBoxCallbackFunc(UninstallMessageBoxCallback, LongInt(Self));
- var LStyle := StyleServices(Self);
- if not LStyle.Enabled or LStyle.IsSystemStyle then
- LStyle := nil;
- if not CustomWizardBackground or (SetupHeader.WizardBackColor = clWindow) then
- MainPanel.ParentBackGround := False;
- InitializeFont;
- PageNameLabel.Font.Style := [fsBold];
- PageNameLabel.Caption := SetupMessages[msgWizardUninstalling];
- { Initialize wizard style: not done here but in TUninstallProgressForm.Initialize }
- { Adjust page name and description label - also see TWizardForm.Create }
- const I = FPageNameLabel.AdjustHeight;
- FPageDescriptionLabel.Top := FPageDescriptionLabel.Top + I;
- { Initialize BeveledLabel }
- if SetupMessages[msgBeveledLabel] <> '' then begin
- BeveledLabel.Caption := ' ' + SetupMessages[msgBeveledLabel] + ' ';
- BeveledLabel.Top := Bevel.Top - ((BeveledLabel.Height - 1) div 2);
- if not CustomWizardBackground then begin
- if LStyle <> nil then
- BeveledLabel.Color := LStyle.GetStyleColor(scWindow);
- end else
- BeveledLabel.Color := TBitmapImageImplementation.AdjustColorForStyle(Self, SetupHeader.WizardBackColor);
- BeveledLabel.Visible := True;
- end;
- CancelButton.Caption := SetupMessages[msgButtonCancel];
- end;
- destructor TUninstallProgressForm.Destroy;
- begin
- SetMessageBoxCallbackFunc(nil, 0);
- SetAppTaskbarProgressState(tpsNoProgress);
- inherited;
- end;
- procedure TUninstallProgressForm.Initialize(const ATitle, AAppName: String);
- begin
- var LStyle := StyleServices(Self);
- if not LStyle.Enabled or LStyle.IsSystemStyle then
- LStyle := nil;
- Caption := ATitle;
- PageDescriptionLabel.Caption := FmtSetupMessage1(msgUninstallStatusLabel, AAppName);
- StatusLabel.Caption := FmtSetupMessage1(msgStatusUninstalling, AAppName);
- { Initialize wizard style - also see TWizardForm.Create }
- if not CustomWizardBackground then begin
- if LStyle <> nil then begin
- { TNewNotebook ignores VCL Styles so it needs a bit of help }
- OuterNotebook.ParentColor := True;
- Color := LStyle.GetStyleColor(scWindow);
- end;
- end else begin
- OuterNotebook.ParentBackground := True;
- for var I := 0 to OuterNotebook.PageCount-1 do
- OuterNotebook.Pages[I].ParentBackground := True;
- InnerNotebook.ParentBackground := True;
- for var I := 0 to InnerNotebook.PageCount-1 do
- InnerNotebook.Pages[I].ParentBackground := True;
- end;
- if lfWizardModern in MessagesLangOptions.Flags then begin
- if LStyle = nil then begin
- if CustomWizardBackground then
- InternalError('Unexpected CustomWizardBackground value');
- OuterNotebook.Color := clWindow;
- end;
- Bevel1.Visible := False;
- end;
- if lfWizardBevelsHidden in MessagesLangOptions.Flags then begin
- Bevel1.Visible := False;
- Bevel.Visible := False;
- end;
- { Initialize image }
- if not WizardSmallBitmapImage.InitializeFromIcon(HInstance, PChar('Z_UNINSTALLICON' + WizardIconsPostfix), clNone, [32, 48, 64]) then {don't localize}
- WizardSmallBitmapImage.InitializeFromIcon(HInstance, PChar('MAINICON' + MainIconPostfix), clNone, [32, 48, 64]); {don't localize}
- end;
- procedure TUninstallProgressForm.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- Params.WindowClass.style := Params.WindowClass.style or CS_NOCLOSE;
- end;
- procedure TUninstallProgressForm.UpdateProgress(const AProgress, ARange: Integer);
- var
- NewPos: Integer;
- begin
- NewPos := MulDiv(AProgress, ProgressBar.Max, ARange);
- if ProgressBar.Position <> NewPos then begin
- ProgressBar.Position := NewPos;
- SetAppTaskbarProgressValue(UInt64(NewPos), UInt64(ProgressBar.Max));
- end;
- end;
- end.
|