lazarus-ccr/components/rx/curredit.pas

{ curredit unit

  Copyright (C) 2005-2010 Lagunov Aleksey alexs@hotbox.ru and Lazarus team
  original conception from rx library for Delphi (c)

  This library is free software; you can redistribute it and/or modify it
  under the terms of the GNU Library General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at your
  option) any later version with the following modification:

  As a special exception, the copyright holders of this library give you
  permission to link this library with independent modules to produce an
  executable, regardless of the license terms of these independent modules,and
  to copy and distribute the resulting executable under terms of your choice,
  provided that you also meet, for each linked independent module, the terms
  and conditions of the license of that module. An independent module is a
  module which is not derived from or based on this library. If you modify
  this library, you may extend this exception to your version of the library,
  but you are not obligated to do so. If you do not wish to do so, delete this
  exception statement from your version.

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  You should have received a copy of the GNU Library General Public License
  along with this library; if not, write to the Free Software Foundation,
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}

unit curredit;

{$I rx.inc}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  LMessages, MaskEdit;

type

  { TCustomNumEdit }

  TCustomNumEdit = class(TCustomMaskEdit)
  private
    FCanvas: TControlCanvas;
    FAlignment: TAlignment;
    FBeepOnError: Boolean;
    FCheckOnExit: Boolean;
    FDecimalPlaces: Cardinal;
    FDisplayFormat: string;
    FFormatOnEditing: Boolean;
    FFormatting: Boolean;
    FMaxValue: Extended;
    FMinValue: Extended;
    FValue: Extended;
    FFocused: Boolean;
    FZeroEmpty: Boolean;
    function GetAsInteger: Longint;
    function GetText: string;
    function GetValue: Extended;
    function IsFormatStored: boolean;
    procedure SetAlignment(const AValue: TAlignment);
    procedure SetAsInteger(const AValue: Longint);
    procedure SetBeepOnError(const AValue: Boolean);
    procedure SetDecimalPlaces(const AValue: Cardinal);
    procedure SetDisplayFormat(const AValue: string);
    procedure SetFormatOnEditing(const AValue: Boolean);
    procedure SetMaxValue(const AValue: Extended);
    procedure SetMinValue(const AValue: Extended);
    procedure SetText(const AValue: string);
    procedure SetValue(const AValue: Extended);
    procedure SetZeroEmpty(const AValue: Boolean);
    function TextToValText(const AValue: string): string;
    function CheckValue(NewValue: Extended; RaiseOnError: Boolean): Extended;
    procedure SetFocused(Value: Boolean);
  protected
    //messages
    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
    procedure CMEnter(var Message: TLMEnter); message LM_ENTER;
    procedure WMExit(var Message: TLMExit); message LM_EXIT;
    procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
    procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
    procedure WMPaste(var Message: TLMessage); message LM_PASTE;
    procedure GetSel(var ASelStart: Integer; var SelStop: Integer);
    procedure DoEnter; override;
    procedure DoExit; override;
//    procedure AcceptValue(const Value: Variant); override;

    procedure Change; override;
    procedure ReformatEditText; dynamic;
    procedure DataChanged; virtual;
    function DefaultDisplayFormat: string; virtual;
    procedure KeyPress(var Key: Char); override;
    function IsValidChar(Key: Char): Boolean; virtual;
    function FormatDisplayText(Value: Extended): string;
    function GetDisplayText: string; virtual;
    procedure Reset; override;
    procedure CheckRange;
    procedure UpdateData;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property Formatting: Boolean read FFormatting;
    property BeepOnError: Boolean read FBeepOnError write SetBeepOnError
      default True;
    property CheckOnExit: Boolean read FCheckOnExit write FCheckOnExit default False;
    property DecimalPlaces: Cardinal read FDecimalPlaces write SetDecimalPlaces
      default 2;
    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat stored IsFormatStored;
    property MaxValue: Extended read FMaxValue write SetMaxValue;
    property MinValue: Extended read FMinValue write SetMinValue;
    property FormatOnEditing: Boolean read FFormatOnEditing
      write SetFormatOnEditing default False;
    property Text: string read GetText write SetText stored False;
    property MaxLength default 0;
    property ZeroEmpty: Boolean read FZeroEmpty write SetZeroEmpty default True;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    property AsInteger: Longint read GetAsInteger write SetAsInteger;
    property DisplayText: string read GetDisplayText;
    property Value: Extended read GetValue write SetValue;
  published
    { Published declarations }
  end;
  
  { TCurrencyEdit }

  TCurrencyEdit = class(TCustomNumEdit)
  protected
    function DefaultDisplayFormat: string; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Alignment;
    property AutoSelect;
    property AutoSize;
    property BeepOnError;
    property BorderStyle;
    property BorderSpacing;
    property CheckOnExit;
    property Color;
    property DecimalPlaces;
    property DisplayFormat;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property FormatOnEditing;
