views:

128

answers:

2

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;  }
A: 

Did you include TSplashBar's unit in your .dpr file's 'uses' clause, and does it define a global SplashBar variable?

Remy Lebeau - TeamB
Yes added it, but it's not the problem.
Shaun
+1  A: 

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.

Alan Clark
Right thanks, found the duplicate {$R *.RES}, must have happened when I moved stuff around.
Shaun
I declared the variable before implementation; didn't think it would be an issue. Now get an access violation error in module at 00C3119. Read of address 00000000. Any ideas. And thanks with the help sofar.
Shaun
Read of address 00000000 indicates you are accessing a nil pointer. I would step through the code using F8 and see where the error occurs. I'm guessing TSplashBar1 or Label1 is not being created somehow.
Alan Clark
Something wrong with the Splashbar.pas
Shaun
I cannot get it to work at all. It causes access violation when I try to use it. If I disable the call, then my app comiles. I think it's full of bugs, but I don't know how to use the debugger to fix.
Shaun