unit ValuePanel;

interface
{.$DEFINE DEBVP}{don't undefine after installed in BPL!!!}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, FnpNumericEdit {$IFDEF DEBPV},ExeLogu{$ENDIF};

const
  DefDigits = 5;
  DefDecimals = 2;

const
  ValuePanelWidth = 160;
  ValuePanelHeight = 120;
  ValueEditWidth = 50;
  ValueEditMargin = 5;

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

type
  TValue = extended;
  TQuantity = (Pressure, Temperature);
    { Set/Get Value for

        Pressure is ALWAYS in Pa
        Temperature is ALWAYS in deg.C

      Set/Get UsrValue is in currently set units
    }

  { For displaying purposes: }
  TTemperatureUnit = (Celsius, Kelvin, Fahrnheit);
  TPressureUnit = (MPa, kPa, hPa, Pa, miPa);

  TValuePanel = class(TPanel{TCustomControl})
  private
    { Private declarations }
    FQuantity: TQuantity;
      FPressureUnit: TPressureUnit;
      FTemperatureUnit: TTemperatureUnit;

    FValueEdit: TFnpNumericEdit;
    FValueMinEdit: TFnpNumericEdit;
    FValueMaxEdit: TFnpNumericEdit;

    FValue: TValue;
    FValueMin: TValue;
    FValueMax: TValue;

    FDecimals: integer;
    FDigits: integer; {parent}
    {FDefaultSizes: boolean;}
    FLeftLabel: string;
    {FRightLabel: string;}
    FUpdating: integer;
    FUsingEdits: boolean;
    FMoveable: boolean;
    FEditHeight: integer;
    FValueEditTop: integer;
    FRefreshing: boolean;
    FEditsCreating: boolean;
    FOnValueChange: TNotifyEvent;
    FOnValueMinChange: TNotifyEvent;
    FOnValueMaxChange: TNotifyEvent;

  protected
    { Protected declarations }
    procedure Paint;override;
    procedure SetQuantity(AQuantity: TQuantity);

    procedure SetValue(AValue: TValue);
    procedure SetValueMin(AValueMin: TValue);
    procedure SetValueMax(AValueMax: TValue);
    function GetValue: TValue;
    function GetValueMin: TValue;
    function GetValueMax: TValue;

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

    function UsrToValue(AUsrValue: TValue): TValue;
    function ValueToUsr(AValue: TValue): TValue;
    function GetCoef: TValue; { returns number used for dividing the
      basic unit value (Pa, C) to get Usr value }
    function GetOffs: TValue; { returns number used to be added to the
      basic unit value after division by Coef }
    procedure UpdateValues;
    procedure UpdateEditsPlacement;
    procedure UpdateEditMasks;
    {procedure UpdateEditMask(AMaskEdit: TMaskEdit; const AMask: string);}
    function GetValueUnitString: string;
    procedure EditChanged(Sender: TObject);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMLButtonDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
    function NotUsingEdits: boolean;
    procedure SetFieldDefaults;
      { called from constructor to set default Fxxx values }
    procedure EditsCreate;
    procedure Loaded;override;
    procedure SetLeftLabel(ALabel:string);
    procedure ValueEditChanged(Sender: TObject);
    procedure ValueMinEditChanged(Sender: TObject);
    procedure ValueMaxEditChanged(Sender: TObject);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); reintroduce;
    {procedure SetDefaultSizes;}

  published
    { Published declarations }
    property Quantity: TQuantity read FQuantity write SetQuantity;
    property PressureUnit: TPressureUnit read FPressureUnit write SetPressureUnit
      default MPa;
    property TemperatureUnit: TTemperatureUnit read FTemperatureUnit write SetTemperatureUnit
      default Celsius;
    property Value: TValue read GetValue write SetValue;
    {property UsrValue: TValue read GetUsrValue write SetUsrValue;}
    property ValueMin: TValue read GetValueMin write SetValueMin;
    property ValueMax: TValue read GetValueMax write SetValueMax;
    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 SetLeftLabel;
    {property RightLabel: string read FRightLabel write FRightLabel;}
    property Moveable: boolean read FMoveable write FMoveable;
    property ValueUnitString: string read GetValueUnitString;
    property OnValueChange: TNotifyEvent read FOnValueChange write FOnValueChange;
    property OnValueMinChange: TNotifyEvent read FOnValueMinChange write FOnValueMinChange;
    property OnValueMaxChange: TNotifyEvent read FOnValueMaxChange write FOnValueMaxChange;
  end;