//    property HideSelection;
    property Anchors;
//    property BiDiMode;
    property Constraints;
    property DragKind;
//    property ParentBiDiMode;
{$IFDEF WIN32}
  {$IFNDEF VER90}
//    property ImeMode;
//    property ImeName;
  {$ENDIF}
{$ENDIF}
    property MaxLength;
    property MaxValue;
    property MinValue;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Value;
    property Visible;
    property ZeroEmpty;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF RX_D5}
    property OnContextPopup;
{$ENDIF}
{$IFDEF WIN32}
    property OnStartDrag;
{$ENDIF}
{$IFDEF RX_D4}
    property OnEndDock;
    property OnStartDock;
{$ENDIF}
  end;

implementation
uses rxstrutils, Math, tooledit;

function IsValidFloat(const Value: string; var RetValue: Extended): Boolean;
var
  I: Integer;
  Buffer: array[0..63] of Char;
begin
  Result := False;
  for I := 1 to Length(Value) do
    if not (Value[I] in [DecimalSeparator, '-', '+', '0'..'9', 'e', 'E']) then
      Exit;
  Result := TextToFloat(StrPLCopy(Buffer, Value,
    SizeOf(Buffer) - 1), RetValue, fvExtended);
end;

function FormatFloatStr(const S: string; Thousands: Boolean): string;
var
  I, MaxSym, MinSym, Group: Integer;
  IsSign: Boolean;
begin
  Result := '';
  MaxSym := Length(S);
  IsSign := (MaxSym > 0) and (S[1] in ['-', '+']);
  if IsSign then MinSym := 2
  else MinSym := 1;
  I := Pos(DecimalSeparator, S);
  if I > 0 then MaxSym := I - 1;
  I := Pos('E', AnsiUpperCase(S));
  if I > 0 then MaxSym := Min(I - 1, MaxSym);
  Result := Copy(S, MaxSym + 1, MaxInt);
  Group := 0;
  for I := MaxSym downto MinSym do begin
    Result := S[I] + Result;
    Inc(Group);
    if (Group = 3) and Thousands and (I > MinSym) then begin
      Group := 0;
      Result := ThousandSeparator + Result;
    end;
  end;
  if IsSign then Result := S[1] + Result;
end;

{ TCustomNumEdit }

function TCustomNumEdit.GetAsInteger: Longint;
begin
  Result := Trunc(Value);
end;

function TCustomNumEdit.GetDisplayText: string;
begin
  Result := FormatDisplayText(FValue);
end;

procedure TCustomNumEdit.Reset;
begin
  DataChanged;
  SelectAll;
end;

procedure TCustomNumEdit.CheckRange;
begin
  if not (csDesigning in ComponentState) and CheckOnExit then
    CheckValue(StrToFloat(TextToValText(EditText)), True);
end;

procedure TCustomNumEdit.UpdateData;
begin
  ValidateEdit;
  FValue := CheckValue(StrToFloat(TextToValText(EditText)), False);
end;

constructor TCustomNumEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption];
  MaxLength := 0;
  FBeepOnError := True;
  FAlignment := taRightJustify;
  FDisplayFormat := DefaultDisplayFormat;
  FDecimalPlaces := 2;
  FZeroEmpty := True;
