在程序加载时复制文件时出现进度条
好的,这是 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; }
OK, here is the complete code for the Splashbar.pas, still have three progressbars, as I want to see what they look like before I choose one. It also includes some stuff that's disabled, as I can't get them to work.
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; }
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(2)
第一个错误(W1056):
确保
{$R *.RES}
未在您的 dpr 中输入两次(项目|查看源代码)
第二个错误 (H2077):
代码中的其他地方无法解决
第三个错误(W1019):
你必须把
它放在
You似乎已经在程序之外的其他地方定义了 X ,循环控制变量错误表明了这一点。
First error (W1056):
Make sure that
{$R *.RES}
is not entered twice in your dpr (Project|View Source)
Second error (H2077):
Somewhere else in your code, can't help with it
Third error (W1019):
You have to put
right after
You seem to have defined X somewhere other than the procedure, which the loop control variable error is indicating.
您是否在 .dpr 文件的“uses”子句中包含了 TSplashBar 的单位,并且它是否定义了全局 SplashBar 变量?
Did you include TSplashBar's unit in your .dpr file's 'uses' clause, and does it define a global SplashBar variable?