(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
UNIT AHMTGauge;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls,AHMTBackground,
  Forms, Menus, Graphics,dialogs,AHMEnhancedClass,AHMControls;

Type
  TAHMGauge = class(TAHMGraphicControl)
  private
    FPercent,FBorder : Byte;
    f3d : TAHMFont3D;
    FInsideColor,FSegColor:Tcolor;
    fback : TAHMBackground;
    FSegWidth,FSegGap : Byte;
    FAHMGlyph : TAHMGlyph;
    fpp : TAHMPosition;
    fkind : TAHMKind;
    fouter,finner : TAHMFrame;
    procedure Setouter(value : TAHMFrame);
    procedure Setinner(value : TAHMFrame);
    procedure SetPercent(Value : Byte);
    procedure SetBorderwidth(Value : Byte);
    procedure SetInsideColor(value:Tcolor);
    procedure SetBack(value:TAHMBackground);
    procedure SetSegColor(value:Tcolor);
    Procedure SetAHMGlyph(value : TAHMGlyph);
    procedure SetSegWidth(value : Byte);
    procedure SetSegGap(value : Byte);
    procedure SetKindType(value:TAHMKind);
    Procedure SetPicPos(value : TAHMPosition);
    procedure Set3D(value : TAHMFont3D);
  protected
    frm : TRect;
    procedure UpdateProgress;
    procedure Paint; Override;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas;
  published
    Property Align;
    Property Cursor;
    Property Glyph : TAHMGlyph read FAHMGlyph write SetAHMGlyph;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property Font;
    property Font3D : TAHMFont3D read f3d write Set3d stored  true;
    property Background : TAHMBackground read fback write Setback;
    property BevelInner : TAHMFrame read finner write SetInner stored true;
    property BevelOuter : TAHMFrame read fouter write SetOuter stored true;
    Property PicturePosition : TAHMPosition read fpp write SetPicPos default pLeft;
    Property Borderwidth : Byte read FBorder write SetBorderwidth default 6;
    Property Kind : TAHMKind read fkind write SetKindType default kHorizontal;
    property SegmentGap : Byte read FSegGap write SetSegGap default 2;
    property SegmentWidth: Byte read FSegWidth write SetSegWidth default 8;
    property SegmentColor : Tcolor read FSegColor write SetSegColor default clNavy;
    property InsideBackColor:TColor read FInsideColor write SetInsideColor default clWhite;
    property Percentage : Byte read FPercent write SetPercent default 0;
    property Width default 100;
    property Height default 18;
end;

var fl,ft,fb,fr,fbw : integer;

implementation

procedure TAHMGauge.SetSegWidth(Value : Byte);
begin
  if FSegWidth<>Value then
  begin
    FSegWidth := value;
    Invalidate;
  end;
end;

procedure TAHMGauge.Notification(AComponent: TComponent;Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and  (AComponent = Background) then SetBack(nil);
end;


procedure TAHMGauge.SetBorderwidth(Value : Byte);
begin
  if FBorder<>Value then
  begin
    FBorder := value;
    Invalidate;
  end;
end;

procedure TAHMGauge.SetSegGap(Value : Byte);
begin
  if FSegGap<>Value then
  begin
    FSegGap := Value;
    Invalidate;
  end;
end;

procedure TAHMGauge.SetBack(value:TAHMBackground);
begin
  if fback<>nil then fback.OList.remove(self);
  if value<>nil then value.additem(self);
  FBack := value;
  Invalidate;
 end;


procedure TAHMGauge.Set3D(value:TAHMFont3D);
begin
  F3D := value;
  Invalidate;
end;

procedure TAHMGauge.SetPicPos(value:TAHMPosition);
begin
  Fpp := value;
  Invalidate;
 end;


procedure TAHMGauge.SetInner(value:TAHMFrame);
begin
  Finner:= value;
  Invalidate;
end;

procedure TAHMGauge.SetOuter(value:TAHMFrame);
begin
  Fouter:= value;
  Invalidate;
end;


procedure TAHMGauge.SetInsideColor(value:Tcolor);
begin
  FInsideColor := value;
  Invalidate;
end;

procedure TAHMGauge.SetSegColor(value:Tcolor);
begin
  FSegColor := Value;
  Invalidate;
end;

procedure TAHMGauge.SetPercent(Value : Byte);
begin
   FPercent := Value;
   if FPercent > 100 then FPercent := 100;
   if (csDesigning in ComponentState) then Invalidate;
   UpdateProgress;
end;

procedure TAHMGauge.SetKindType(value:TAHMKind);
begin
  Fkind:=value;
  Invalidate;
end;

Procedure TAHMGauge.SetAHMGlyph(value : TAHMGlyph);
begin
  FAHMGlyph.assign(value);
  Invalidate;
end;



constructor TAHMGauge.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPercent := 0;
  fborder:=6;
  width:=140;
  height:=36;
  FAHMGlyph := TAHMGlyph.create(self);
  FSegColor := clNavy;
  FSegWidth := 8;
  FSegGap := 2;
  Finsidecolor:=Clwhite;
  fkind:=kHorizontal;
  finner:=TAHMFrame.create(Self);
  finner.FrameStyle:=frameLowered;
  fouter:=TAHMFrame.create(Self);
  f3d := TAHMFont3D.create(self);
  frm:=rect(0,0,width,height);
end;

Destructor TAHMgauge.Destroy;
begin
  if fback<>nil then fback.OList.remove(self);
  FAHMGlyph.free;
  finner.free;
  fouter.free;
  f3d.free;
  inherited Destroy;
end;

procedure TAHMGauge.UpdateProgress;
var
  x1,y1,x2,y2,max : integer;
  txtrect : TRect;

procedure Initvalues;
begin
 fl:=fborder;
 fr:=fborder;
 ft:=fborder;
 fb:=fborder;
 if FAHMGlyph.width>0 then
 begin
   fbw:=FAHMGlyph.width;
   if fpp=pLeft then fl:=fBorder+fbw;
   if fpp=pRight then fr:=fBorder+fbw;
   if fpp=pTop then ft:=FBorder+fbw;
   if fpp=pBottom then fb:=fBorder+fbw;
  end;
  frm:=rect(0+fl+finner.totalwidth+fouter.totalwidth-1,
            0+ft+finner.totalwidth+fouter.totalwidth-1,
            width-fr-finner.totalwidth-fouter.totalwidth,
            height-fb-finner.totalwidth-fouter.totalwidth);
end;


procedure DoHorizontal;
var
  i,i2 : integer;
begin
  Canvas.pen.width:=1;
  Canvas.pen.color:=finsidecolor;
  x1:=frm.left;
  y1:=frm.top;
  y2:=frm.bottom;
  max:=(frm.right-x1-1);
  x2:=x1+round((max*fpercent)/100);
  i2:=fsegwidth+fseggap;
  if fpercent>0 then
  for i:=x1 to x2 do with canvas do
  begin
   if (i mod i2) <=fsegwidth then pen.color:=fsegcolor
   else pen.color:=finsidecolor;
   moveto(i,y1);
   lineto(i,y2);
  end;
  if x2<max then
  begin
    frm.left:=x2;
    Canvas.brush.color:=finsidecolor;
    Canvas.fillrect(frm);
  end;
end;

procedure DoVertical;
var
  i,i2 : integer;

begin
  Canvas.pen.width:=1;
  Canvas.pen.color:=finsidecolor;
  x1:=frm.left;
  y2:=frm.bottom-1;
  x2:=frm.right;
  max:=y2-frm.top;
  y1:=y2-round((max*fpercent)/100);
  i2:=fsegwidth+fseggap;
  if fpercent>0 then
  for i:=y1 to y2 do with canvas do
  begin
   if (i mod i2) <=fsegwidth then pen.color:=fsegcolor
   else pen.color:=finsidecolor;
   moveto(x1,i);
   lineto(x2,i);
  end;
  frm.bottom:=y1;
  if fpercent=0 then frm.bottom:=y1+1;
  Canvas.brush.color:=finsidecolor;
  Canvas.fillrect(frm);
end;

begin
  Initvalues;
  Txtrect:=frm;
  canvas.pen.color := FSegColor;
  canvas.brush.color := FsegColor;
  if fkind=kHorizontal then DoHorizontal else DoVertical;
  f3d.write(Font,canvas.handle,Txtrect,inttostr(fpercent)+' %',DT_VCenter or DT_CENTER or DT_Singleline,enabled);
end;

procedure TAHMGauge.Paint;
begin
  if assigned(fback) then fback.Draw(Canvas.Handle,Width,Height,true);
  fbw:=0;
  with Canvas do
  begin
     fl:=fborder;
     fr:=fborder;
     ft:=fborder;
     fb:=fborder;
     if FAHMGlyph.width>0 then
     begin
       fbw:=FAHMGlyph.width;
       if fpp=pLeft then fl:=fBorder+fbw;
       if fpp=pRight then fr:=fBorder+fbw;
       if fpp=pTop then ft:=FBorder+fbw;
       if fpp=pBottom then fb:=fBorder+fbw;
     end;
     pen.Width := 1;
     Brush.Color := FInsideColor;
     case fpp of
       pLeft : FAHMGlyph.Draw(Canvas,1+fouter.totalwidth+round(fborder/2),
                   round(Height/2-FAHMGlyph.height/2),Enabled,False,False);
       pTop  : FAHMGlyph.Draw(Canvas,round(width/2-FAHMGlyph.width/2),
                  1+fouter.totalwidth+round(fborder/2),Enabled,False,False);
       pRight: FAHMGlyph.Draw(Canvas,width-(fouter.totalwidth)-fr+round(fborder/2)+1,
                  round(Height/2-FAHMGlyph.height/2),Enabled,False,False);
       pBottom :FAHMGlyph.Draw(Canvas,round(width/2-FAHMGlyph.width/2)+1,
                  height-fouter.totalwidth-fb+round(fborder/2),Enabled,False,False);
     end;
     Frm:=Rect(0,0,width,height);
     fouter.draw(canvas.handle,frm);
     frm:=rect(frm.left+fl-1,frm.top+ft-1,frm.right-fr,frm.bottom-fb);
     finner.draw(canvas.handle,frm);
     brush.color:=finsidecolor;
     fillrect(frm);
     UpdateProgress;
  end;
end;

end.