//  inherited Text := '';
//  inherited Alignment := taLeftJustify;
//  FDefNumGlyphs := 2;
  { forces update }
  DataChanged;
  ControlState := ControlState + [csCreating];
end;

destructor TCustomNumEdit.Destroy;
begin
  FCanvas.Free;
{  if FPopup <> nil then begin
    TPopupWindow(FPopup).OnCloseUp := nil;
    FPopup.Free;
    FPopup := nil;
  end;}
  inherited Destroy;
end;

function TCustomNumEdit.GetText: string;
begin
  Result := inherited Text;
end;

function TCustomNumEdit.GetValue: Extended;
begin
  if not (csDesigning in ComponentState) then
    try
      UpdateData;
    except
      FValue := FMinValue;
    end;
  Result := FValue;
end;

function TCustomNumEdit.IsFormatStored: boolean;
begin
  Result := (DisplayFormat <> DefaultDisplayFormat);
end;

procedure TCustomNumEdit.SetAlignment(const AValue: TAlignment);
begin
  if FAlignment=AValue then exit;
  FAlignment:=AValue;
  Invalidate;
end;

procedure TCustomNumEdit.SetAsInteger(const AValue: Longint);
begin
  SetValue(AValue);
end;

procedure TCustomNumEdit.SetBeepOnError(const AValue: Boolean);
begin
  if FBeepOnError=AValue then exit;
  FBeepOnError:=AValue;
end;

procedure TCustomNumEdit.SetDecimalPlaces(const AValue: Cardinal);
begin
  if FDecimalPlaces=AValue then exit;
  FDecimalPlaces:=AValue;
  DataChanged;
  Invalidate;
end;

procedure TCustomNumEdit.SetDisplayFormat(const AValue: string);
begin
  if FDisplayFormat=AValue then exit;
  FDisplayFormat:=AValue;
  Invalidate;
  DataChanged;
end;

procedure TCustomNumEdit.SetFormatOnEditing(const AValue: Boolean);
begin
  if FFormatOnEditing=AValue then exit;
  FFormatOnEditing:=AValue;
  if FFormatOnEditing then
//    FAlignment := AValue
  else
    FAlignment := taLeftJustify;
  if FFormatOnEditing and FFocused then
    ReformatEditText
  else
  if FFocused then
  begin
    UpdateData;
    DataChanged;
  end;
end;

procedure TCustomNumEdit.SetMaxValue(const AValue: Extended);
begin
  if FMaxValue=AValue then exit;
  FMaxValue:=AValue;
  if Value > AValue then
    Value:=AValue;
end;

procedure TCustomNumEdit.SetMinValue(const AValue: Extended);
begin
  if FMinValue=AValue then exit;
  FMinValue:=AValue;
  if Value < AValue then
    Value:=AValue;
end;

procedure TCustomNumEdit.SetText(const AValue: string);
begin
  if not (csReading in ComponentState) then
  begin
    FValue := CheckValue(StrToFloat(TextToValText(AValue)), False);
    DataChanged;
    Invalidate;
  end;
end;

procedure TCustomNumEdit.SetValue(const AValue: Extended);
begin
  FValue := CheckValue(AValue, False);
  DataChanged;
  Invalidate;
end;

procedure TCustomNumEdit.SetZeroEmpty(const AValue: Boolean);
begin
  if FZeroEmpty=AValue then exit;
  FZeroEmpty:=AValue;
  DataChanged;
end;

function TCustomNumEdit.TextToValText(const AValue: string): string;
begin
  Result := DelRSpace(AValue);
  if DecimalSeparator <> ThousandSeparator then begin
    Result := DelChars(Result, ThousandSeparator);
  end;
  if (DecimalSeparator <> '.') and (ThousandSeparator <> '.') then
    Result := ReplaceStr(Result, '.', DecimalSeparator);
  if (DecimalSeparator <> ',') and (ThousandSeparator <> ',') then
    Result := ReplaceStr(Result, ',', DecimalSeparator);
  if Result = '' then Result := '0'
  else if Result = '-' then Result := '-0';
