2010. március 2., kedd
Call CopyFileEx and let the callback update a progress bar
Problem/Question/Abstract:
Does anyone have an example of using CopyFileEx with a CopyProgressRoutine? I have created a function that takes the same parameters as the CopyProgressRoutine, but when I pass it using @ or Addr() I get a Variable Required error message.
Answer:
Let's assume you call CopyFileEx and want the callback to update a progress bar. The callback cannot be an objects method but you can use the lpData parameter of CopyFileEx to pass any kind of data to the callback, e.g. a form reference. So, if you want to serve a progress form in the callback that would look like this (untested !):
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;
end;
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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése