Bladeren bron

Added new CreateMarqueeProgressWizardPage support function to show marquee progress to the user.

Martijn Laan 4 jaren geleden
bovenliggende
commit
b85edeecbb

+ 20 - 8
Examples/AllPagesExample.iss

@@ -42,7 +42,8 @@ Name: "task"; Description: "Task";
 [Code]
 var
   OutputProgressWizardPage: TOutputProgressWizardPage;
-  OutputProgressWizardPageAfterID: Integer;
+  OutputMarqueeProgressWizardPage: TOutputMarqueeProgressWizardPage;
+  OutputProgressWizardPagesAfterID: Integer;
 
 procedure InitializeWizard;
 var
@@ -84,27 +85,38 @@ begin
   AfterID := OutputMsgMemoWizardPage.ID;
 
   OutputProgressWizardPage := CreateOutputProgressPage('CreateOutputProgressPage', 'ADescription');
-  OutputProgressWizardPageAfterID := AfterID;
+  OutputMarqueeProgressWizardPage := CreateOutputMarqueeProgressPage('CreateOutputMarqueeProgressPage', 'ADescription');
+  OutputProgressWizardPagesAfterID := AfterID;
 
   { See CodeDownloadFiles.iss for a CreateDownloadPage example }
 end;
 
 function NextButtonClick(CurPageID: Integer): Boolean;
 var
-  Position, Max: Integer;
+  I, Max: Integer;
 begin
-  if CurPageID = OutputProgressWizardPageAfterID then begin
+  if CurPageID = OutputProgressWizardPagesAfterID then begin
     try
-      Max := 25;
-      for Position := 0 to Max do begin
-        OutputProgressWizardPage.SetProgress(Position, Max);
-        if Position = 0 then
+      Max := 50;
+      for I := 0 to Max do begin
+        OutputProgressWizardPage.SetProgress(I, Max);
+        if I = 0 then
           OutputProgressWizardPage.Show;
         Sleep(2000 div Max);
       end;
     finally
       OutputProgressWizardPage.Hide;
     end;
+    try
+      Max := 50;
+      OutputMarqueeProgressWizardPage.Show;
+      for I := 0 to Max do begin
+        OutputMarqueeProgressWizardPage.Animate;
+        Sleep(2000 div Max);
+      end;
+    finally
+      OutputMarqueeProgressWizardPage.Hide;
+    end;
   end;
   Result := True;
 end;

+ 1 - 0
ISHelp/isxclasses.footer

@@ -6,6 +6,7 @@
 <tt>function <link topic="isxfunc_CreateOutputMsgPage">CreateOutputMsgPage</link>(const AfterID: Integer; const ACaption, ADescription, AMsg: String): TOutputMsgWizardPage;</tt><br />
 <tt>function <link topic="isxfunc_CreateOutputMsgMemoPage">CreateOutputMsgMemoPage</link>(const AfterID: Integer; const ACaption, ADescription, ASubCaption: String; const AMsg: AnsiString): TOutputMsgMemoWizardPage;</tt><br />
 <tt>function <link topic="isxfunc_CreateOutputProgressPage">CreateOutputProgressPage</link>(const ACaption, ADescription: String): TOutputProgressWizardPage;</tt><br />
+<tt>function <link topic="isxfunc_CreateOutputMarqueeProgressPage">CreateOutputMarqueeProgressPage</link>(const ACaption, ADescription: String): TOutputMarqueeProgressWizardPage;</tt><br />
 <tt>function <link topic="isxfunc_CreateCustomPage">CreateCustomPage</link>(const AfterID: Integer; const ACaption, ADescription: String): TWizardPage;</tt><br />
 <tt>function <link topic="isxfunc_CreateCustomForm">CreateCustomForm</link>: TSetupForm;</tt><br />
 <br />

+ 4 - 0
ISHelp/isxclasses.pas

@@ -731,6 +731,10 @@ TOutputProgressWizardPage = class(TWizardPage)
   procedure Show;
 end;
 
+TOutputMarqueeProgressWizardPage = class(TOutputProgressWizardPage)
+  procedure Animate;
+end;
+
 TDownloadWizardPage = class(TOutputProgressWizardPage)
   property AbortButton: TNewButton; read;
   property AbortedByUser: Boolean; read;

+ 12 - 3
ISHelp/isxfunc.xml

