在程序加载时复制文件时启动进度条

Question

好的，这是 Splashbar.pas 的完整代码，仍然有三个进度条，因为我想在选择一个之前看看它们的样子。它还包括一些被禁用的东西，因为我无法让它们工作。

    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

第一个错误 (W1056)： 确保

{$R *.RES} 没有在您的 dpr 中输入两次（项目|查看源代码）

第二个错误（H2077）： 代码中的其他地方，无能为力

第三个错误（W1019）： 你必须把

var
  X: integer

紧接着

procedure TSplashBar1.ShowProgress;

您似乎在循环控制变量错误所指示的过程之外的某个地方定义了 X。

Answer 2

您是否在 .dpr 文件的“uses”子句中包含了 TSplashBar 的单元，它是否定义了全局 SplashBar 变量？