home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D8 / TVFM.ZIP / GAUGES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  3.0 KB  |  130 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision File Manager Demo               }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit Gauges;
  9.  
  10. {$V-}
  11.  
  12. interface
  13.  
  14. uses Drivers, Objects, Views;
  15.  
  16. const
  17.   cmUpdateGauge = 12000;
  18.   cmResetGauge = 12001;
  19.   cmAddGauge   = 12002;
  20.  
  21. type
  22.   PPercentGauge = ^TPercentGauge;
  23.   TPercentGauge = object(TView)
  24.     MaxValue: Longint;
  25.     CurValue: Longint;
  26.     constructor Init(var Bounds: TRect; AMaxValue: Longint);
  27.     procedure Draw; virtual;
  28.     procedure Update(Progress: Longint); virtual;
  29.     procedure AddProgress(Progress: Longint);
  30.     procedure HandleEvent(var Event: TEvent); virtual;
  31.     function SolveForX(Y, Z: Longint): Integer;
  32.     function SolveForY(X, Z: Longint): Integer;
  33.   end;
  34.  
  35.   PBarGauge = ^TBarGauge;
  36.   TBarGauge = object(TPercentGauge)
  37.     procedure Draw; virtual;
  38.   end;
  39.  
  40. implementation
  41.  
  42. constructor TPercentGauge.Init(var Bounds: TRect; AMaxValue: Longint);
  43. begin
  44.   inherited Init(Bounds);
  45.   EventMask := EventMask or evBroadcast;
  46.   MaxValue := AMaxValue;
  47.   CurValue := 0;
  48. end;
  49.  
  50. procedure TPercentGauge.Draw;
  51. var
  52.   B: TDrawBuffer;
  53.   C: Word;
  54.   S: string[10];
  55.   PercentDone: Longint;
  56. begin
  57.   C := GetColor(1);
  58.   MoveChar(B, ' ', C, Size.X);
  59.   PercentDone := SolveForY(CurValue, MaxValue);
  60.   FormatStr(S, '%-3d%%', PercentDone);
  61.   MoveStr(B, S, C);
  62.   WriteLine(0,0,Size.X,Size.Y,B);
  63. end;
  64.  
  65. procedure TPercentGauge.Update(Progress: Longint);
  66. begin
  67.   CurValue := Progress;
  68.   DrawView;
  69. end;
  70.  
  71. procedure TPercentGauge.AddProgress(Progress: Longint);
  72. begin
  73.   Update(Progress + CurValue);
  74. end;
  75.  
  76. procedure TPercentGauge.HandleEvent(var Event: TEvent);
  77. begin
  78.   inherited HandleEvent(Event);
  79.   if Event.What = evBroadcast then
  80.   begin
  81.     case Event.Command of
  82.       cmUpdateGauge :
  83.         begin
  84.           Update(Event.InfoLong);
  85.         end;
  86.       cmResetGauge:
  87.         begin
  88.           MaxValue := Event.InfoLong;
  89.           Update(0);
  90.         end;
  91.       cmAddGauge:
  92.         begin
  93.           AddProgress(Event.InfoLong);
  94.         end;
  95.     end;
  96.   end;
  97. end;
  98.  
  99. { This function solves for x in the equation "x is y% of z". }
  100. function TPercentGauge.SolveForX(Y, Z: Longint): Integer;
  101. begin
  102.   SolveForX := Trunc( Z * (Y * 0.01) );
  103. end;
  104.  
  105. { This function solves for y in the equation "x is y% of z". }
  106. function TPercentGauge.SolveForY(X, Z: Longint): Integer;
  107. begin
  108.   if Z = 0 then SolveForY := 0
  109.   else SolveForY := Trunc( (X * 100) / Z );
  110. end;
  111.  
  112.  
  113. { TBarGauge }
  114. procedure TBarGauge.Draw;
  115. var
  116.   B: TDrawBuffer;
  117.   C: Word;
  118.   PercentDone: Longint;
  119.   FillSize: Integer;
  120. begin
  121.   C := GetColor(1);
  122.   MoveChar(B, #176, C, Size.X);
  123.   PercentDone := SolveForY(CurValue, MaxValue);
  124.   FillSize := SolveForX(PercentDone, Size.X);
  125.   if FillSize > Size.X then FillSize := Size.X;
  126.   MoveChar(B, #178, C, FillSize);
  127.   WriteLine(0,0,Size.X,Size.Y,B);
  128. end;
  129.  
  130. end.