{**********************************************************************
 extracted from Package pl_ExControls.pkg
 From PilotLogic Software House
 for CodeTyphon Project (http://www.pilotlogic.com/)
 This unit is part of CodeTyphon Project
 used by Lazarus for Industrial package
***********************************************************************}

unit indGnouMeter;

{$mode objfpc}{$H+}

interface

uses
  Classes, Controls, Graphics, SysUtils, Messages, LMessages, Types, LCLType, LCLIntf;

type
  TindGnouMeter = class(TGraphicControl)
  private
    fValue: Double;
    fColorFore: TColor;
    fColorBack: TColor;
    fSignalUnit: ShortString;
    fValueMax: Double;
    fValueMin: Double;
    fDigits: Byte;
    fIncrement: Double;
    fShowIncrements: Boolean;
    fGapTop: Word;
    fGapBottom: Word;
    fBarThickness: Word;
    fMarkerColor: TColor;
    fShowMarker: Boolean;
    //Variables used internally
    TopTextHeight: Word;
    LeftMeter: Word;
    DisplayValue: String;
    DrawStyle: integer;
    TheRect: TRect;
    //End of variables used internally
    procedure SetValue(val: Double);
    procedure SetColorBack(val: TColor);
    procedure SetColorFore(val: TColor);
    procedure SetSignalUnit(val: ShortString);
    procedure SetValueMin(val: Double);
    procedure SetValueMax(val: Double);
    procedure SetDigits(val: Byte);
    procedure SetTransparent(val: Boolean);
    function GetTransparent: Boolean;
    procedure SetIncrement(val: Double);
    procedure SetShowIncrements(val: Boolean);
    procedure SetGapTop(val: Word);
    procedure SetGapBottom(val: Word);
    procedure SetBarThickness(val: Word);
    procedure SetMarkerColor(val: TColor);
    procedure SetShowMarker(val: Boolean);
    procedure DrawTopText;
    procedure DrawMeterBar;
    procedure DrawIncrements;
    function ValueToPixels(val: Double): integer;
    procedure DrawValueMax;
    procedure DrawValueMin;
    procedure DrawMarker;
  protected
    procedure Paint; override;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property Caption;
    property Visible;
    property ShowHint;
    property Value: Double read fValue write SetValue;
    property Color;
    property Font;
    property ParentColor;
    property ColorFore: Tcolor read fColorFore write SetColorFore;
    property ColorBack: Tcolor read fColorBack write SetColorBack;
    property SignalUnit: ShortString read fSignalUnit write SetSignalUnit;
    property ValueMin: Double read fValueMin write SetValueMin;
    property ValueMax: Double read fValueMax write SetValueMax;
    property Digits: Byte read fDigits write SetDigits;
    property Increment: Double read fIncrement write SetIncrement;
    property ShowIncrements: Boolean read fShowIncrements write SetShowIncrements;
    property Transparent: Boolean read GetTransparent write SetTransparent;
    property GapTop: Word read fGapTop write SetGapTop;
    property GapBottom: Word read fGapBottom write SetGapBottom;
    property BarThickness: Word read fBarThickness write SetBarThickness;
    property MarkerColor: TColor read fMarkerColor write SetMarkerColor;
    property ShowMarker: Boolean read fShowMarker write SetShowMarker;
  end;


implementation

constructor TindGnouMeter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable, csSetCaption];
  Width := 100;
  Height := 200;
  fColorFore := clRed;
  fColorBack := clBtnFace;
  fMarkerColor := clBlue;
  fValueMin := 0;
  fValueMax := 100;
  fIncrement := 10;
  fShowIncrements := True;
  fShowMarker := True;
  fValue := 0;
  fGapTop := 20;
  fGapBottom := 10;
  fBarThickness := 5;
  fSignalUnit := 'Units';
end;

destructor TindGnouMeter.Destroy;
begin
  inherited Destroy;
end;

