lbcurrencyctrls.pas

天涯進銷存系統

unit LBCurrencyCtrls;

interface

uses Messages, SysUtils, Classes, Controls, Forms, Graphics,
     Windows, StdCtrls, Extctrls;

const
  FloatMaxLength = 18;
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);

type
  TLBCurrencyLabel = class(TGraphicControl)
  private
    FBorderStyle: TBorderStyle;
    FCellWidth: Integer;
    FCtl3D: Boolean;
    FDecimalNumber: Integer;
    FDecimalSeparatorColor: TColor;
    FDecimalSymbols: TStrings;
    FDigitalNumber: Integer;
    FDigitalSymbols: TStrings;
    FGridLineColor: TColor;
    FGridLineWidth: Integer;
    FKilobitSeparatorColor: TColor;
    FTextLayout: TTextLayout;
    BorderSize: Integer;
    IntCellOffset: Integer;
    IntCellWidth: Integer;

    procedure AutoInitialize;
    procedure AutoDestroy;
    function GetBorderStyle: TBorderStyle;
    procedure SetBorderStyle(Value: TBorderStyle);
    function GetCellWidth: Integer;
    procedure SetCellWidth(Value: Integer);
    function GetCtl3D: Boolean;
    procedure SetCtl3D(Value: Boolean);
    function GetDecimalNumber: Integer;
    procedure SetDecimalNumber(Value: Integer);
    function GetDecimalSeparatorColor: TColor;
    procedure SetDecimalSeparatorColor(Value: TColor);
    procedure SetDecimalSymbols(Value: TStrings);
    function GetDigitalNumber: Integer;
    procedure SetDigitalNumber(Value: Integer);
    procedure SetDigitalSymbols(Value: TStrings);
    function GetGridLineColor: TColor;
    procedure SetGridLineColor(Value: TColor);
    function GetGridLineWidth: Integer;
    procedure SetGridLineWidth(Value: Integer);
    function GetKilobitSeparatorColor: TColor;
    procedure SetKilobitSeparatorColor(Value: TColor);
    function GetTextLayout: TTextLayout;
    procedure SetTextLayout(Value: TTextLayout);
    procedure DrawGrid;
    procedure DrawText;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle
             default bsSingle;
    property CellWidth: Integer read GetCellWidth write SetCellWidth
             default -1;
    property Ctl3D: Boolean read GetCtl3D write SetCtl3D
             default True;
    property DecimalNumber: Integer read GetDecimalNumber write SetDecimalNumber
             default 2;
    property DecimalSeparatorColor: TColor read GetDecimalSeparatorColor write SetDecimalSeparatorColor
             default clRed;
    property DecimalSymbols: TStrings read FDecimalSymbols write SetDecimalSymbols;
    property DigitalNumber: Integer read GetDigitalNumber write SetDigitalNumber
             default 10;
    property DigitalSymbols: TStrings read FDigitalSymbols write SetDigitalSymbols;
    property GridLineColor: TColor read GetGridLineColor write SetGridLineColor
             default clSilver;
    property GridLineWidth: Integer read GetGridLineWidth write SetGridLineWidth
             default 1;
    property KilobitSeparatorColor: TColor read GetKilobitSeparatorColor write SetKilobitSeparatorColor
             default clBlack;
    property TextLayout: TTextLayout read GetTextLayout write SetTextLayout
             default tlCenter;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property Color;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Visible;
  end;

  TLBCustomCurrencyEdit = class(TCustomControl)
  private
    FBorderStyle: TBorderStyle;
    FCellWidth: Integer;
    FCurrencySymbol: String;
    FCurrencySymbolAligned: Boolean;
    FDecimalNumber: Integer;
    FDecimalSeparatorColor: TColor;
    FDigitalNumber: Integer;
    FFocusedColor: TColor;
    FGridLineColor: TColor;
    FGridLineWidth: Integer;
    FKilobitSeparatorColor: TColor;
    FMaxLength: Integer;
    FMoveOutAllowed: Boolean;
    FNegativeColor: TColor;
    FNegativeFont: TFont;
    FReadOnly: Boolean;
    FShowNegativeColor: Boolean;
    FShowNegativeFont: Boolean;
    FShowNegativeSign: Boolean;
    FTextLayout: TTextLayout;
    FValue: Extended;
    FZeroEmpty: Boolean;
    FOnChange: TNotifyEvent;
    FModified: Boolean;
    FOnBeforeChange: TNotifyEvent;
    FOnMoveOut: TKeyEvent;

    FCursorTimer: TTimer;
    FCursorVisible: Boolean;
    FCursorWidth: Integer;
    FCursorXPos: Integer;
    FCursorY: Integer;
    FDotLength: Integer;
    FFormatString: String;
    FWorkCellOffset: Integer;
    FWorkCellWidth: Integer;
    FNegativeSign: Integer;
    FOriginValue: Extended;

    procedure AutoInitialize;
    procedure AutoDestroy;
    function GetBorderStyle: TBorderStyle;
    procedure SetBorderStyle(Value: TBorderStyle);
    function GetCellWidth: Integer;
    procedure SetCellWidth(Value: Integer);
    function GetCurrencySymbol: String;
    procedure SetCurrencySymbol(Value: String);
    function GetCurrencySymbolAligned: Boolean;
    procedure SetCurrencySymbolAligned(Value: Boolean);
    function GetDecimalNumber: Integer;
    procedure SetDecimalNumber(Value: Integer);
    function GetDecimalSeparatorColor: TColor;
    procedure SetDecimalSeparatorColor(Value: TColor);
    function GetDigitalNumber: Integer;
    procedure SetDigitalNumber(Value: Integer);
    function GetFocusedColor: TColor;
    procedure SetFocusedColor(Value: TColor);
    function GetGridLineColor: TColor;
    procedure SetGridLineColor(Value: TColor);
    function GetGridLineWidth: Integer;
    procedure SetGridLineWidth(Value: Integer);
    function GetKilobitSeparatorColor: TColor;
    procedure SetKilobitSeparatorColor(Value: TColor);
    function GetMaxLength: Integer;
    procedure SetMaxLength(Value: Integer);
    function GetMoveOutAllowed: Boolean;
    procedure SetMoveOutAllowed(Value: Boolean);
    function GetNegativeColor: TColor;
    procedure SetNegativeColor(Value: TColor);
    procedure SetNegativeFont(Value: TFont);
    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);
    function GetShowNegativeColor: Boolean;
    procedure SetShowNegativeColor(Value: Boolean);
    function GetShowNegativeFont: Boolean;
    procedure SetShowNegativeFont(Value: Boolean);
    function GetShowNegativeSign: Boolean;
    procedure SetShowNegativeSign(Value: Boolean);
    function GetTextLayout: TTextLayout;
    procedure SetTextLayout(Value: TTextLayout);
    function GetValue: Extended;
    procedure SetValue(Value: Extended);
    function GetZeroEmpty: Boolean;
    procedure SetZeroEmpty(Value: Boolean);
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMEnter(var Message: TMessage); message CM_ENTER;
    procedure SyncCursorPos;
    procedure ChangeValue(Value: Extended);
    procedure CursorTimerHandle(Sender: TObject);
    procedure DecodeCursorX(X: Integer);
    procedure DrawCursor;
    procedure DrawGrid;
    procedure DrawText;
    procedure InitCursorX(X: Integer);
    procedure SetCursorState(Visible: Boolean);
    procedure WMChar(var Message: TMessage); message WM_CHAR;
    procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;
    procedure CNKEYDOWN(var Message: TMessage); message CN_KEYDOWN;
    procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
    procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
  protected
    procedure BeforeChange; virtual;
    procedure MoveOut(var Key: Word; Shift: TShiftState); virtual;
    procedure Change; virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle
             default bsSingle;
    property CellWidth: Integer read GetCellWidth write SetCellWidth
             default -1;
    property CurrencySymbol: String read GetCurrencySymbol write SetCurrencySymbol;
    property CurrencySymbolAligned: Boolean read GetCurrencySymbolAligned write SetCurrencySymbolAligned
             default False;
    property DecimalNumber: Integer read GetDecimalNumber write SetDecimalNumber
             default 2;
    property DecimalSeparatorColor: TColor read GetDecimalSeparatorColor write SetDecimalSeparatorColor
             default clRed;
    property DigitalNumber: Integer read GetDigitalNumber write SetDigitalNumber
             default 10;  { not clude dot }
    property FocusedColor: TColor read GetFocusedColor write SetFocusedColor
             default clYellow;
    property GridLineColor: TColor read GetGridLineColor write SetGridLineColor
             default clSilver;
    property GridLineWidth: Integer read GetGridLineWidth write SetGridLineWidth
             default 1;
    property KilobitSeparatorColor: TColor read GetKilobitSeparatorColor write SetKilobitSeparatorColor
             default clBlack;
    property MaxLength: Integer read GetMaxLength write SetMaxLength
             default FloatMaxLength; { not include dot }
    property MoveOutAllowed: Boolean read GetMoveOutAllowed write SetMoveOutAllowed
             default False;
    property NegativeColor: TColor read GetNegativeColor write SetNegativeColor
             default clRed;
    property NegativeFont: TFont read FNegativeFont write SetNegativeFont;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly
             default False;
    property ShowNegativeColor: Boolean read GetShowNegativeColor write SetShowNegativeColor
             default False;
    property ShowNegativeFont: Boolean read GetShowNegativeFont write SetShowNegativeFont
             default False;
    property ShowNegativeSign: Boolean read GetShowNegativeSign write SetShowNegativeSign
             default True;
    property TextLayout: TTextLayout read GetTextLayout write SetTextLayout
             default tlCenter;
    property Value: Extended read GetValue write SetValue;
    property ZeroEmpty: Boolean read GetZeroEmpty write SetZeroEmpty
             default True;
    property OnBeforeChange: TNotifyEvent read FOnBeforeChange write FOnBeforeChange;
    property OnMoveOut: TKeyEvent read FOnMoveOut write FOnMoveOut;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Modified: Boolean;
    procedure UnDo;
  end;

  TLBCurrencyEdit = class(TLBCustomCurrencyEdit)
  published
    property BorderStyle;
    property CellWidth;
    property Color;
    property Ctl3D;
    property CurrencySymbol;
    property CurrencySymbolAligned;
    property DecimalNumber;
    property DecimalSeparatorColor;
    property DigitalNumber;
    property Enabled;
    property FocusedColor;
    property Font;
    property GridLineColor;
    property GridLineWidth;
    property KilobitSeparatorColor;
    property MaxLength;
    property MoveOutAllowed;
    property NegativeColor;
    property NegativeFont;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property ReadOnly;
    property ShowHint;
    property ShowNegativeColor;
    property ShowNegativeFont;
    property ShowNegativeSign;
    property TabOrder;
    property TabStop;
    property TextLayout;
    property Value;
    property Visible;
    property ZeroEmpty;
    property OnBeforeChange;
    property OnMoveOut;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure DrawCurrencyFrame(DestCanvas: TCanvas; DestRect: TRect; CurrencyEdit: TLBCustomCurrencyEdit; DestValue: Extended);