procedure Register;

implementation

constructor TValuePanel.Create(AOwner: TComponent);
{var o:TComponent;}
begin
  inherited Create(AOwner);
  inc(FUpdating);
  try
    SetFieldDefaults;

    if not NotUsingEdits then begin
      EditsCreate;
    end;

  finally
    dec(FUpdating);
  end;
end;

procedure TValuePanel.ValueEditChanged(Sender: TObject);
begin
  EditChanged(Sender);
  if Assigned(FOnValueChange) then
    FOnValueChange(Self);
end;

procedure TValuePanel.ValueMinEditChanged(Sender: TObject);
begin
  EditChanged(Sender);
  if Assigned(FOnValueMinChange) then
    FOnValueMinChange(Self);
end;

procedure TValuePanel.ValueMaxEditChanged(Sender: TObject);
begin
  EditChanged(Sender);
  if Assigned(FOnValueMaxChange) then
    FOnValueMaxChange(Self);
end;

procedure TValuePanel.EditsCreate;
var o: TComponent;
begin
  if FValueEdit <> nil then begin
    UpdateEditsPlacement;
    exit;
  end;
  FEditsCreating := true;
  try
    o := Self;{AOwner;}
    FValueEdit := TFnpNumericEdit.Create(o);
    {FValueEdit.Name := Name + 'Value';}
    FValueEdit.Parent := Self;
    FValueEdit.OnChange := ValueEditChanged;
    FValueEdit.Decimals := DefDecimals;


    FValueMinEdit:= TFnpNumericEdit.Create(o);
    {FValueMinEdit.Name := Name + 'ValueMin';}
    FValueMinEdit.Parent := Self;
    FValueMinEdit.OnChange := ValueMinEditChanged;
    FValueMinEdit.Decimals := DefDecimals;

    FValueMaxEdit:= TFnpNumericEdit.Create(o);
    {FValueMaxEdit.Name := Name + 'ValueMax';}
    FValueMaxEdit.Parent := Self;
    FValueMaxEdit.OnChange := ValueMaxEditChanged;
    FValueMaxEdit.Decimals := DefDecimals;

    FValueEdit.Width := ValueEditWidth;
    {FValueEdit.Height := FEditHeight;}
    FEditHeight := FValueEdit.Height;

    FValueMinEdit.Width :=  ValueEditWidth;
    FValueMinEdit.Height := FEditHeight;

    FValueMaxEdit.Width :=  ValueEditWidth;
    FValueMaxEdit.Height :=  FEditHeight;

    UpdateEditsPlacement;
    UpdateValues;
  finally
    FEditsCreating := false;
  end;
end;

procedure TValuePanel.Loaded;
begin
  inherited Loaded;
  {v0.24}
  if csDesigning in ComponentState then
    exit;
  {/v0.24}
  EditsCreate;
end;

procedure TValuePanel.SetFieldDefaults;
begin
  FDigits := DefDigits;
  FDecimals := DefDecimals;
  FQuantity := Pressure;
  FLeftLabel := 'P1';
  FValueMax := 20000000;
  Width := ValuePanelWidth;
  Height := ValuePanelHeight;
  FEditHeight := 30;
  FValueEditTop := ValueEditMargin;
  FUsingEdits := true;
  {SetDefaultSizes;}
  {UpdateEditMasks;}
  {UpdateValues;}
end;

procedure TValuePanel.UpdateEditsPlacement;
begin
  FValueEditTop := ValueEditMargin;
  FValueEdit.Top := FValueEditTop;
  FValueEdit.Left := (Width div 2) - (FValueEdit.Width div 2);

  FValueMinEdit.Left := ValueEditMargin;
  FValueMinEdit.Top := Height - ValueEditMargin - FValueMinEdit.Height;

  FValueMaxEdit.Left := Width - ValueEditMargin - FValueMaxEdit.Width;
  FValueMaxEdit.Top := Height - ValueEditMargin - FValueMaxEdit.Height;
