Ang. ProgressBar - kroning (Fejl i eksempel).

Hej Igen - Spøgsmål rettet mest til kroning.

--------------------------------------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CopyFolder(src, dest : string );
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CopyProgressRoutine(
    TotalFileSize : Int64;    // total file size, in bytes
    TotalBytesTransferred : Int64;    // total number of bytes transferred
    StreamSize : Int64;    // total number of bytes for this stream
    StreamBytesTransferred : Int64;    // total number of bytes transferred for this stream
    dwStreamNumber : DWORD;    // the current stream
    dwCallbackReason : DWORD;    // reason for callback
    hSourceFile : THandle;    // handle to the source file
    hDestinationFile : THandle;    // handle to the destination file
    lpData : pointer) : DWORD; stdcall; // passed by CopyFileEx
begin
  with Form1 do
  begin
    ProgressBar1.Max:=TotalFileSize;
    ProgressBar1.Position:=TotalBytesTransferred;
    ProgressBar1.Update;
    ProgressBar2.Position:=integer(lpData);
    ProgressBar2.Update;
    Label2.Caption:='Fil '+IntToStr(round((TotalBytesTransferred/TotalFileSize)*100));
    Label2.Update;
  end;
end;

procedure TForm1.CopyFolder(src, dest : string );
var
  fl : TStringList;
  i : integer;

procedure MakeList(src, dest : string);
var
  sts : Integer ;
  SR: TSearchRec;
begin
  sts := FindFirst(src + '*.*' , faAnyFile , SR );
  while sts = 0 do
  begin
    if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
    begin
      if Pos('.', SR.Name) = 0 then
      begin
        {$I-}MkDir( dest + SR.Name );{$I+}
        MakeList( src + SR.Name + '\', dest + SR.Name+ '\' ) ;
      end
      else
        fl.Add(src + SR.Name+'='+dest + sr.name);
    end;
    sts:=FindNext( SR );
  end;
  FindClose( SR ) ;
end;

begin
  fl:=TStringList.Create;
  MakeList(src, dest);
  ProgressBar2.Max:=fl.Count;
  ProgressBar2.Position:=0;
  for i:=0 to fl.Count-1 do
  begin
    Label1.Caption:='Kopierer '+fl.Names[i]+' til '+fl.ValueFromIndex[i];
    Label1.Update;
    Label3.Caption:='Samlet '+IntToStr(Round(((i+1)/fl.Count)*100));
    Label3.Update;
    CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(i), nil, 0);
  end;
  fl.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyFolder('C:\Temp\', 'D:\Temp\');
end;

end.

--------------------------------------------


Sidste gang jeg testede dit eksempel kroning så det ud til at virke som det skulle, men det gjorde det ikke alligvel :-)

Ville kopiere en mappe fra en disk til en anden ca. 8,5 GB (mange filer) når jeg gør dette opstår der 2 fejl :

1. Hvis disse linjer er slået til :
Form2.Label2.Caption := (IntToStr(round((TotalBytesTransferred/TotalFileSize)*100)));
Form2.Label2.Update;

Så får jeg fejlen : Exeception calss EInvalidOp with message "invalid floating point operation" - denne fejl opstår når jeg når til 55% i OverAll PrgressBar (ProgressBar2)

2. Når jeg slår de 2 linjer fra som den melder fejl i oppe i nr. 1 så ser det ud som om den kopiere det hele det gør den ikke desværre, det er ligesom om den springer noget over .. lidt øv.

Jeg har prøvet at rode med det men kan ikke lige hitte ud af hvad der sker - Hjælp :-)

Michael.