end;

function TCustomNumEdit.CheckValue(NewValue: Extended; RaiseOnError: Boolean
  ): Extended;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue) then begin
    if (FMaxValue > FMinValue) then begin
      if NewValue < FMinValue then Result := FMinValue
      else if NewValue > FMaxValue then Result := FMaxValue;
    end
    else begin
      if FMaxValue = 0 then begin
        if NewValue < FMinValue then Result := FMinValue;
      end
      else if FMinValue = 0 then begin
        if NewValue > FMaxValue then Result := FMaxValue;
      end;
    end;
    if RaiseOnError and (Result <> NewValue) then
      raise ERangeError.CreateFmt(ReplaceStr('SOutOfRange %d %d %d %d', '%d', '%.*f'),
        [DecimalPlaces, FMinValue, DecimalPlaces, FMaxValue]);
  end;
end;

procedure TCustomNumEdit.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    Invalidate;
    FFormatting := True;
    try
      DataChanged;
    finally
      FFormatting := False;
    end;
  end;
end;

procedure TCustomNumEdit.CMEnabledChanged(var Message: TLMessage);
begin
  inherited;
  if NewStyleControls and not FFocused then Invalidate;
end;

procedure TCustomNumEdit.CMEnter(var Message: TLMEnter);
begin
  SetFocused(True);
  if FFormatOnEditing then ReformatEditText;
  inherited;
end;

procedure TCustomNumEdit.WMExit(var Message: TLMExit);
begin
  inherited;
  try
    CheckRange;
    UpdateData;
  except
    SelectAll;
    if CanFocus then SetFocus;
    raise;
  end;
  SetFocused(False);
  Cursor:=0;
  DoExit;
end;

procedure TCustomNumEdit.CMFontChanged(var Message: TLMessage);
begin
  inherited;
  Invalidate;
end;

procedure TCustomNumEdit.WMPaint(var Message: TLMPaint);
var
  S: string;
begin
  S := GetDisplayText;
//  if not FFocused then
//  else
  if not PaintComboEdit(Self, S, FAlignment, FFocused {and not PopupVisible}, FCanvas, Message) then
      inherited WMPaint(Message);
end;

procedure TCustomNumEdit.WMPaste(var Message: TLMessage);
var
  S: string;
begin
  S := EditText;
  try
    inherited;
    UpdateData;
  except
    EditText := S;
    SelectAll;
    if CanFocus then SetFocus;
//    if BeepOnError then MessageBeep(0);
  end;
end;

procedure TCustomNumEdit.GetSel(var ASelStart: Integer; var SelStop: Integer);
begin
  ASelStart:=SelStart;
  SelStop:=SelStart + SelLength;
end;

procedure TCustomNumEdit.DoEnter;
begin
  SetFocused(True);
  if FFormatOnEditing then ReformatEditText;
  inherited DoEnter;
end;

procedure TCustomNumEdit.DoExit;
begin
  try
    CheckRange;
    UpdateData;
  except
    SelectAll;
    if CanFocus then SetFocus;
    raise;
  end;
  SetFocused(False);
  Cursor:=0;

  inherited DoExit;
  Invalidate;
end;

{procedure TCustomNumEdit.AcceptValue(const Value: Variant);
begin
  inherited AcceptValue(Value);
end;}

procedure TCustomNumEdit.Change;
begin
  if not FFormatting then
  begin
    if FFormatOnEditing and FFocused then ReformatEditText;
    inherited Change;
  end;
end;

procedure TCustomNumEdit.ReformatEditText;
var
  S: string;
  IsEmpty: Boolean;
  OldLen, ASelStart, SelStop: Integer;
