unit PressureGauge;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Mask;

const
  DefDigits = 5;
  DefDecimals = 2;
type
  TPressure = single;
    { Always in Pa }

  TPressureUnit = (MPa, kPa, hPa, Pa, miPa);
    { For displaying purposes }

  TPressureGauge = class(TPanel{TCustomControl})
  private
    { Private declarations }
    FPressureEdit: TMaskEdit;
    FLowLimitEdit: TMaskEdit;
    FHighLimitEdit: TMaskEdit;

    {FPressure: TPressure;
    FLowLimit: TPressure;
    FHighLimit: TPressure;}

    FPressureUnit: TPressureUnit;
    FDecimals: integer;
    FDigits: integer; {parent}
    FDefaultSizes: boolean;
    FLeftLabel: string;
    FRightLabel: string;
    FUpdating: integer;
  protected
    { Protected declarations }
    procedure Paint;override;
    procedure SetPressure(APressure: TPressure);
    procedure SetLowLimit(ALowLimit: TPressure);
    procedure SetHighLimit(AHighLimit: TPressure);
    function GetPressure: TPressure;
    function GetLowLimit: TPressure;
    function GetHighLimit: TPressure;

    procedure SetDecimals(ADecimals: integer);
    procedure SetDigits(ADigits: integer);
    procedure SetPressureUnit(APressureUnit: TPressureUnit);

    function TextToPressure(AText: string): TPressure;
    function PressureToText(APressure: TPressure): string;
    function GetCoef: single;
    procedure UpdatePressures;
    procedure UpdatePlacement;
    procedure UpdateEditMasks;
    procedure UpdateEditMask(AMaskEdit: TMaskEdit; const AMask: string);
    function GetPressureUnitString: string;
    procedure EditChanged(Sender: TObject);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); reintroduce;
    procedure SetDefaultSizes;
    procedure SetDefaults;

  published
    { Published declarations }
    property Pressure: TPressure read GetPressure write SetPressure;
    property LowLimit: TPressure read GetLowLimit write SetLowLimit;
    property HighLimit: TPressure read GetHighLimit write SetHighLimit;
    property PressureUnit: TPressureUnit read FPressureUnit write SetPressureUnit default MPa;
    property Decimals: integer read FDecimals write SetDecimals default DefDecimals;
    property Digits: integer read FDigits write SetDigits default DefDigits;
    property DefaultSizes: boolean read FDefaultSizes write FDefaultSizes default true;
    property LeftLabel: string read FLeftLabel write FLeftLabel;
    property RightLabel: string read FRightLabel write FRightLabel;
    property PressureUnitString: string read GetPressureUnitString;
  end;

procedure Register;

implementation

constructor TPressureGauge.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inc(FUpdating);
  try
    FPressureEdit := TMaskEdit.Create(Self);
    FPressureEdit.Parent := Self;
    FPressureEdit.OnChange := EditChanged;
    FLowLimitEdit:= TMaskEdit.Create(Self);
    FLowLimitEdit.Parent := Self;
    FLowLimitEdit.OnChange := EditChanged;
    FHighLimitEdit:= TMaskEdit.Create(Self);
    FHighLimitEdit.Parent := Self;
    FHighLimitEdit.OnChange := EditChanged;

    if csDesigning in ComponentState then begin
      SetDefaults;
    end;
{  end else begin
    UpdateEditMasks;
    UpdatePressures;
    UpdatePlacement;}
  finally
    dec(FUpdating);
  end;
end;

const
  PressureGaugeWidth = 200;
  PressureGaugeHeight = 150;
  PressureEditWidth = 60;
  PressureEditMargin = 10;

  DispMargin = 5;
  AxisDispMargin = 20;
  DashLen = 5;

procedure TPressureGauge.SetDefaultSizes;
begin
  inc(FUpdating);
  try
  Width := PressureGaugeWidth;
  Height := PressureGaugeHeight;
  FPressureEdit.Width := PressureEditWidth;
  FLowLimitEdit.Width :=  PressureEditWidth;
  FHighLimitEdit.Width :=  PressureEditWidth;
  UpdatePlacement;
  finally
    dec(FUpdating);
  end;
end;