@@ -2507,10 +2507,19 @@ Page := CreateOutputMsgMemoPage(wpWelcome,
         <remarks><p>Call the <tt>Show</tt> method to activate and show the page. When you're finished with it, call the <tt>Hide</tt> method to revert to the previous page.</p>
 <p>Always put the <tt>Hide</tt> call inside the <tt>finally</tt> part of a <tt>try..finally</tt> language construct, as demonstrated in <i>CodeDlg.iss</i>. Not calling <tt>Hide</tt> will result in the wizard being permanently stuck on the progress page.</p>
 <p>To set the text on the page, call the <tt>SetText</tt> method. <tt>SetText</tt> takes two string parameters: use the first to tell the user what you're doing, and the second to display a file or directory name. Either parameter may be blank.</p>
-<p>To display or update the progress bar, call the <tt>SetProgress</tt> method. <tt>SetProgress</tt> takes two integer parameters: the first specifies the position of the progress bar (zero-based), and the second specifies the highest possible position. If the second parameter is 0, the progress bar will be hidden.
-</p></remarks>
+<p>To show or update the progress bar, call the <tt>SetProgress</tt> method. <tt>SetProgress</tt> takes two integer parameters: the first specifies the position of the progress bar (zero-based), and the second specifies the highest possible position. If the second parameter is 0, the progress bar will be hidden.</p></remarks>
         <example><p>See <i>CodeDlg.iss</i> and <i>AllPagesExample.iss</i> for examples.</p></example>
-        <seealso><p><link topic="scriptclasses" anchor="TOutputProgressWizardPage">TOutputProgressWizardPage</link></p></seealso>
+        <seealso><p><link topic="scriptclasses" anchor="TOutputProgressWizardPage">TOutputProgressWizardPage</link><br />
+<link topic="isxfunc_CreateOutputMarqueeProgressPage">CreateOutputMarqueeProgressPage</link></p></seealso>
+      </function>
+      <function>
+        <name>CreateOutputMarqueeProgressPage</name>
+        <prototype>function CreateOutputMarqueeProgressPage(const ACaption, ADescription: String): TOutputMarqueeProgressWizardPage;</prototype>
+        <description><p>Creates a wizard page containing static text as well as a marquee progress bar.</p>
+<p>See <link topic="isxfunc_CreateOutputProgressPage">CreateOutputProgressPage</link> for information on how to work with progress pages.</p></description>
+        <remarks><p>To animate the progress bar, call the <tt>Animate</tt> method. Do not call the <tt>SetProgress</tt> method, it will raise an internal error.</p></remarks>
+        <example><p>See <i>AllPagesExample.iss</i> for an example.</p></example>
+        <seealso><p><link topic="scriptclasses" anchor="TOutputMarqueeProgressWizardPage">TOutputMarqueeProgressWizardPage</link></p></seealso>
       </function>
       <function>
         <name>CreateDownloadPage</name>

+ 10 - 0
Projects/ScriptClasses_C.pas

@@ -539,6 +539,15 @@ begin
   end;
 end;
 
+procedure RegisterOutputMarqueeProgressWizardPage_C(Cl: TPSPascalCompiler);
+begin
+  with CL.AddClassN(Cl.FindClass('TOutputProgressWizardPage'),'TOutputMarqueeProgressWizardPage') do
+  begin
+    RegisterMethod('procedure Animate');
+    RegisterMethod('procedure SetProgress(const Position, Max: Longint)'); { Only used to stop the script from called TOutputProgressWizardPage.SetProgress }
+  end;
+end;
+
 {$IFNDEF PS_NOINT64}
 procedure RegisterDownloadWizardPage_C(Cl: TPSPascalCompiler);
 begin
@@ -667,6 +676,7 @@ begin
   RegisterOutputMsgWizardPage_C(Cl);
   RegisterOutputMsgMemoWizardPage_C(Cl);
   RegisterOutputProgressWizardPage_C(Cl);
+  RegisterOutputMarqueeProgressWizardPage_C(Cl);
 {$IFNDEF PS_NOINT64}
   RegisterDownloadWizardPage_C(Cl);
 {$ENDIF}

+ 10 - 0
Projects/ScriptClasses_R.pas

@@ -320,6 +320,15 @@ begin
   end;
 end;
 
+procedure RegisterOutputMarqueeProgressWizardPage_R(CL: TPSRuntimeClassImporter);
+begin
+  with CL.Add(TOutputMarqueeProgressWizardPage) do
+  begin
+    RegisterMethod(@TOutputMarqueeProgressWizardPage.Animate, 'Animate');
+    RegisterMethod(@TOutputMarqueeProgressWizardPage.SetProgress, 'SetProgress');
+  end;
+end;
+
 {$IFNDEF PS_NOINT64}
 procedure TDownloadPageAbortedByUser_R(Self: TDownloadWizardPage; var T: Boolean); begin T := Self.AbortedByUser; end;
 
@@ -438,6 +447,7 @@ begin
     RegisterOutputMsgWizardPage_R(Cl);
     RegisterOutputMsgMemoWizardPage_R(Cl);
     RegisterOutputProgressWizardPage_R(Cl);
+    RegisterOutputMarqueeProgressWizardPage_R(Cl);
 {$IFNDEF PS_NOINT64}
     RegisterDownloadWizardPage_R(Cl);
 {$ENDIF}

+ 32 - 1
Projects/ScriptDlg.pas

@@ -165,6 +165,14 @@ type
       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
@@ -194,7 +202,7 @@ implementation
 
 uses
   Struct, Main, SelFolderForm, Msgs, MsgIDs, PathFunc, CmnFunc, CmnFunc2,
-  BrowseFunc, Logging;
+  BrowseFunc, Logging, InstFunc;
 
 const
   DefaultLabelHeight = 14;
@@ -885,6 +893,29 @@ begin
   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 ---}

