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.
|