Barre de progression en splash lors de la copie d'un fichier lors du chargement du programme

Question

OK, voici le code complet de Splashbar.pas, j'ai toujours trois barres de progression, car je veux voir à quoi elles ressemblent avant d'en choisir une. Il inclut également des éléments désactivés, car je n'arrive pas à les faire fonctionner.

unit Splashbar; 

    interface 

    uses ExtActns, Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 
     Buttons, ExtCtrls, AdvProgr, ComCtrls, NetAPI32, SHFolder, WinInet, ActnList, 
     AdvSmoothSplashScreen, AdvSmoothProgressBar, AdvSmoothProgressBarReg, 
     UTCT1b, GIFImg; 

    type 
     TSplashBar1 = class(TForm) 
     Bevel1: TBevel; 
     ProgressBar1: TProgressBar; 
     AdvProgress1: TAdvProgress; 
     Timer1: TTimer; 
     Label1: TLabel; 
     AdvSmoothProgressBar1: TAdvSmoothProgressBar; 
     ActionList1: TActionList; 
     DatabaseCopy: TAction; 
     procedure FormCreate(Sender: TObject); 
     procedure DatabaseCopyExecute(Sender: TObject); 
     procedure Timer1Timer(Sender: TObject); 

     private { Private declarations } 
    { procedure URLOnDownloadProgress (Sender: TDownLoadURL; 
      Progress, ProgressMax: Cardinal; 
      StatusCode: TURLDownloadStatus; 
      StatusText: String; var Cancel: Boolean) ; } 

     public { Public declarations } 
     procedure OpenSplash; 
     procedure ShowProgress; 
     procedure CloseSplash; 
     end; 
     var 
      SplashBar1 : TSplashBar1; 
      dirpath: string; 
      Total: Integer; 
      Percent: Integer; 

    implementation 


    {$R *.dfm} 


    function GetSpecialFolderPath(folder : integer) : string; 
    const 
     SHGFP_TYPE_CURRENT = 0; 
    var 
     path: array [0..MAX_PATH] of char; 
    begin 
     if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,@path[0])) then 
     Result := path 
    else 
     Result := ''; 
    end; 

    function GetInetFile(const fileURL, FileName: String): boolean; 
    const BufferSize = 1024; 
    var 
     hSession, hURL: HInternet; 
     Buffer: array[1..BufferSize] of Byte; 
     BufferLen: DWORD; 
     f: File; 
     sAppName: string; 
    begin 
    Result:=False; 
    sAppName := ExtractFileName(Application.ExeName); 
    hSession := InternetOpen(PChar(sAppName), 
        INTERNET_OPEN_TYPE_PRECONFIG, 
        nil, nil, 0); 
    try 
     hURL := InternetOpenURL(hSession, 
       PChar(fileURL), 
       nil,0,0,0); 
     try 
     AssignFile(f, FileName); 
     Rewrite(f,1); 
     repeat 
     InternetReadFile(hURL, @Buffer, 
         SizeOf(Buffer), BufferLen); 
     BlockWrite(f, Buffer, BufferLen) 
     until BufferLen = 0; 
     CloseFile(f); 
     Result:=True; 
     finally 
     InternetCloseHandle(hURL) 
     end 
    finally 
     InternetCloseHandle(hSession) 
    end 
    end; 

    procedure TSplashBar1.FormCreate(Sender: TObject); 
    begin 
    Timer1.Enabled := True; 
    DatabaseCopy.Execute; 
    dirpath:=GetSpecialFolderPath($0023)+'\UTCT\'; 
    end; 

    procedure TSplashBar1.DatabaseCopyExecute(Sender: TObject); 
    var 
     InternetFile,LocalFile: string; 
    begin 
    InternetFile:='http://160.14.20.20/log/Docs/test.xls'; 
    LocalFile:=(dirpath + 'test.xls'); 

    if GetInetFile(InternetFile,LocalFile)=True then 
     Label1.Caption := 'Working...'; 
     //OnDownloadProgress := URLOnDownloadProgress; 
     //else 
     // StatusBar1.Panels[2].Text := 'MTable Offline!' ; 
     CopyFile(PChar(internetFile), PChar(LocalFile), False); 
    end; 

    procedure TSplashBar1.Timer1Timer(Sender: TObject); 
    const cnt: integer = 1; 
    begin 
     ProgressBar1.Position := cnt; 
    if cnt = 1 then Label1.Caption := 'Waiting...' 
    else 
    if cnt = 100 then begin 
    Label1.Caption := 'Done!'; 
     Timer1.Enabled := False; 
    end 
    else begin 
    Label1.Caption := 'Working...'; 
      end; 
    end; 

    procedure TSplashBar1.OpenSplash; 
    begin 
     Label1.Caption := ''; 
     Show; 
     Update; 
    end; 
    procedure TSplashBar1.CloseSplash; 
    begin 
     Close; 
    end; 

    procedure TSplashBar1.ShowProgress; 
    var 
     xs: integer; 
    begin 
    Label1.caption:=''; 
     Total := 1000; 
      for xs := 1 to Total do 
      begin 
      Sleep(5); 
      Percent := (xs * 100) div Total; 
      Label1.caption := StringOfChar('|', Percent) + IntToStr(Percent) + '%'; 
      Label1.Repaint; 

      end; 
    end; 

    end. 


    // {procedure TSplashBar1.URLOnDownloadProgress; 
    // begin 
    // ProgressBar1.Max:= ProgressMax; 
    // ProgressBar1.Position:= Progress; 
    //  AdvProgress1.Max:= ProgressMax; 
    //  AdvProgress1.Position:= Progress; 
    //  AdvSmoothProgressBar1.Position:= Progress; 
    // 
    // end; } 

Answer 1

Avez-vous inclus l'unité de TSplashBar dans la clause « utilisations » de votre fichier .dpr et définit-il une variable globale de SplashBar?

Answer 2

première erreur (W1056): Assurez-vous que

{$R *.RES} n'est pas entré deux fois dans votre DPR (Projet | Voir le code source)

Deuxième erreur (H2077): Ailleurs dans votre code, ne peut pas aider avec

Troisième erreur (W1019): Y ous devez mettre

var 
    X: integer 

juste après

procedure TSplashBar1.ShowProgress; 

Vous semblez avoir défini X quelque part autre que la procédure, l'erreur variable de contrôle de boucle indique.