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 : in开发者_如何学Pythonteger) : 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; }
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
var
X: integer
right after
procedure TSplashBar1.ShowProgress;
You seem to have defined X somewhere other than the procedure, which the loop control variable error is indicating.
Did you include TSplashBar's unit in your .dpr file's 'uses' clause, and does it define a global SplashBar variable?
精彩评论