[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

{
Here is my percentage bar unit, that (??Steve Rogers?? I can't quite remember
now--sorry ) suggested I try a whiles back (I just got around to it).  It has
been debugged for all of a hour.
{**

PBar   Percentage Bar Unit   copr.1995 Brad Zavitsky

All Rights Reserved
Commercial use not allowed
Use at your own risk

Formulae-
  Percentage    => Round(cur/max);
  PBar progress => Round((cur/max) * #spaces);

ReDraw-
  If set to true, the whole percentage bar is redrawn each time.
  If false, it will continue were last left off

**}

unit PBar;

interface

type
  BarObj = object
    ReDraw : Boolean;
    Spaces : Integer;
    Old,
    Max    : Longint;
    Ch     : Char;
    X,
    Y,
    Color  : Byte;
    procedure UpDate(Cur: Longint);
    procedure Init(_Spaces: Integer; _Max: Longint; _Ch: Char; _X, _Y,
                   _Color: Byte; _ReDraw: Boolean);
  end;

implementation

var
  VS: word;

function VidSeg: Word;
var
  VidM: ^Byte;
begin
  {$iFDEF VER70}
  VidM := Ptr(Seg0040,$0049);
  if VidM^ = 7 then VidSeg := SegB000 else VidSeg := SegB800;
  {$ELSE}
  VidM := Ptr($0040,$0049);
  if VidM^ = 7 then VidSeg := $B000 else VidSeg := $B800;
  {$ENDiF}
end;

procedure WriteChar(Ch: char; x, y, attr: byte);
var
  where: Word;
[Abegin
  Where := 160*(Y-1)+2*(X-1);
  Mem[VS:Where] := Ord(Ch);
  Mem[VS:Where+1] := Attr;
end;

procedure BarObj.Init(_Spaces: Integer; _Max: Longint; _Ch: Char; _X, _Y,
                      _Color: Byte; _ReDraw: Boolean);
begin
  Old := 0;
  Spaces := _Spaces;
  X := _X;
  Y := _Y;
  Color := _Color;
  Ch := _Ch;
  Max := _Max;
  ReDraw := _ReDraw;
end;

procedure BarObj.UpDate(Cur: Longint);
var
  Temp,
  OldPos,
  SpacePos: Integer;
begin
  SpacePos := Round((Cur/Max) * Spaces);
  if ReDraw then
  begin
    for Temp := 0 to SpacePos-1 do WriteChar(Ch, X+Temp, Y, Color);
  end else
  begin
    Dec(SpacePos, Old);
    for Temp := 0 to SpacePos-1 do WriteChar(Ch, X+Temp+Old, Y, Color);
    Inc(Old, SpacePos);
  end;
end;

begin
  VS := VidSeg;
end.

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]