简单 money 金额输入控件

unit UnitCom;

interface

uses
  Messages, Windows, SysUtils, Classes, Controls, Graphics;

type

  TMoneyEdit = class(TCustomControl)

  private
    Flengthall: Integer;
    Flengthdecimal: Integer;
    FSingleWidth: Integer;
    FXs: array of array [0 .. 1] of Integer;
    FCurrentShow: Boolean;
    FCurrentPos: Integer;
    FFocused: Boolean;
    FValue: Double;
    procedure Paint; override;
    procedure setlengthall(const Value: Integer);
    procedure setlengthdecimal(const Value: Integer);
    procedure setXs(doClear: Boolean = False);
    procedure DrawHighlight(apos: Integer);
    procedure DrawChar(apos: Integer);
    function GetValue: Double;
    procedure setValue(const Value: Double);
    procedure setCurrentPosbyPoint(x: Integer);
  protected
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure WMLButtonDown(var Message: TWMLButtonDown);
      message WM_LBUTTONDOWN;
    procedure WMRButtonDown(var Message: TWMRButtonDown);
      message WM_RBUTTONDOWN;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;

  public
    constructor Create(AOwner: TComponent); override;

  published
    property lengthall: Integer read Flengthall write setlengthall default 1;
    property lengthdecimal: Integer read Flengthdecimal write setlengthdecimal
      default 0;
    property value: Double read GetValue write setValue;
  end;

procedure Register;

implementation

uses
  Math;

procedure Register;
begin
  RegisterComponents('ashiyue', [TMoneyEdit]);
end;

{ TmyCtrl }

procedure TMoneyEdit.CMEnter(var Message: TCMEnter);
begin
  inherited;
  SendMessage(self.Handle,WM_SETFOCUS,0,0);
end;

constructor TMoneyEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ParentColor := False;
  TabStop := True;
  FCurrentPos := 1;
  FCurrentShow := False;
  Flengthall := 3;
  Flengthdecimal := 2;
end;

procedure TMoneyEdit.Paint;
var
  X, Y, W, H: Integer;
  eW: Integer;
  I: Integer;
begin
  inherited;
  with Canvas do
  begin
    Pen.Color := clBlack;
    Pen.Style := psSolid;
    X := Pen.Width div 2;
    Y := X;
    W := Width - Pen.Width + 1;
    H := Height - Pen.Width + 1;
    Rectangle(X, Y, X + W, Y + H);
    FCurrentShow := False;
    for I := 0 to Length(FXs) - 2 do
    begin

      Pen.Style := psDot;
      if Flengthall - Flengthdecimal - 1 = I then
        Pen.Color := clRed
      else
        Pen.Color := clBlack;
      MoveTo(FXs[I][0], Y);
      LineTo(FXs[I][0], H);

      if not FCurrentShow and ((FXs[I][1] > 0) or (I >= Flengthall - Flengthdecimal - 1)) then
        FCurrentShow := True;

      DrawChar(I);
    end;
    if not FCurrentShow then
      FCurrentShow := True;
    DrawChar(Flengthall - 1);

    Pen.Color := clBlack;
    Pen.Style := psSolid;
  end;
  if FFocused then
    DrawHighlight(FCurrentPos);
end;

procedure TMoneyEdit.DrawChar(apos: Integer);
var
  X, Y: Integer;
begin
  if apos > Flengthall - 1 then
    Exit;
  if apos < 0 then
    Exit;

  with Canvas do
  begin
    if FCurrentShow then
    begin
      // 16/25  一般字符的比例，有待研究
      if Height * 16 > FSingleWidth * 25 then
        Font.Height := FSingleWidth * 25 div 16 - 2
      else
        Font.Height := Height - 2;

      X := FXs[apos][0] - (FSingleWidth + TextWidth('0')) div 2;
      Y := (Height - Font.Height) div 2;
      TextOut(X, Y, IntToStr(FXs[apos][1]));
    end;
  end;
end;

procedure TMoneyEdit.DrawHighlight(apos: Integer);
begin
  if apos > Flengthall then
    Exit;
  if apos < 1 then
    Exit;
  with Canvas do
  begin
    Pen.Color := clHighlight;
    Pen.Style := psDot;
    MoveTo(FXs[apos - 1][0] - FSingleWidth + 1, 1);
    LineTo(FXs[apos - 1][0] - 1, 1);
    LineTo(FXs[apos - 1][0] - 1, Height - 2);
    LineTo(FXs[apos - 1][0] - FSingleWidth + 1, Height - 2);
    LineTo(FXs[apos - 1][0] - FSingleWidth + 1, 1);
  end;
