Delphi中实现简单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.