procedure TindGnouMeter.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TindGnouMeter.SetValue(val: Double);
begin
  if (val <> fValue) and (val >= fValueMin) and (val <= fValueMax) then
  begin
    fValue := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetColorFore(val: TColor);
begin
  if val <> fColorFore then
  begin
    fColorFore := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetColorBack(val: TColor);
begin
  if val <> fColorBack then
  begin
    fColorBack := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetSignalUnit(val: ShortString);
begin
  if val <> fSignalUnit then
  begin
    fSignalUnit := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetValueMin(val: Double);
begin
  if (val <> fValueMin) and (val <= fValue) then
  begin
    fValueMin := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetValueMax(val: Double);
begin
  if (val <> fValueMax) and (val >= fValue) then
  begin
    fValueMax := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetDigits(val: Byte);
begin
  if (val <> fDigits) then
  begin
    fDigits := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetIncrement(val: Double);
begin
  if (val <> fIncrement) and (val > 0) then
  begin
    fIncrement := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetShowIncrements(val: Boolean);
begin
  if (val <> fShowIncrements) then
  begin
    fShowIncrements := val;
    Invalidate;
  end;
end;

function TindGnouMeter.GetTransparent: Boolean;
begin
  Result := not (csOpaque in ControlStyle);
end;

procedure TindGnouMeter.SetTransparent(Val: Boolean);
begin
  if Val <> Transparent then
  begin
    if Val then
      ControlStyle := ControlStyle - [csOpaque]
    else
      ControlStyle := ControlStyle + [csOpaque];
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetGapTop(val: Word);
begin
  if (val <> fGapTop) then
  begin
    fGapTop := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetGapBottom(val: Word);
begin
  if (val <> fGapBottom) then
  begin
    fGapBottom := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetBarThickness(val: Word);
begin
  if (val <> fBarThickness) and (val > 0) then
  begin
    fBarThickness := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetMarkerColor(val: TColor);
begin
  if (val <> fMarkerColor) then
  begin
    fMarkerColor := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.SetShowMarker(val: Boolean);
begin
  if (val <> fShowMarker) then
  begin
    fShowMarker := val;
    Invalidate;
  end;
end;

procedure TindGnouMeter.DrawIncrements;
var
  i: Double;
  PosPixels: Word;
begin
  if fShowIncrements then
  begin
    with Canvas do
    begin
      i := fValueMin;
      while i <= fValueMax do
      begin
        PosPixels := ValueToPixels(i);
        pen.color := clGray;
        MoveTo(LeftMeter + BarThickness + 3, PosPixels - 1);
        LineTo(LeftMeter + BarThickness + 7, PosPixels - 1);
        pen.color := clWhite;
        MoveTo(LeftMeter + BarThickness + 3, PosPixels);
        LineTo(LeftMeter + BarThickness + 7, PosPixels);
        i := i + fIncrement;
      end;
    end;
  end;
end;

procedure TindGnouMeter.DrawMarker;
begin
  if fShowMarker then
  begin
    with Canvas do
    begin
      pen.color := clWhite;
      Brush.Style := bsClear;
      MoveTo(LeftMeter - 2, ValueToPixels(fValue));
      LineTo(LeftMeter - 6, ValueToPixels(fValue) - 4);
      LineTo(LeftMeter - 6, ValueToPixels(fValue) + 4);
      pen.color := clGray;
      LineTo(LeftMeter - 2, ValueToPixels(fValue));

      pen.color := fMarkerColor;
      Brush.color := fMarkerColor;
      Brush.Style := bsSolid;
      Polygon([Point(LeftMeter - 3, ValueToPixels(fValue)),
        Point(LeftMeter - 5, ValueToPixels(fValue) - 2),
        Point(LeftMeter - 5, ValueToPixels(fValue) + 2),
        Point(LeftMeter - 3, ValueToPixels(fValue))]);
    end;
  end;
end;

