home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / SRC / PROGRESS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  5.6 KB  |  205 lines
  1. {**************************************************************************}
  2. {                                                                          }
  3. {    Calmira shell for Microsoft« Windows(TM) 3.1                          }
  4. {    Source Release 2.1                                                    }
  5. {    Copyright (C) 1997-1998 Li-Hsin Huang                                 }
  6. {                                                                          }
  7. {    This program is free software; you can redistribute it and/or modify  }
  8. {    it under the terms of the GNU General Public License as published by  }
  9. {    the Free Software Foundation; either version 2 of the License, or     }
  10. {    (at your option) any later version.                                   }
  11. {                                                                          }
  12. {    This program is distributed in the hope that it will be useful,       }
  13. {    but WITHOUT ANY WARRANTY; without even the implied warranty of        }
  14. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         }
  15. {    GNU General Public License for more details.                          }
  16. {                                                                          }
  17. {    You should have received a copy of the GNU General Public License     }
  18. {    along with this program; if not, write to the Free Software           }
  19. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.             }
  20. {                                                                          }
  21. {**************************************************************************}
  22.  
  23. unit Progress;
  24.  
  25. interface
  26.  
  27. uses
  28.   SysUtils, Classes, Controls, Forms, StdCtrls, Buttons, ExtCtrls, BarGauge;
  29.  
  30. type
  31.   TFileOperation = (foCopy, foMove, foDelete, foBinning,
  32.     foRestoring, foEmptying);
  33.  
  34.   TProgressBox = class(TForm)
  35.     FileLabel: TLabel;
  36.     CancelBtn: TBitBtn;
  37.     FromText: TLabel;
  38.     FromLabel: TLabel;
  39.     ToText: TLabel;
  40.     ToLabel: TLabel;
  41.     Image: TImage;
  42.     BytesLabel: TLabel;
  43.     CopiedLabel: TLabel;
  44.     Gauge: TWin95Gauge;
  45.     procedure CancelBtnClick(Sender: TObject);
  46.     procedure FormShow(Sender: TObject);
  47.     procedure FormHide(Sender: TObject);
  48.     procedure FormCreate(Sender: TObject);
  49.     procedure ImageClick(Sender: TObject);
  50.   private
  51.     { Private declarations }
  52.     FAbortOp : Boolean;
  53.     LastOp : TFileOperation;
  54.     LastDisplayTime : Longint;
  55.     ShowingBytes : Boolean;
  56.   public
  57.     { Public declarations }
  58.     property AbortOp : Boolean read FAbortOp;
  59.     procedure UpdateGauge;
  60.     procedure UpdateLabel(const source, dest : TFilename);
  61.     procedure Init(Op : TFileOperation; Count: Integer);
  62.     procedure CheckForAbort;
  63.     procedure Hide;
  64.     procedure ChangeByteDisplay;
  65.   end;
  66.  
  67. var
  68.   ProgressBox: TProgressBox;
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74. uses FileCtrl, Settings, Strings, Desk, Replace, Locale, WinProcs, Files;
  75.  
  76.  
  77. const FileOpMessages : array[TFileOperation] of Word =
  78.    (SProgressCopy, SProgressMove, SProgressDelete, SProgressBinning,
  79.     SProgressRestoring, SProgressEmptying);
  80.  
  81. procedure TProgressBox.UpdateGauge;
  82. begin
  83.   Gauge.AddProgress(1);
  84. end;
  85.  
  86.  
  87. procedure TProgressBox.UpdateLabel(const source, dest: TFilename);
  88. begin
  89.   if LastOp >= foBinning then Exit;
  90.  
  91.   FileLabel.Caption := Uppercase(ExtractFilename(source));
  92.  
  93.   with FromLabel do
  94.     Caption := MinimizeName(Uppercase(ExtractFileDir(source)), Canvas, Width);
  95.  
  96.   with ToLabel do
  97.     Caption := MinimizeName(Uppercase(ExtractFileDir(dest)), Canvas, Width);
  98.  
  99.   FromLabel.Update;
  100.   ToLabel.Update;
  101. end;
  102.  
  103.  
  104. procedure TProgressBox.Init(Op : TFileOperation; Count: Integer);
  105. var i: Integer;
  106. begin
  107.   LastOp := Op;
  108.  
  109.   if Op in [foCopy, foMove] then begin
  110.     FileLabel.Caption := '';
  111.     FromText.Show;
  112.     ToText.Show;
  113.     FromLabel.Caption := '';  FromLabel.Show;
  114.     ToLabel.Caption := '';    ToLabel.Show;
  115.   end
  116.   else begin
  117.     FileLabel.Caption := 'Please wait...';
  118.     FromText.Hide;
  119.     FromLabel.Hide;
  120.     ToText.Hide;
  121.     ToLabel.Hide;
  122.   end;
  123.  
  124.   ShowingBytes := False;
  125.   BytesCopied := 0;
  126.   ChangeByteDisplay;
  127.  
  128.   Caption := LoadStr(FileOpMessages[Op]);
  129.   FAbortOp := False;
  130.   Gauge.Progress := 0;
  131.   Gauge.MaxValue := Count;
  132.   Show;
  133.   Update;
  134. end;
  135.  
  136.  
  137. procedure TProgressBox.CancelBtnClick(Sender: TObject);
  138. begin
  139.   FAbortOp := True;
  140. end;
  141.  
  142.  
  143. procedure TProgressBox.FormShow(Sender: TObject);
  144. begin
  145.   with Gauge do begin
  146.     ForeColor := Colors[ccPercent];
  147.     BackColor := Colors[ccPercentBack];
  148.     {Font.Color := Colors[ccPercentText];}
  149.   end;
  150.   Desktop.EnableForms(False);
  151. end;
  152.  
  153. procedure TProgressBox.FormHide(Sender: TObject);
  154. begin
  155.   FAbortOp := False;
  156.   Desktop.EnableForms(True);
  157.   ReplaceBox.Free;
  158.   ReplaceBox := nil;
  159.   DestroyHandle;
  160. end;
  161.  
  162. procedure TProgressBox.CheckForAbort;
  163. var
  164.   t: Longint;
  165. begin
  166.   if ShowingBytes then begin
  167.     t := GetTickCount;
  168.     if t - LastDisplayTime > 500 then begin
  169.       BytesLabel.Caption := FormatByteLong(BytesCopied);
  170.       LastDisplayTime := t;
  171.     end;
  172.   end;
  173.  
  174.   Application.ProcessMessages;
  175.   if FAbortOp then Abort;
  176. end;
  177.  
  178. procedure TProgressBox.Hide;
  179. begin
  180.   inherited Hide;
  181.   DestroyHandle;
  182. end;
  183.  
  184. procedure TProgressBox.FormCreate(Sender: TObject);
  185. begin
  186.   Image.Picture.Icon.Handle := LoadIcon(HInstance, 'PROGRESSICON');
  187. end;
  188.  
  189. procedure TProgressBox.ImageClick(Sender: TObject);
  190. begin
  191.   ShowingBytes := not ShowingBytes;
  192.   ChangeByteDisplay;
  193. end;
  194.  
  195. procedure TProgressBox.ChangeByteDisplay;
  196. begin
  197.   if not (LastOp in [foMove, foCopy, foBinning, foRestoring]) then
  198.     ShowingBytes := False;
  199.  
  200.   CopiedLabel.Visible := ShowingBytes;
  201.   BytesLabel.Visible := ShowingBytes;
  202. end;
  203.  
  204. end.
  205.