SendProgressUnit.pas 1018 B

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051
  1. unit SendProgressUnit;
  2. interface
  3. uses
  4. LinkUnit,
  5. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  6. StdCtrls, ComCtrls;
  7. type
  8. TSendProgressForm = class(TForm)
  9. ProgressBar: TProgressBar;
  10. FileNameLabel: TLabel;
  11. CancelButton: TButton;
  12. procedure CancelButtonClick(Sender: TObject);
  13. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  14. private
  15. public
  16. Cancelled: Boolean;
  17. CloseNow: Boolean;
  18. end;
  19. function ProgressProg(ID: Pointer; Progress: PDWord): Boolean;
  20. implementation
  21. {$R *.DFM}
  22. function ProgressProg(ID: Pointer; Progress: PDWord): Boolean;
  23. begin
  24. with TSendProgressForm (ID) do begin
  25. ProgressBar.Position := Progress^;
  26. Result := not Cancelled;
  27. end;
  28. Application.ProcessMessages;
  29. end;
  30. procedure TSendProgressForm.CancelButtonClick(Sender: TObject);
  31. begin
  32. Cancelled := True;
  33. end;
  34. procedure TSendProgressForm.FormCloseQuery(Sender: TObject;
  35. var CanClose: Boolean);
  36. begin
  37. CanClose := CloseNow;
  38. if not CanClose then
  39. Cancelled := True;
  40. end;
  41. end.