home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / DSKCACHE / EVALCACH.ZIP / HBARS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-26  |  1.4 KB  |  70 lines
  1. {
  2. **************************************************************************
  3. HBARS.PAS -- Horizontal bar graph objects
  4. Copyright 1989 L. Brett Glass -- All rights reserved.
  5. **************************************************************************
  6. }
  7. unit HBars;
  8.  
  9. interface
  10.  
  11. uses CRT, CharScrn, StrUtil;
  12.  
  13. const
  14.   MAXHBARSIZE = SCREENWIDTH*2;
  15. type
  16.   HBarSize = 0..MAXHBARSIZE;
  17.  
  18.   HBar = object (TitledCharObject)
  19.     size : HBarSize;
  20.     maxWidth : ColType;
  21.     procedure Draw; virtual;
  22.     {Draw a bar.}
  23.     procedure DispTitle; virtual;
  24.     end;
  25.  
  26. implementation
  27.  
  28. const
  29.   halfHBarChar : Char = '▌';
  30.   fullBarChar : Char = '█';
  31.  
  32.  
  33. {Public routines}
  34.  
  35. procedure HBar.DispTitle;
  36.   var
  37.     tLen : Byte absolute title;
  38.     p : ScreenParms;
  39.   begin {HBar.DispTitle}
  40.   p.Save;
  41.   TextAttr := color;
  42.   HighVideo;
  43.   Ellipsis(title,maxWidth);
  44.   CharsToScreen(x,y+2,tLen,title[1]);
  45.   p.Restore;
  46.   end;  {HBar.DispTitle}
  47.  
  48. procedure HBar.Draw;
  49. var
  50.   pos : ColType;
  51.   p : ScreenParms;
  52. begin {HBar.Draw}
  53. p.Save;
  54. TextAttr := color;
  55. LowVideo;
  56. pos := x;
  57. if size > (maxWidth * 2) then
  58.   size := maxWidth * 2;
  59. if size > 1 then
  60.   for pos := pos to x + (size div 2) do
  61.     CharsToScreen(pos,y,1,fullBarChar);
  62. if Odd(size) then
  63.   CharsToScreen(pos,y,1,halfHBarChar);
  64. if Length(title) <> 0 then
  65.   Self.DispTitle;
  66. p.Restore;
  67. end; {HBar.Draw}
  68.  
  69. end. {HBars}
  70.