unit MyMoneyEdit;
interface
uses
SysUtils, Classes, Controls, StdCtrls;
type
TMoneyEdit =
class(TEdit)
private
{ Private-Deklarationen }
reactonc:boolean;
protected
{ Protected-Deklarationen }
procedure setmoney(money:real);
function getmoney:real;
public
{ Public-Deklarationen }
published
{ Published-Deklarationen }
procedure keypress(
var key:char);
override;
property money:real
read getmoney
write setmoney;
procedure change;
override;
constructor create(aOwner:tcomponent);
override;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Beispiele', [TMoneyEdit]);
end;
constructor tmoneyedit.create(aOwner:tcomponent);
begin
inherited create(aOwner);
reactonc:=true;
end;
procedure tmoneyedit.setmoney(money:real);
begin
if not (((text='
')
or (text='
-'))
and (money=0))
then
self.text:=floattostr(money);
end;
function tmoneyedit.getmoney:real;
begin
if (text='
')
or (text='
-')
then
result:=0
else
try
result:=strtofloat(text);
except
result:=0;
text:='
';
end;
end;
procedure tmoneyedit.Change;
var
curpos,i,commavalues:integer;
commaexists:boolean;
s:
string;
begin
if not reactonc
then
exit;
reactonc:=false;
curpos:=self.GetSelStart;
if not((text='
')
or (text='
-')
or (text[length(text)]='
,'))
then
begin
commaexists:=false;
commavalues:=0;
for i:=1
to length(text)
do
begin
if commaexists
then
inc(commavalues);
if commavalues>2
then
begin
s:=text;
delete(s,i,length(text));
text:=s;
break;
end;
if text[i]='
,'
then
begin
if commaexists
then
begin
s:=text;
delete(s,i,length(text));
text:=s;
break;
end;
commaexists:=true;
end;
end;
end;
setselstart(curpos);
reactonc:=true;
inherited change;
end;
procedure tmoneyedit.KeyPress(
var key:char);
begin
if Key = '
.'
then Key := '
,';
If not (Key
in [#43..#45, #48..#57, #8, #13])
then
Key := #0;
If (Pos('
,', Text) <> 0)
then
if Key = '
,'
then
Key := #0;
inherited keypress(key);
end;
end.