procedure TPressureGauge.SetDefaults;
begin
  FDigits := DefDigits;
  FDecimals := DefDecimals;
  FPressureEdit.Text := '0';
  FLowLimitEdit.Text := '0';
  FHighLimitEdit.Text := '0';
  FLeftLabel := 'P1';
{  Enabled := false;}
  SetDefaultSizes;
  UpdateEditMasks;
  UpdatePressures;
  HighLimit := 20000000;
end;

procedure TPressureGauge.UpdatePlacement;
begin
  FPressureEdit.Top := Top + PressureEditMargin;
  FPressureEdit.Left := (Width div 2) - (FPressureEdit.Width div 2);

  FLowLimitEdit.Left := PressureEditMargin;
  FLowLimitEdit.Top := Height - PressureEditMargin - FLowLimitEdit.Height;

  FHighLimitEdit.Left := Width - PressureEditMargin - FHighLimitEdit.Width;
  FHighLimitEdit.Top := Height - PressureEditMargin - FHighLimitEdit.Height;
end;

function TPressureGauge.GetCoef: single;
begin
  case FPressureUnit of
    miPa: Result := 0.001;
    Pa:  Result := 1;
    hPa: Result := 100;
    kPa: Result := 1000;
    MPa: Result := 1000000;
  end;
end;

function TPressureGauge.TextToPressure(AText: string): TPressure;
begin
  AText := Trim(AText);
  if (AText = '') or (AText = DecimalSeparator) then
    Result := 0
  else begin
    Result := StrToFloat(AText) * GetCoef;
  end;
end;

function TPressureGauge.PressureToText(APressure: TPressure): string;
var s:string;
begin
  s := FloatToStrF(APressure/GetCoef, ffFixed, FDigits, FDecimals);
  while length(s) < FDigits do
    s := '0' + s;
  Result := s;
end;