implementation

function sncStuff(S, Pattern: String; Index, Len: Integer): String;
var
  SLen, I: Integer;
  S1, S2: String;
begin
  Result := '';
  SLen := Length(S);
  if (Index<1) or (Len<0) or (Index>SLen+1) or (Index+Len>SLen+1) then
    Exit;
  S1 := '';
  S2 := '';
  for I := 1 to SLen do
    if (I<Index) then
      S1 := S1+S[I]
    else
    if (I>Index+Len-1) then
      S2 := S2+S[I];
  Result := S1 + Pattern + S2;
end;

procedure DrawCurrencyFrame(DestCanvas: TCanvas; DestRect: TRect; CurrencyEdit: TLBCustomCurrencyEdit; DestValue: Extended);
var
  DotLength: Integer;
  FormatString: String;
  WorkCellOffset, WorkCellWidth: Integer;
  DestHeight, DestWidth: Integer;

  I, Len: Integer;
  BrushColor: TColor;
  OldPenColor: TColor;
  OldPenWidth: Integer;
  OldPenPos: TPoint;
  OldBrushColor: TColor;
  OldFont: TFont;

  DestText: String;
  XOffset, YOffset: Integer;
  TheRect: TRect;
begin
  OldFont := TFont.Create;
  OldFont.Assign(DestCanvas.Font);
  OldBrushColor := DestCanvas.Brush.Color;

