在程序加载时复制文件时出现进度条

问题描述:

好的,这里是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; } 
+0

请在发布之前使用预览区域来查看您的问题,[代码]在堆栈溢出时不起作用。 – 2010-09-17 11:02:43

+0

好的,但我似乎得到了一个红色的部分,我无法正确显示。我认为这是某种错误。 – Shaun 2010-09-17 11:36:22

是否包含TSplashBar的单位你.dpr文件的“用途”条款中,并且它定义一个全局变量SplashBar?

+0

是的,但它不是问题。 – Shaun 2010-09-13 06:40:51

第一个错误(W1056): 确保

{$R *.RES} 是不是在你的DPR(项目|查看源文件)输入两次

二错误(H2077): 别的地方在你的代码,不能用它帮助

第三个错误(W1019): ÿ OU必须把

var 
    X: integer 

procedure TSplashBar1.ShowProgress; 

正确的你似乎已经定义与过程,其循环控制变量错误指示其他X某处。

+0

非常感谢,发现重复的{$ R * .RES},当我移动东西时肯定发生了。 – Shaun 2010-09-13 06:22:59

+0

我在实现之前声明了变量;并不认为这会是一个问题。现在在00C3119模块中出现访问冲突错误。阅读地址00000000.任何想法。并感谢与帮助sofar。 – Shaun 2010-09-13 06:40:27

+0

读取地址00000000表示您正在访问一个零指针。我会使用F8浏览代码并查看错误发生的位置。我猜测TSplashBar1或Label1没有被创建。 – 2010-09-13 18:18:48