end;

function TValuePanel.GetCoef: TValue;
begin
  case FQuantity of
    Pressure: begin
      case FPressureUnit of
        miPa: Result := 0.001;
        Pa:  Result := 1;
        hPa: Result := 100;
        kPa: Result := 1000;
        MPa: Result := 1000000;
      else
        Result := 1;
      end;
    end;
    Temperature: begin
      case FTemperatureUnit of
        Celsius, Kelvin: Result := 1;
        Fahrnheit: Result := 1;{not yet}
      else
        Result := 1;
      end;
    end;
  else
    Result := 1;
  end;
end;

function TValuePanel.GetOffs: TValue;
begin
  case FQuantity of
    Pressure: begin
      Result := 0;
    end;
    Temperature: begin
      case FTemperatureUnit of
        Celsius: Result := 0;
        Kelvin: Result := 273;
        Fahrnheit: Result := 0;{not yet}
      else
        Result := 0;
      end;
    end;
  else
    Result := 0;
  end;
end;

function TValuePanel.UsrToValue(AUsrValue: TValue): TValue;
begin
  Result := (AUsrValue - GetOffs) * GetCoef;
end;

function TValuePanel.ValueToUsr(AValue: TValue): TValue;
begin
  Result := AValue/GetCoef + GetOffs;
{ ffFixed, FDigits, FDecimals);
  while length(s) < FDigits do
    s := '0' + s;
  Result := s; }
end;

procedure TValuePanel.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;

  r:TRect;

  v,lv,hv: TValue;

  pw:integer;
begin
  if FUpdating > 0 then
    exit;
  inherited Paint;

{  Canvas.Rectangle(0, 0, Width, Height);}

  dl := DispMargin;
  dw := Width - 2 * DispMargin;
  dh := Height - FEditHeight{FValueMaxEdit.Height} - ValueEditMargin - 2 * DispMargin;
  dt := DispMargin;
  db := dt + dh;

{ Canvas.Rectangle(DispMargin, DispMargin, Width - DispMargin,
  Height - FValueMaxEdit.Height - ValueEditMargin - DispMargin); }

  r.Left := DispMargin;
  r.Top := DispMargin;
  r.Right := Width - DispMargin;
  r.Bottom := Height - FEditHeight{FValueMaxEdit.Height} - ValueEditMargin - 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 - FValueEdit.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 - FValueEditTop{FValueEdit.Top} - FEditHeight{FValueEdit.Height};
  atop := FValueEditTop{FValueEdit.Top} + FEditHeight{FValueEdit.Height} +
    (aheight - Canvas.TextWidth(ValueUnitString)) 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);

  hv := ValueMax;
  lv := ValueMin;
  v := Value;

  if hv > lv then begin
    {$IFDEF DEBVP}ExeLog.Log('Paint ' + IntToStr(px));{$ENDIF}
    px := aleft + round(awidth * (v - lv) / (hv - lv));
    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);
    pw := Canvas.Pen.Width;
    Canvas.Pen.Width := 3;
    Canvas.LineTo(px, atop + pl2);
    Canvas.Pen.Width := pw;
  end;

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

procedure TValuePanel.SetValue(AValue: TValue);
begin
  if (FValue <> AValue) or FRefreshing then begin
    FValue := AValue;
    if not NotUsingEdits then
      FValueEdit.AsFloat := ValueToUsr(AValue);
  end;
end;

function TValuePanel.GetValue: TValue;
begin
  Result := FValue;{UsrToValue(FValueEdit.AsFloat);}
end;

function TValuePanel.GetValueMin: TValue;
begin
  Result := FValueMin;{UsrToValue(FValueMinEdit.AsFloat);}
end;

procedure TValuePanel.SetValueMin(AValueMin: TValue);
begin
  if (FValueMin <> AValueMin) or FRefreshing  then begin
    FValueMin := AValueMin;
    if not NotUsingEdits then
      FValueMinEdit.AsFloat := ValueToUsr(AValueMin);
  end;
