unit GvGauges;

{ Graphics Vision 2.0 Gauges implementation, Copr. 1994 Matthias K”ppe

  Derived from Gauges.pas, TV File Manager Demo, Copr. 1992 Borland Int.

  Portions copr. Borland Int.
}

{$V-}

interface

uses Drivers, Objects, Views, GvViews;

const

{ Gauge commands }

  cmUpdateGauge = 12000;
  cmResetGauge = 12001;
  cmAddGauge   = 12002;

{ Color palette }

  CGauge = #129#126#127#130;

type

{ TPercentgauge object }

  { Palette layout  }
  { 1 - frame       }
  { 2 - background  }
  { 3 - percent bar }
  { 4 - text        }

  PPercentGauge = ^TPercentGauge;
  TPercentGauge = object(TGView)
    MaxValue: Longint;
    CurValue: Longint;
    constructor Init(var Bounds: TRect; AMaxValue: Longint);
    constructor Load(var S: TStream);
    procedure AddProgress(Progress: Longint);
    procedure Draw; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function SolveForX(Y, Z: Longint): Integer;
    function SolveForY(X, Z: Longint): Integer;
    procedure Store(var S: TStream); 
    procedure Update(Progress: Longint); virtual;
  end;

{ TBarGauge object }

  PBarGauge = ^TBarGauge;
  TBarGauge = object(TPercentGauge)
    procedure Draw; virtual;
  end;

const

{ Stream registration records }

  RPercentGauge: TStreamRec = (
    ObjType: 151;
    VmtLink: Ofs(TypeOf(TPercentGauge)^);
    Load: @TPercentGauge.Load;
    Store: @TPercentGauge.Store);

  RBarGauge: TStreamRec = (
    ObjType: 152;
    VmtLink: Ofs(TypeOf(TBarGauge)^);
    Load: @TBarGauge.Load;
    Store: @TBarGauge.Store);

{ Stream registration procedure }

procedure RegisterGVGauges;

implementation

{$ifdef FPK}
uses GvFPK, Bgi;
{$else}
{$ifdef Windows}
uses WinGr;
{$else}
uses GvDriver, MetaGr, MyFonts;
{$endif}
{$endif}

function Min(X, Y: LongInt): LongInt;
Begin
  If X > Y then Min := Y
           else Min := X;
End;

(*************************** TPercentGauge object ***************************)

constructor TPercentGauge.Init(var Bounds: TRect; AMaxValue: Longint);
begin
  inherited Init(Bounds);
  EventMask := EventMask or evBroadcast;
  MaxValue := AMaxValue;
  CurValue := 0;
end;

constructor TPercentGauge.Load(var S: TStream);
Begin
  inherited Load(S);
  S.Read(MaxValue, SizeOf(MaxValue));
  S.Read(CurValue, SizeOf(CurValue));
End;

procedure TPercentGauge.AddProgress(Progress: Longint);
begin
  Update(Progress + CurValue);
end;

procedure TPercentGauge.Draw;
var
  S: string[10];
  PercentDone: Longint;
begin
  SetFillStyle(SolidFill, GetColor(2));
  Bar(0, 0, Size.X - 1, Size.Y - 1);
  SetColor(GetColor(4));
  PercentDone := SolveForY(CurValue, MaxValue);
  FormatStr(S, '%-3d%%', PercentDone);
  SetTextParams(GetStandardFont, 0, GetColor(4), false);
  SetTextJustify(LeftText, CenterText);
  OutTextXY(0, Size.Y div 2, S);
end;

function TPercentGauge.GetPalette: PPalette;
const
  P: string[Length(CGauge)] = CGauge;
Begin
  GetPalette := @P
End;

procedure TPercentGauge.HandleEvent(var Event: TEvent);
begin
  inherited HandleEvent(Event);
  if Event.What = evBroadcast then
  begin
    case Event.Command of
      cmUpdateGauge :
	begin
	  Update(Event.InfoLong);
	end;
      cmResetGauge:
	begin
	  MaxValue := Event.InfoLong;
	  Update(0);
	end;
      cmAddGauge:
	begin
	  AddProgress(Event.InfoLong);
	end;
    end;
  end;
end;

{ This function solves for x in the equation "x is y% of z". }
function TPercentGauge.SolveForX(Y, Z: Longint): Integer;
begin
  SolveForX := Trunc( Z * (Y * 0.01) );
end;

{ This function solves for y in the equation "x is y% of z". }
function TPercentGauge.SolveForY(X, Z: Longint): Integer;
begin
  if Z = 0 then SolveForY := 0
  else SolveForY := Trunc( (X * 100) / Z );
end;

procedure TPercentGauge.Store(var S: TStream);
Begin
  inherited Store(S);
  S.Write(MaxValue, SizeOf(MaxValue));
  S.Write(CurValue, SizeOf(CurValue));
End;

procedure TPercentGauge.Update(Progress: Longint);
begin
  CurValue := Min(Progress, MaxValue);
  DrawView;
end;

(****************************** TBarGauge object ****************************)

procedure TBarGauge.Draw;
var
  PercentDone: Longint;
  FillSize: Integer;
begin
  SetColor(GetColor(1));
  Rectangle(0, 0, Size.X - 1, Size.Y - 1);
  PercentDone := SolveForY(CurValue, MaxValue);
  FillSize := SolveForX(PercentDone, Size.X - 2);
  if FillSize >= Size.X - 2
  then FillSize := Size.X - 2
  else Begin
    SetFillStyle(SolidFill, GetColor(2));
    If FillSize > 0
    then Bar(1 + FillSize, 1, Size.X - 2, Size.Y - 2)
    else Bar(1, 1, Size.X - 2, Size.Y - 2)
  End;
  If FillSize > 0 then Begin
    SetFillStyle(SolidFill, GetColor(3));
    Bar(1, 1, FillSize, Size.Y - 2)
  End;
end;

(*********************** Stream registration procedure **********************)

procedure RegisterGVGauges;
Begin
{$ifndef FPK}
  RegisterType(RPercentGauge);
  RegisterType(RBarGauge);
{$endif FPK}
End;

end.