begin
  FFormatting := True;
  try
    S := inherited Text;
    OldLen := Length(S);
    IsEmpty := (OldLen = 0) or (S = '-');
    if HandleAllocated then GetSel(ASelStart, SelStop);
    if not IsEmpty then S := TextToValText(S);
    S := FormatFloatStr(S, Pos(',', DisplayFormat) > 0);
    inherited Text := S;
{    if HandleAllocated and (GetFocus = Handle) and not
      (csDesigning in ComponentState) then
    begin
      Inc(ASelStart, Length(S) - OldLen);
      SetCursor(ASelStart);
    end;}
  finally
    FFormatting := False;
  end;
end;

procedure TCustomNumEdit.DataChanged;
var
  EditFormat: string;
begin
  EditFormat := '0';
  if FDecimalPlaces > 0 then
    EditFormat := EditFormat + '.' + MakeStr('#', FDecimalPlaces);
  if (FValue = 0.0) and FZeroEmpty then
    EditText := ''
  else
    EditText := FormatFloat(EditFormat, FValue);
end;

function TCustomNumEdit.DefaultDisplayFormat: string;
begin
  Result := ',0.##';
end;

procedure TCustomNumEdit.KeyPress(var Key: Char);
begin
{  if PopupVisible and (UpCase(Key) in ['0'..'9', DecimalSeparator, '.', ',',
    '+', '-', '*', '/', '_', '=', 'C', 'R', 'Q', '%', #8, #13] -
    [ThousandSeparator]) then
  begin
    THack(FPopup).KeyPress(Key);
    Key := #0;
  end;}
  if Key in ['.', ','] - [ThousandSeparator] then
    Key := DecimalSeparator;
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and not IsValidChar(Key) then begin
//    if BeepOnError then MessageBeep(0);
    Key := #0;
  end
  else if Key = #27 then begin
    Reset;
    Key := #0;
  end;
end;

function TCustomNumEdit.IsValidChar(Key: Char): Boolean;
var
  S: string;
  ASelStart, SelStop, DecPos: Integer;
  RetValue: Extended;
begin
  Result := False;
  S := EditText;
  GetSel(ASelStart, SelStop);
  System.Delete(S, ASelStart + 1, SelStop - ASelStart);
  System.Insert(Key, S, ASelStart + 1);
  S := TextToValText(S);
  DecPos := Pos(DecimalSeparator, S);
  if (DecPos > 0) then
  begin
    ASelStart := Pos('E', UpperCase(S));
    if (ASelStart > DecPos) then
      DecPos := ASelStart - DecPos
    else
      DecPos := Length(S) - DecPos;
    if DecPos > Integer(FDecimalPlaces) then
      Exit;
  end;
  Result := IsValidFloat(S, RetValue);
  if Result and (FMinValue >= 0) and (FMaxValue > 0) and (RetValue < 0) then
    Result := False;
end;

function TCustomNumEdit.FormatDisplayText(Value: Extended): string;
begin
  if DisplayFormat <> '' then
    Result := FormatFloat(DisplayFormat, Value)
  else
    Result := FloatToStr(Value);
end;

procedure TCustomNumEdit.Clear;
begin

end;

{ TCurrencyEdit }

function TCurrencyEdit.DefaultDisplayFormat: string;
var
  CurrStr: string;
  I: Integer;
  C: Char;
begin
  Result := ',0.' + MakeStr('0', CurrencyDecimals);
  CurrStr := '';
  for I := 1 to Length(CurrencyString) do
  begin
    C := CurrencyString[I];
    if C in [',', '.'] then
    begin
      CurrStr := CurrStr + '''' + C + ''''
    end
    else CurrStr := CurrStr + C;
  end;
  if Length(CurrStr) > 0 then
    case CurrencyFormat of
      0: Result := CurrStr + Result; { '$1' }
      1: Result := Result + CurrStr; { '1$' }
      2: Result := CurrStr + ' ' + Result; { '$ 1' }
      3: Result := Result + ' ' + CurrStr; { '1 $' }
    end;
  Result := Format('%s;-%s', [Result, Result]);
end;

constructor TCurrencyEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlState := ControlState + [csCreating];
  try
//    ButtonWidth := 0;
  finally
    ControlState := ControlState - [csCreating];
  end;
end;

end.