procedure TindGnouMeter.DrawTopText;
begin
  with Canvas do
  begin
    DisplayValue := Caption;
    Brush.Style := bsClear;
    TheRect := ClientRect;
    DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_CENTER + DT_TOP;
    Font.Style := [fsBold];
    TopTextHeight := DrawText(Handle, PChar(DisplayValue),
      Length(DisplayValue), TheRect, DrawStyle);

    Font.Style := [];
    TheRect.Top := TopTextHeight;
    DisplayValue := FloatToStrF(Value, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
    TopTextHeight := TopTextHeight + DrawText(Handle, PChar(DisplayValue),
      Length(DisplayValue), TheRect, DrawStyle);
    TopTextHeight := TopTextHeight + fGapTop;
  end;
end;

procedure TindGnouMeter.DrawValueMin;
begin
  with Canvas do
  begin
    TheRect := ClientRect;
    TheRect.Left := LeftMeter + BarThickness + 10;
    TheRect.Top := TopTextHeight;
    TheRect.Bottom := Height - fGapBottom + 6;
    Brush.Style := bsClear;
    DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_LEFT + DT_BOTTOM;
    DisplayValue := FloatToStrF(ValueMin, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
    DrawText(Handle, PChar(DisplayValue), Length(DisplayValue),
      TheRect, DrawStyle);
  end;
end;

procedure TindGnouMeter.DrawValueMax;
begin
  with Canvas do
  begin
    TheRect := ClientRect;
    TheRect.Left := LeftMeter + BarThickness + 10;
    TheRect.Top := TopTextHeight - 6;
    Brush.Style := bsClear;
    DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_LEFT + DT_TOP;
    DisplayValue := FloatToStrF(ValueMax, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
    DrawText(Handle, PChar(DisplayValue), Length(DisplayValue),
      TheRect, DrawStyle);
  end;
end;

procedure TindGnouMeter.DrawMeterBar;
begin
  with Canvas do
  begin
    pen.Color := fColorBack;
    Brush.Color := fColorBack;
    Brush.Style := bsSolid;
    Rectangle(LeftMeter, ValueToPixels(fValueMax), LeftMeter +
      fBarThickness, ValueToPixels(fValueMin));

    pen.Color := fColorFore;
    Brush.Color := fColorFore;
    Brush.Style := bsSolid;
    Rectangle(LeftMeter + 1, ValueToPixels(fValue), LeftMeter +
      fBarThickness, ValueToPixels(fValueMin));

    pen.color := clWhite;
    Brush.Style := bsClear;
    MoveTo(LeftMeter + fBarThickness - 1, ValueToPixels(fValueMax));
    LineTo(LeftMeter, ValueToPixels(fValueMax));
    LineTo(LeftMeter, ValueToPixels(fValueMin) - 1);

    pen.color := clGray;
    LineTo(LeftMeter + fBarThickness, ValueToPixels(fValueMin) - 1);
    LineTo(LeftMeter + fBarThickness, ValueToPixels(fValueMax));

    if (fValue > fValueMin) and (fValue < fValueMax) then
    begin
      pen.color := clWhite;
      MoveTo(LeftMeter + 1, ValueToPixels(fValue));
      LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue));
      pen.color := clGray;
      MoveTo(LeftMeter + 1, ValueToPixels(fValue) - 1);
      LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue) - 1);
    end;

  end;
end;

function TindGnouMeter.ValueToPixels(val: Double): integer;
var
  factor: Double;
begin
  Result := 0;
  if fValueMax > fValueMin then
  begin
    Factor := (Height - fGapBottom - TopTextHeight) / (fValueMin - fValueMax);
    Result := Round(Factor * val - Factor * fValueMax + TopTextHeight);
  end;
end;

procedure TindGnouMeter.Paint;
begin
  LeftMeter := (Width div 2) - 10 - fBarThickness;
  with Canvas do
  begin
    if not Transparent then
    begin
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
      FillRect(ClientRect);
    end;
    Brush.Style := bsClear;
    DrawTopText;
    DrawValueMin;
    DrawValueMax;
    DrawMeterBar;
    DrawMarker;
    DrawIncrements;
  end;
end;

end.