Fórum Evolução de cópia de um único arquivo no ProgressBar #254713

type
  TProgressForm = class(TForm)
    AbortButton: TButton;
    ProgressBar: TProgressBar;
    procedure AbortButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FCancel: BOOL;
  end;
  // form has fsStayOnTop formstyle!

implementation

{$R *.DFM}

procedure TProgressForm.AbortButtonClick(Sender: TObject);
begin
  FCancel := True;
end;
   
// Note: could use int64 instead of COMP, but that would make this D4 specific
Function CopyCallback( TotalFileSize, TotalBytesTransferred, 
                       StreamSize, StreamBytesTransferred: COMP; 
                       dwStreamNumber, dwCallbackReason : DWORD;
                       hSourceFile, hDestinationFile: THandle;
                       progressform: TProgressForm ): DWORD; stdcall;
Var
  newpos: Integer;
Begin
  Result := PROCESS_CONTINUE;
  If dwCallbackReason = CALLBACK_CHUNK_FINISHED Then Begin
    newpos := Round( TotalBytesTransferred / TotalFileSize * 100 );
    With progressform.Progressbar Do
      if newpos <> Position then
        Position := newpos;
    Application.ProcessMessages; 
  End; { If }
End; { CopyCallback }

Function DoFilecopy( Const source, target: String ): Boolean;
Var
  progressform: TProgressForm;
Begin
  progressform := TProgressform.Create;
  try
    progressform.Show;
    Application.ProcessMessages;
    Result := CopyFileEx(
                PChar( source ),
                PChar( target ),
                @CopyCallback,
                Pointer( progressform ),
                @progressform.FCancel,
                0 );
 finally
   progressform.Hide;
   progressform.free;
 end;
end; { DoFileCopy }

procedure TForm1.Button1Click(Sender: TObject);
var
  OpStruc: TSHFileOpStruct;
  frombuf, tobuf: Array [0..128] of Char;
Begin
  fillChar( OpStruc, Sizeof(OpStruc), 0 );
  FillChar( frombuf, Sizeof(frombuf), 0 );
  FillChar( tobuf, Sizeof(tobuf), 0 );
  StrPCopy( frombuf, ´c:\temp\*.*´ );
  StrPCopy( tobuf, ´c:\lixo\tmp´ );
  With OpStruc DO Begin
    Wnd:= Handle;
    wFunc:= FO_COPY;
    pFrom:= @frombuf;
    pTo:=@tobuf;
    fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
    fAnyOperationsAborted:= False;
    hNameMappings:= Nil;
    lpszProgressTitle:= Nil;
  end;
  ShFileOperation( OpStruc );
end;