I've made money Edit componetin, but there's a problem with it that you can write characters other than numbers on it.
Here's a file
unit RahaEd;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, GenRutii,
LCLIntf, LCLType, LMessages, Messages;
type
TRahaEd = class(TEdit)
private
FArvo: Currency;
protected
vanhatext: String;
procedure KeyPress(var Key: Char); override;
procedure DoEnter; override;
procedure DoExit; override;
public
Muokattu: Boolean;
procedure AsetaArvo(I:Currency);
published
property Arvo: Currency read FArvo write AsetaArvo ;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard',[TRahaEd]);
end;
function LaskeKaava(s: String): String;
var ope: Char;
tot, luku: Currency;
function SeuraavaLuku(var ss: String): Currency;
begin
Result := 0;
while (Length(ss) > 0) and (ss[1] >= '0') and (ss[1] <= '9') do begin
Result := (Result * 10) + (Ord(ss[1]) - Ord('0'));
ss := Copy(ss, 2, Length(ss)-1);
end;
end;
begin
Result := '';
tot := SeuraavaLuku(s);
while Length(s) > 0 do begin
ope := s[1];
s := Copy(s, 2, Length(s)-1);
luku := SeuraavaLuku(s);
case ope of
'*': tot := tot * luku;
'/': tot := tot / luku;
'+': tot := tot + luku;
'-': tot := tot - luku;
end;
end;
Result := MaaraToStr(tot);
end;
procedure TrahaED.AsetaArvo(I:Currency);
begin
FArvo := I;
Text := MkToStr(FArvo);
SelectAll;
end;
procedure TrahaED.KeyPress(var Key: Char);
begin
if ((Key >= Char(VK_F1)) and (Key <= Char(VK_F12))) then
else if ((48 > Integer(Key)) or (Integer(Key) > 57)) and
not ((32 < Integer(Key)) or (Key = Char(VK_BACK)) or
(Key = Char(VK_DELETE)) or (Key = DecimalSeparator)) then
Key := Char(0) ;
inherited KeyPress(Key);
if Text <> '-' then
FArvo := StrToMk(Text);
end;
procedure TrahaED.DoEnter;
begin
Text := MkToStr(FArvo);
vanhatext := Text;
inherited DoEnter;
end;
procedure TrahaED.DoExit;
begin
if (Pos('*',Text) > 0) or (Pos('/',Text) > 0) or(Pos('+',Text) > 0) or(Pos('-',Text) > 1) then
Text := LaskeKaava(Text);
FArvo := StrToMk(Text);
Text := MkToStr(FArvo); { etunollat pois }
Muokattu := vanhatext <> Text;
inherited;
end;
end.
Recent
