home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol12n18.zip / METER.ZIP / METER.PAS next >
Pascal/Delphi Source File  |  1993-06-12  |  4KB  |  109 lines
  1. {$X+,V-}
  2. UNIT Meter;
  3. (**) INTERFACE (**)
  4. USES Dialogs, Drivers, Objects, Views;
  5. TYPE
  6.   PMeter = ^TMeter;
  7.   TMeter = OBJECT(TView)
  8.     low, high,  (* low and high limit of values     *)
  9.     meterlen,   (* length of the meter display      *)
  10.     currperc,   (* current percentage of completion *)
  11.     currfilled, (* currently filled boxes           *)
  12.     TxColor,    (* Colors for Text and Meter        *)
  13.     MtColor    : WORD;
  14.     theMsg     : PString; (* string to display w/ meter *)
  15.     (* constructor initializes the meter control and
  16.        sets low/high values and the message; warning:
  17.        the rectangle 'R' needs to be exactly 2 rows
  18.        high and at least 10 columns wide *)
  19.     CONSTRUCTOR Init(R : TRect; Message : STRING;
  20.                       lowbound, highbound : WORD);
  21.     DESTRUCTOR  Done; VIRTUAL;
  22.     PROCEDURE Draw; VIRTUAL;
  23.     (* set a given value to be used in the display;
  24.        the meter control calculates the current percentage
  25.        and the number of boxes to be filled and redraws
  26.        the control, if there's been a change *)
  27.     PROCEDURE SetValue(value: WORD);
  28.         (* set the colors for the text and meter control *)
  29.     PROCEDURE SetColor(TextColor, MeterColor : WORD);
  30.   END;
  31. (**) IMPLEMENTATION (**)
  32. CONSTRUCTOR TMeter.Init(R : TRect; Message : STRING;
  33.                          lowbound, highbound : WORD);
  34. BEGIN
  35.   (* check if rectangle is big enough to hold meter control *)
  36.   IF(R.B.Y - R.A.Y <> 2) OR (R.B.X - R.A.X < 10) THEN FAIL;
  37.   TView.Init(R);
  38.   Options    := Options AND (NOT ofSelectable) AND (NOT ofTileable)
  39.                         AND (NOT ofFramed);
  40.   GrowMode   := 0;
  41.   State      := State AND NOT sfShadow;
  42.   (* calculate meter length and set default values *)
  43.   meterlen   := R.B.X - R.A.X - 1;
  44.   currfilled := 0;
  45.   currperc   := 0;
  46.   low        := lowbound;
  47.   high       := highbound;
  48.   (* initialize message *)
  49.   theMsg     := NewStr(Message);
  50.   (* get default colors *)
  51.   TxColor := $70;
  52.   MtColor := $7F;
  53. END;
  54.  
  55. DESTRUCTOR TMeter.Done;
  56. BEGIN
  57.   DisposeStr(theMsg);
  58.   TView.Done;
  59. END;
  60.  
  61. PROCEDURE TMeter.Draw;
  62.  (* Draw method; fills two string buffers, one
  63.    with the message and the currently achieved
  64.    percentage, the other one with the actual meter
  65.    with partly unfulfilled and partly filled "boxes" *)
  66. VAR
  67.   percstr : STRING;
  68.   B       : TDrawBuffer;
  69. BEGIN
  70.   (* fill first string buffer *)
  71.   MoveChar(B, ' ', TxColor, Size.X);
  72.   MoveStr(B[1], TheMsg^, TxColor);
  73.   Str(currperc:3, percstr);
  74.   MoveStr(B[meterlen-3], percstr, TxColor);
  75.   MoveStr(B[meterlen], '%', TxColor);
  76.   WriteLine(0, 0, Size.X, 1, B);
  77.   (* fill second string buffer *)
  78.   MoveChar(B, ' ', TxColor, Size.X);
  79.   IF currfilled <= meterlen THEN
  80.     BEGIN
  81.       MoveChar(B[1], #219, MtColor, currfilled);
  82.       MoveChar(B[currfilled+1], #176, MtColor,
  83.         meterlen-currfilled+1);
  84.     END
  85.   ELSE MoveChar(B[1], #219, MtColor, meterlen);
  86.   WriteLine(0, 1, Size.X, 1, B);
  87. END;
  88.  
  89. PROCEDURE TMeter.SetValue(value: WORD);
  90.  (* set the new value; we then calculate the new
  91.    percentage and number of filled boxes to be
  92.    drawn, and redraw the view *)
  93. VAR perc : REAL;
  94. BEGIN
  95.   IF (value < low) OR (value > high) THEN Exit;
  96.   perc := (value-low)/(high - low);
  97.   currperc := WORD(Round(perc*100.0));
  98.   currfilled := WORD(Round(perc*meterlen));
  99.   DrawView;
  100. END;
  101.  
  102. PROCEDURE TMeter.SetColor(TextColor, MeterColor : WORD);
  103. BEGIN
  104.   TxColor := TextColor;
  105.   MtColor := MeterColor;
  106. END;
  107.  
  108. END.
  109.