end;

function TValuePanel.GetValueMax: TValue;
begin
  Result := FValueMax;{UsrToValue(FValueMaxEdit.AsFloat);}
end;

procedure TValuePanel.SetValueMax(AValueMax: TValue);
begin
  if (FValueMax <> AValueMax) or FRefreshing  then begin
    FValueMax := AValueMax;
    if not NotUsingEdits then
      FValueMaxEdit.AsFloat := ValueToUsr(AValueMax);
  end;
end;

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

procedure TValuePanel.SetQuantity(AQuantity: TQuantity);
begin
  if FQuantity <> AQuantity then begin
    FQuantity := AQuantity;
    UpdateValues;
  end;
end;

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

procedure TValuePanel.SetTemperatureUnit(ATemperatureUnit: TTemperatureUnit);
begin
  if FTemperatureUnit <> ATemperatureUnit then begin
    FTemperatureUnit := ATemperatureUnit;
    UpdateValues;
    Invalidate;
  end;
end;

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

procedure TValuePanel.UpdateValues;
begin
  FRefreshing := true;
  try
    Value := Value;
    ValueMax := ValueMax;
    ValueMin := ValueMin;
  finally
    FRefreshing := false;
  end;

  Invalidate;
end;

procedure TValuePanel.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(FValueEdit, s);
  UpdateEditMask(FValueMinEdit, s);
  UpdateEditMask(FValueMaxEdit, s);
  }
end;
{
procedure TValuePanel.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 TValuePanel.GetValueUnitString: string;
begin
  case FQuantity of
    Pressure: begin
      case FPressureUnit of
        miPa: Result := 'mPa';
        Pa:  Result := 'Pa';
        hPa: Result := 'hPa';
        kPa: Result := 'kPa';
        MPa: Result := 'MPa';
      end;
    end;
    Temperature: begin
      case FTemperatureUnit of
        Celsius: Result := '°C';{uldpobju}
        Fahrnheit: Result := 'F';
        Kelvin: Result := 'K';
      end;
    end;
  end;
end;

procedure TValuePanel.EditChanged(Sender: TObject);
begin
  if Sender is TFnpNumericEdit then with Sender as TFnpNumericEdit do begin
    if not FEditsCreating then begin
      if Sender = FValueEdit then
        FValue := UsrToValue(AsFloat)
      else if Sender = FValueMinEdit then
        FValueMin := UsrToValue(AsFloat)
      else if Sender = FValueMaxEdit then
        FValueMax := UsrToValue(AsFloat);
    end;
  end;
  Invalidate;
  {$IFDEF DEBVP} ExeLog.Log('Invalidate');{$ENDIF}
end;

procedure TValuePanel.WMSize(var Message: TWMSize);
begin
  inherited;
  if not NotUsingEdits then
    UpdateEditsPlacement;
{  GridLines := 6 * GridLineWidth;
  DefaultColWidth := (Message.Width - GridLines) div 7;
  DefaultRowHeight := (Message.Height - GridLines) div 7;}
end;

function TValuePanel.NotUsingEdits: boolean;
begin
  Result := ((csDesigning in ComponentState) or (not FUsingEdits)) and (FValueEdit = nil);
end;


procedure TValuePanel.SetLeftLabel(ALabel:string);
begin
  FLeftLabel := ALabel;
  Invalidate;
end;

procedure TValuePanel.WMLButtonDown(var Message: TWMMouse);
const  SC_DragMove = $F012;{61458} {winutl}
  {
    F001 - size control left
    F002 - size control right
    F003 - size control top
    F004 - size control left top
    F005 - size control top right
    F006 - size control down
    F007 - size control left down
    F008 - size control right down
    F009 - move control
    F00A - nothing
    F00B - size control top
    F00C - mouse up/down size control right edge(left/right)
  }
begin
  if csDesigning in ComponentState then begin
    inherited;
  end else begin
    {v0.24}
    if not FMoveable then
      exit;
    {/v0.24}
    ReleaseCapture;
    Perform(WM_SysCommand, SC_DragMove, 0);
  end;
{  inherited;}
end;

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

end.