//  DestRect

  DestHeight := DestRect.Bottom-DestRect.Top;
  DestWidth := DestRect.Right-DestRect.Left;

  with CurrencyEdit do
  begin
    if (DecimalNumber=0) then
      DotLength := 0
    else
      DotLength := 1;
    FormatString := '0'+StringOfChar('.', DotLength)+StringOfChar('0', DecimalNumber);
    WorkCellWidth := (DestWidth-GridLineWidth*(DigitalNumber-1)) div DigitalNumber;
    WorkCellOffset := DestWidth-GridLineWidth*(DigitalNumber-1) - WorkCellWidth*DigitalNumber;

    if (DestValue<0) and (ShowNegativeColor) then
      BrushColor := NegativeColor
    else
      BrushColor := Color;
    DestCanvas.Brush.Color := BrushColor;
    DestCanvas.FillRect(DestRect);

    OldPenColor := DestCanvas.Pen.Color;
    OldPenWidth := DestCanvas.Pen.Width;
    OldPenPos := DestCanvas.PenPos;

    DestCanvas.Pen.Width := GridLineWidth;
    for I:=1 to DigitalNumber-1 do
    begin
      if ((DigitalNumber-DecimalNumber-I)=0) then
        DestCanvas.Pen.Color := DecimalSeparatorColor
      else
        if ((DigitalNumber-DecimalNumber-I) mod 3=0) then
          DestCanvas.Pen.Color := KilobitSeparatorColor
        else
          DestCanvas.Pen.Color := GridLineColor;
      DestCanvas.MoveTo(DestRect.Left+(WorkCellWidth+GridLineWidth)*I-GridLineWidth+WorkCellOffset, DestRect.Top);
      DestCanvas.LineTo(DestRect.Left+(WorkCellWidth+GridLineWidth)*I-GridLineWidth+WorkCellOffset, DestRect.Bottom);
    end;

    DestCanvas.Pen.Color := OldPenColor;
    DestCanvas.Pen.Width := OldPenWidth;
    DestCanvas.PenPos := OldPenPos;

    if (DestValue<0) and (ShowNegativeFont) then
      DestCanvas.Font.Assign(NegativeFont)
    else
      DestCanvas.Font.Assign(Font);

    if (ZeroEmpty and (DestValue=0)) then
    begin
      DestCanvas.FillRect(Rect(DestRect.Left,DestRect.Top,DestRect.Left+WorkCellWidth+WorkCellOffset-1,DestRect.Bottom));
      for I:=1 to DigitalNumber-1 do
        DestCanvas.FillRect(Rect(DestRect.Left+(WorkCellWidth+GridLineWidth)*I+WorkCellOffset,DestRect.Top,DestRect.Left+(WorkCellWidth+GridLineWidth)*I+WorkCellWidth+WorkCellOffset-1,DestRect.Bottom));
    end
    else begin
      if (DestValue<0) and not ShowNegativeSign then
        DestText := FormatFloat(FormatString, -DestValue)
      else
        DestText := FormatFloat(FormatString, DestValue);
      Len := Length(DestText);
      if (CurrencySymbol<>'') then
      begin
        if (DigitalNumber-(Len-DotLength)<1) then
        begin
          DestText := StringOfChar('*',DigitalNumber-DecimalNumber-1)+StringOfChar('.',DotLength)+StringOfChar('*',DecimalNumber);
          Len := DigitalNumber+DotLength-1;
        end;
      end
      else begin
        if (DigitalNumber-(Len-DotLength)<0) then
        begin
          DestText := StringOfChar('*',DigitalNumber-DecimalNumber)+StringOfChar('.',DotLength)+StringOfChar('*',DecimalNumber);
          Len := DigitalNumber+DotLength;
        end;
      end;
      case TextLayout of
        tlTop:    YOffset := 0;
        tlCenter: YOffset := (DestHeight-DestCanvas.TextHeight('0')) div 2+1;
        tlBottom: YOffset := DestHeight-DestCanvas.TextHeight('0');
      else
        YOffset := 0;
      end;

      if (CurrencySymbol<>'') then
      begin
        DestCanvas.FillRect(Rect(DestRect.Left,DestRect.Top,DestRect.Left+WorkCellWidth+WorkCellOffset,DestRect.Bottom));
        XOffset := (WorkCellWidth-DestCanvas.TextWidth(CurrencySymbol)) div 2;
        if CurrencySymbolAligned or (DigitalNumber-(Len-DotLength)=1) then
        begin
          TheRect := Rect(DestRect.Left,DestRect.Top,DestRect.Left+WorkCellWidth+WorkCellOffset,DestRect.Bottom);
          DestCanvas.TextRect(TheRect,DestRect.Left+XOffset+(WorkCellOffset div 2),DestRect.Top+YOffset, CurrencySymbol);
          for I:=1 to DigitalNumber-(Len-DotLength)-1 do
            DestCanvas.FillRect(Rect(DestRect.Left+(WorkCellWidth+GridLineWidth)*I+WorkCellOffset,DestRect.Top,DestRect.Left+(WorkCellWidth+GridLineWidth)*I+WorkCellWidth+WorkCellOffset,DestRect.Bottom));
        end
        else begin
          for I:=1 to DigitalNumber-(Len-DotLength)-1-1 do
            DestCanvas.FillRect(Rect(DestRect.Left+(WorkCellWidth+GridLineWidth)*I+WorkCellOffset,DestRect.Top,DestRect.Left+(WorkCellWidth+GridLineWidth)*I+WorkCellWidth+WorkCellOffset,DestRect.Bottom));
          TheRect := Rect(DestRect.Left+(WorkCellWidth+GridLineWidth)*(DigitalNumber-(Len-DotLength)-1)+WorkCellOffset,DestRect.Top,DestRect.Left+(WorkCellWidth+GridLineWidth)*(DigitalNumber-(Len-DotLength)-1)+WorkCellWidth+WorkCellOffset,DestRect.Bottom);
          DestCanvas.FillRect(TheRect);
          DestCanvas.TextRect(TheRect,DestRect.Left+(WorkCellWidth+GridLineWidth)*(DigitalNumber-(Len-DotLength)-1)+XOffset+WorkCellOffset,DestRect.Top+YOffset, CurrencySymbol);
        end;
      end
      else begin
        DestCanvas.FillRect(Rect(DestRect.Left,DestRect.Top,DestRect.Left+WorkCellWidth+WorkCellOffset,DestRect.Bottom));
        for I:=1 to DigitalNumber-(Len-DotLength)-1 do
          DestCanvas.FillRect(Rect(DestRect.Left+(WorkCellWidth+GridLineWidth)*I+WorkCellOffset,DestRect.Top,DestRect.Left+(WorkCellWidth+GridLineWidth)*I+WorkCellWidth+WorkCellOffset,DestRect.Bottom));
      end;

      XOffset := (WorkCellWidth-DestCanvas.TextWidth('0')) div 2;
      for I:=1 to Len-DecimalNumber-DotLength do