end;

function TMoneyEdit.GetValue: Double;
var
  I: Integer;
begin
  result := 0;
  for I := 0 to Length(FXs) - 1 do
  begin
    result := result + FXs[I][1] * Power(10,Flengthall - Flengthdecimal - I - 1);
  end;
end;

procedure TMoneyEdit.setCurrentPosbyPoint(x: Integer);
var
  I: Integer;
begin
  FCurrentPos := 1;
  for I := 0 to length(FXs) - 2 do
    if x > FXs[I][0] then
      inc(FCurrentPos)
    else
      Break;
end;

procedure TMoneyEdit.setlengthall(const Value: Integer);
var
  oldValue: Integer;
begin
  oldValue := Flengthall;
  if Value < 2 then
    Flengthall := 2
  else
    Flengthall := Value;
  setXs(oldValue <> Flengthall);
end;

procedure TMoneyEdit.setlengthdecimal(const Value: Integer);
var
  oldValue: Integer;
begin
  oldValue := Flengthdecimal;
  Flengthdecimal := Value;
  if Value < 0 then
    Flengthdecimal := 0
  else if Value > Flengthall - 1 then
    Flengthdecimal := Flengthall - 1;
  setXs(oldValue <> Flengthdecimal);
end;

procedure TMoneyEdit.setValue(const Value: Double);
var
  tmpInteger: Integer;
  tmpDecimals: Double;
  I: Integer;
begin
  tmpInteger := Floor(value);
  tmpDecimals := Value - tmpInteger;
  if tmpInteger > power(10,Flengthall - Flengthdecimal) - 1 then
    tmpInteger := Floor(power(10,Flengthall - Flengthdecimal) - 1);
  for I := Flengthall - Flengthdecimal - 1 downto 0 do
  begin
    FXs[I][1] := (tmpInteger mod 10);
    tmpInteger := tmpInteger div 10;
  end;
  for I := Flengthall - Flengthdecimal to Flengthall - 1 do
  begin
    tmpDecimals := tmpDecimals * 10;
    FXs[I][1] := Floor(tmpDecimals);
    tmpDecimals := tmpDecimals - Floor(tmpDecimals);
  end;
  Invalidate;
end;

procedure TMoneyEdit.setXs(doClear: Boolean);
var
  I: Integer;
begin
  FSingleWidth := Width div Flengthall;
  SetLength(FXs, Flengthall);
  for I := 0 to Flengthall - 1 do
  begin
    FXs[I][0] := FSingleWidth * (I + 1);
    if doClear then
      FXs[I][1] := 0;
  end;
  Invalidate;
end;

procedure TMoneyEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := DLGC_WANTARROWS or DLGC_WANTTAB;
end;

procedure TMoneyEdit.WMKeyDown(var Message: TWMKeyDown);
begin
  inherited;
  case Message.CharCode of
    VK_LEFT:
      begin
        if FCurrentPos > 1 then
          dec(FCurrentPos);
      end;
    VK_RIGHT:
      begin
        if FCurrentPos < Flengthall then
          inc(FCurrentPos);
      end;
    ord('0') .. ord('9'):
      begin
        FXs[FCurrentPos - 1][1] := Message.CharCode - 48;
        if FCurrentPos < Flengthall then
          inc(FCurrentPos);
      end;
    96 .. 105:
    begin
      FXs[FCurrentPos - 1][1] := Message.CharCode - 96;
        if FCurrentPos < Flengthall then
          inc(FCurrentPos);
    end;
  end;
  Invalidate;
end;

procedure TMoneyEdit.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  FFocused := False;
  Invalidate;
end;

procedure TMoneyEdit.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  SendMessage(self.Handle,CM_ENTER,0,0);
  setCurrentPosbyPoint(Message.XPos);
end;

procedure TMoneyEdit.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  SendMessage(self.Handle,CM_ENTER,0,0);
  setCurrentPosbyPoint(Message.XPos);
end;

procedure TMoneyEdit.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  FFocused := True;
  Invalidate;
end;

procedure TMoneyEdit.WMSize(var Message: TWMSize);
begin
  setXs;
end;

procedure TMoneyEdit.WMSysKeyDown(var Message: TWMSysKeyDown);
begin
  inherited;
  if Message.CharCode = VK_LEFT then
  begin
    inc(FCurrentPos);
    DrawHighlight(FCurrentPos);
  end;
  if Message.CharCode = VK_RIGHT then
  begin
    dec(FCurrentPos);
    DrawHighlight(FCurrentPos);
  end;
end;

end.