+ 3 - 2
Projects/ScriptFunc.pas

@@ -15,9 +15,9 @@ const
 
   { ScriptDlg }
 {$IFNDEF PS_NOINT64}
-  ScriptDlgTable: array [0..13] of AnsiString =
+  ScriptDlgTable: array [0..14] of AnsiString =
 {$ELSE}
-  ScriptDlgTable: array [0..12] of AnsiString =
+  ScriptDlgTable: array [0..13] of AnsiString =
 {$ENDIF}
   (
     'function PageFromID(const ID: Integer): TWizardPage;',
@@ -30,6 +30,7 @@ const
     'function CreateOutputMsgPage(const AfterID: Integer; const ACaption, ADescription, AMsg: String): TOutputMsgWizardPage;',
     'function CreateOutputMsgMemoPage(const AfterID: Integer; const ACaption, ADescription, ASubCaption: String; const AMsg: AnsiString): TOutputMsgMemoWizardPage;',
     'function CreateOutputProgressPage(const ACaption, ADescription: String): TOutputProgressWizardPage;',
+    'function CreateOutputMarqueeProgressPage(const ACaption, ADescription: String): TOutputMarqueeProgressWizardPage;',
 {$IFNDEF PS_NOINT64}
     'function CreateDownloadPage(const ACaption, ADescription: String; const OnDownloadProgress: TOnDownloadProgress): TDownloadWizardPage;',
 {$ENDIF}

+ 15 - 0
Projects/ScriptFunc_R.pas

@@ -143,6 +143,7 @@ var
   NewOutputMsgPage: TOutputMsgWizardPage;
   NewOutputMsgMemoPage: TOutputMsgMemoWizardPage;
   NewOutputProgressPage: TOutputProgressWizardPage;
+  NewOutputMarqueeProgressPage: TOutputMarqueeProgressWizardPage;
 {$IFNDEF PS_NOINT64}
   NewDownloadPage: TDownloadWizardPage;
   P: PPSVariantProcPtr;
@@ -275,6 +276,20 @@ begin
       raise;
     end;
     Stack.SetClass(PStart, NewOutputProgressPage);
+  end else if Proc.Name = 'CREATEOUTPUTMARQUEEPROGRESSPAGE' then begin
+    if IsUninstaller then
+      NoUninstallFuncError(Proc.Name);
+    NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm);
+    try
+      NewOutputMarqueeProgressPage.Caption := Stack.GetString(PStart-1);
+      NewOutputMarqueeProgressPage.Description := Stack.GetString(PStart-2);
+      GetWizardForm.AddPage(NewOutputMarqueeProgressPage, -1);
+      NewOutputMarqueeProgressPage.Initialize;
+    except
+      NewOutputMarqueeProgressPage.Free;
+      raise;
+    end;
+    Stack.SetClass(PStart, NewOutputMarqueeProgressPage);
 {$IFNDEF PS_NOINT64}
   end else if Proc.Name = 'CREATEDOWNLOADPAGE' then begin
     if IsUninstaller then

+ 1 - 0
whatsnew.htm

@@ -35,6 +35,7 @@ For conditions of distribution and use, see <a href="https://jrsoftware.org/file
   <li>Compiler IDE change: <i>Fix:</i> Autocomplete support for event functions listed some procedures as functions.</li>
   <li>Pascal Scripting changes:
   <ul>
+    <li>Added new <tt>CreateMarqueeProgressWizardPage</tt> support function to show marquee progress to the user. See the <i><a href="https://jrsoftware.github.io/issrc/Examples/AllPagesExample.iss">AllPagesExample.iss</a></i> example script for an example.</li>
     <li>Added new <tt>ItemFontStyle</tt> and <tt>SubItemFontStyle</tt> properties to the <tt>TNewCheckListBox</tt> support class. See the <i><a href="https://jrsoftware.github.io/issrc/Examples/CodeClasses.iss">CodeClasses.iss</a></i> example script for an example.</li>
     <li>Added new <tt>IsMsiProductInstalled</tt> and <tt>StrToVersion</tt> support functions.</li>
     <li>Added new <tt>AbortedByUser</tt> property to the <tt>TDownloadWizardPage</tt> support class.</li>