procedure TPressureGauge.Paint;
var
  {disp left top bottom height width:}
  dl: integer;
  dt: integer;
  db: integer;
  dh: integer;
  dw: integer;

  {arc }
{  ar1: integer;{arc shorter radius}
{  ar2: integer;{arc longer radius}
{  acx: integer;{ center x }
{  acy: integer;{ center y }
   {axis }
  atop, aleft, awidth: integer;
  aheight: integer;

  {value pointer}
  px, pl1, pl2: integer;

var r:TRect;
begin
  if FUpdating > 0 then
    exit;
  inherited Paint;
{  Canvas.Rectangle(0, 0, Width, Height);}

  dl := DispMargin;
  dw := Width - 2 * DispMargin;
  dh := Height - FHighLimitEdit.Height - PressureEditMargin - 2 * DispMargin;
  dt := DispMargin;
  db := dt + dh;
  {
  Canvas.Rectangle(DispMargin, DispMargin, Width - DispMargin,
    Height - FHighLimitEdit.Height - PressureEditMargin - DispMargin);}

  r.Left := DispMargin;
  r.Top := DispMargin;
  r.Right := Width - DispMargin;
  r.Bottom := Height - FHighLimitEdit.Height - PressureEditMargin - DispMargin;
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(r);
  Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom);

    {
  acy := db;
  acx := Width div 2;
  ar1 := dh - 2 * DispMargin - FPressureEdit.Height;
  ar2 := (dw - 4 * DispMargin - 2 * Canvas.TextWidth('P1MPa')) div 2;
  Canvas.Arc(acx - ar2, acy + ar1, acx + ar2, acy - ar1, Width - DispMargin, DispMargin
  ,DispMargin, DispMargin);
    }
  aheight := db - FPressureEdit.Top - FPressureEdit.Height;
  atop := FPressureEdit.Top + FPressureEdit.Height + aheight div 2;
  aleft := dl + AxisDispMargin;
  awidth := dw - 2 * AxisDispMargin;

  Canvas.MoveTo(aleft, atop);
  Canvas.LineTo(aleft + awidth, atop);
  Canvas.MoveTo(aleft + awidth, atop - DashLen);
  Canvas.LineTo(aleft + awidth, atop + DashLen);
  Canvas.MoveTo(aleft, atop - DashLen);
  Canvas.LineTo(aleft, atop + DashLen);
  if HighLimit > LowLimit then begin
    px := aleft + (awidth * round( (Pressure - LowLimit) / (HighLimit - LowLimit)));
    if px < aleft then
      px := aleft
    else if px > aleft + awidth then
      px := aleft + awidth;

    pl1 := aheight div 8;
    pl2 := aheight div 4;
    Canvas.MoveTo(px, atop - pl1);
    Canvas.LineTo(px, atop + pl2);
  end;

  Canvas.TextOut(dl + DispMargin, db - Canvas.TextHeight(LeftLabel) - DispMargin,
    LeftLabel);
  Canvas.TextOut(dl + dw - DispMargin - Canvas.TextWidth(PressureUnitString),
    db - Canvas.TextHeight(PressureUnitString) - DispMargin,
    PressureUnitString);

end;

procedure TPressureGauge.SetPressure(APressure: TPressure);
var
  s: string;
begin
  s := PressureToText(APressure);
  if s <> FPressureEdit.Text then
    FPressureEdit.Text := PressureToText(APressure);
end;

function TPressureGauge.GetPressure: TPressure;
begin
  Result := TextToPressure(FPressureEdit.Text);
end;

function TPressureGauge.GetLowLimit: TPressure;
begin
  Result := TextToPressure(FLowLimitEdit.Text);
end;

procedure TPressureGauge.SetLowLimit(ALowLimit: TPressure);
var s: string;
begin
  s := PressureToText(ALowLimit);
  if s <> FLowLimitEdit.Text then begin
    FLowLimitEdit.Text := s;
  end;
end;

function TPressureGauge.GetHighLimit: TPressure;
begin
  Result := TextToPressure(FHighLimitEdit.Text);
end;

procedure TPressureGauge.SetHighLimit(AHighLimit: TPressure);
var s: string;
begin
  s := PressureToText(AHighLimit);
  if s <> FHighLimitEdit.Text then begin
    FHighLimitEdit.Text := s;
  end;
end;

procedure TPressureGauge.SetDecimals(ADecimals: integer);
begin
  if FDecimals <> ADecimals then begin
    FDecimals := ADecimals;
    UpdateEditMasks;
    UpdatePressures;
  end;
end;

procedure TPressureGauge.SetPressureUnit(APressureUnit: TPressureUnit);
begin
  if FPressureUnit <> APressureUnit then begin
    FPressureUnit := APressureUnit;
    UpdatePressures;
  end;
end;

procedure TPressureGauge.SetDigits(ADigits: integer);
begin
  if FDigits <> ADigits then begin
    FDigits := ADigits;
    UpdateEditMasks;
    UpdatePressures;
  end;
end;

procedure TPressureGauge.UpdatePressures;
begin
  Pressure := Pressure;
  HighLimit := HighLimit;
  LowLimit := LowLimit;
end;

procedure TPressureGauge.UpdateEditMasks;
var
  s: string;
  i: integer;
begin
  s := '';
  if FDecimals <> 0 then begin
    for i := 1 to FDecimals do
      s := s + '0';
    s := '0' + DecimalSeparator + s;
  end else begin
    s := '0';
  end;
  while length(s) < FDigits do
    s := '9' + s;
  s := s;
  UpdateEditMask(FPressureEdit, s);
  UpdateEditMask(FLowLimitEdit, s);
  UpdateEditMask(FHighLimitEdit, s);
end;

procedure TPressureGauge.UpdateEditMask(AMaskEdit: TMaskEdit; const AMask: string);
var s:string;
begin
  AMaskEdit.EditMask := AMask;
  s := Trim(AMaskEdit.Text);
  if s = '' then
    AMaskEdit.Text := '0';
end;

function TPressureGauge.GetPressureUnitString: string;
begin
  case FPressureUnit of
    miPa: Result := 'mPa';
    Pa:  Result := 'Pa';
    hPa: Result := 'hPa';
    kPa: Result := 'kPa';
    MPa: Result := 'MPa';
  end;
end;

procedure TPressureGauge.EditChanged(Sender: TObject);
begin
  if Sender is TMaskEdit then with Sender as TMaskEdit do begin
    {if true then begin
      if Modified then begin
        if Sender = FPressureEdit then
          FPressureEdit := TextToPressure(Text)
        else if Sender = FLowLimitEdit then
          FLowLimit := TextToPressure(Text)
        else if Sender = FHighLimitEdit then
          FHighLimit := TextToPressure(Text);
      end;
    end;
    }
    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents('Chromulan', [TPressureGauge]);
end;

end.
