home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / dnarrays.lzh / ARRTEST6.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-04  |  2KB  |  77 lines

  1. unit Arrtest6;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, VBXCtrl, Gauge, ExtCtrls;
  8.  
  9. type
  10.   TProgressDlg = class(TForm)
  11.     BtnAbort: TButton;
  12.     Gauge: TBiGauge;
  13.     Panel1: TPanel;
  14.     LblAction: TLabel;
  15.     LblFilename: TLabel;
  16.     procedure BtnAbortClick(Sender: TObject);
  17.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  18.   private
  19.     faborted : Boolean;
  20.     { Private-Deklarationen }
  21.   public
  22.     Function ReportProgressOnLoad( pos, max: LongInt;
  23.                                    Var retain: Boolean ): Boolean;
  24.     Function ReportProgressOnStore( pos, max: LongInt;
  25.                                    Var retain: Boolean ): Boolean;
  26.   end;
  27.  
  28. var
  29.   ProgressDlg: TProgressDlg;
  30.  
  31. implementation
  32.  
  33. {$R *.DFM}
  34.  
  35. Function TProgressDlg.ReportProgressOnLoad( pos, max: LongInt;
  36.                                Var retain: Boolean ): Boolean;
  37.   Begin
  38.     Application.ProcessMessages;
  39.     If faborted Then Begin
  40.       FormStyle := fsNormal;
  41.       retain :=
  42.         MessageDlg('Do you want to retain the data already read?',
  43.                    mtConfirmation, [mbYes, mbNo],0 ) = mrYes
  44.     End
  45.     Else
  46.       Gauge.Value := (pos*100) div max;
  47.     Result := not faborted;
  48.   End; { TProgressDlg.ReportProgressOnLoad }
  49.  
  50. Function TProgressDlg.ReportProgressOnStore( pos, max: LongInt;
  51.                                Var retain: Boolean ): Boolean;
  52.   Begin
  53.     Application.ProcessMessages;
  54.     If faborted Then Begin
  55.       FormStyle := fsNormal;
  56.       retain :=
  57.         MessageDlg('Do you want to retain the incomplete file?',
  58.                    mtConfirmation, [mbYes, mbNo],0 ) = mrYes
  59.     End
  60.     Else
  61.       Gauge.Value := (pos*100) div max;
  62.     Result := not faborted;
  63.   End; { TProgressDlg.ReportProgressOnStore }
  64.  
  65. procedure TProgressDlg.BtnAbortClick(Sender: TObject);
  66. begin
  67.   faborted := true;
  68. end;
  69.  
  70. procedure TProgressDlg.FormClose(Sender: TObject;
  71.   var Action: TCloseAction);
  72. begin
  73.   Action := caFree;
  74. end;
  75.  
  76. end.
  77.