Ci dovrebbe essere un componente TMaskEdit che svolge già la funzione che chiedi. Provalo.
L'ho già provato, ma non mi ci ci sono trovato.
il Controllo Tedit in questione può ricevere digit numerici, ma anche simboli matematici per immissioni di formule aritmetiche.
In Gambas esisteva la funzione "Eval" che mi permetteva di ricevere anche i suddetti tipi di dati. In ambiente Lazarus FreePascal, non ho trovato niente in merito. Mi sono dovuto perciò organizzare in modo proprio:
procedure TForm2.EImportFormulaKeyPress(Sender: TObject; var Key: char);
var
decimali, lun, lunSel, p: Integer;
begin
lun:= Length(EImportFormula.Text);
case key of
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ',', '.', '=', '{', '}', '(', ')', '+', '-', '*', '/', Char(8): // Char(8)= VK_Back (Cancella carattere prima)
begin
case key of
'=':
begin
if (Lun > 0) then
begin
if (LeftStr(EImportFormula.Text, 1) = '=') then
begin
key:= Char(0);
end;
end;
end;
'{':
begin
case lun of
0:
begin
key:= Char(0);
end;
end;
if (lun >= 1) then
begin
if (EImportFormula.Text[1] <> '=') then
begin
key:= Char(0);
end;
p:= Pos('{', (EImportFormula.Text));
if (p > 0) then
begin
key:= Char(0);
end;
end;
end;
'}', '(', ')', '+', '-', '*', '/':
begin
if (lun < 2) then
begin
key:= Char(0);
end;
if (LeftStr(EImportFormula.Text, 2) <> '={') then
begin
key:= Char(0);
end;
end;
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
begin
if (lun > 0) then
begin
if (LeftStr(EImportFormula.Text, 1) = '=') then
begin
if (Copy(EImportFormula.Text, 2, 1) <> '{') then;
begin
key:= Char(0);
end;
end;
end;
end;
'.', ',':
begin
if (tipoValuta = '£') then
begin
key:= Char(0);
end
else begin
p:= Pos(',', EImportFormula.Text);
if (p > 0) then
begin
key:= Char(0);
end
else begin
Key:= ',';
end;
end;
end;
end;
end
else begin
key:= Char(0);
end;
end;
if (key <> char(0)) then
begin
crtUltDig:= key;
end
else begin
crtUltDig:= '';
end;
end;
In questa procedura (EImportFormulaKeyPress) mi assicuro che eventuali simboli matematici occupino posizioni obbligate e della possibilità di digitazione di numeri decimali.
procedure TForm2.EImportFormulaChange(Sender: TObject);
var
i, lun, nuCrtDec, p: Integer;
conta: Integer = 0;
begin
lun:= Length(EImportFormula.Text);
case crtUltDig of
',', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
begin
nuCrtDec:= ControlloDecimali(EImportFormula.Text);
if (nuCrtDec > 2) then
begin
EImportFormula.Text:= CancUltCrtDig(EImportFormula.Text, nuCrtDec);
end;
end;
'{':
begin
if (LeftStr(EImportFormula.Text, 2) <> '={') then
begin
EImportFormula.Text:= RightStr(EImportFormula.Text, Length(EImportFormula.Text) - 1); // annulla soltanto l'inserimento dell'ultimo carattere digitato
end;
end;
'}':
begin
for i:= 1 to lun do
begin
case EImportFormula.Text[i] of
'}':
begin
conta:= conta + 1;
end;
end;
end;
if (conta > 1) then
begin
CancUltCrtDig(EImportFormula.Text, 0);
end
else begin
if (LeftStr(EImportFormula.Text, 2) <> '={') then
begin
EImportFormula.Text:= CancUltCrtDig(EImportFormula.Text, 0);
end
else begin
if (RightStr(EImportFormula.Text, 1) <> '}') then
begin
EImportFormula.Text:= CancUltCrtDig(EImportFormula.Text, 0);
end;
end;
end;
end;
'(', ')': // la sua posizione non è vincolante. Occorre però che ci siano tante ')', quante sono le '('
begin
if (LeftStr(EImportFormula.Text, 2) <> '={') then
begin
EImportFormula.Text:= CancUltCrtDig(EImportFormula.Text, 0);
end
else begin
for i:= 1 to lun do
begin
case EImportFormula.Text[i] of
')':
begin
numTondeChiuse:= numTondeChiuse + 1;
end;
'(':
begin
numTondeAperte:= numTondeAperte + 1;
end;
end;
end;
if (numTondeChiuse > numTondeAperte + 1) or (numTondeChiuse < numTondeAperte - 1) then
begin
CancUltCrtDig(EImportFormula.Text, 0);
end;
end;
end;
'+', '-', '*', '/':
begin
for i:= 1 to (lun - 1) do
case EImportFormula.Text[i] of
'+', '-', '*', '/':
begin
if (EImportFormula.Text[i - 1] = '+') or (EImportFormula.Text[i - 1] = '-') or (EImportFormula.Text[i - 1] = '*') or (EImportFormula.Text[i - 1] = '/') then
begin
CancUltCrtDig(EImportFormula.Text, 0);
Break;
end;
if (EImportFormula.Text[i + 1] = '+') or (EImportFormula.Text[i + 1] = '-') or (EImportFormula.Text[i + 1] = '*') or (EImportFormula.Text[i + 1] = '/') then
begin
CancUltCrtDig(EImportFormula.Text, 0);
Break;
end;
end;
end;
end;
end;
end;
In quest'altra (EImportFormulaChange) controllo le formalità sui simboli matematici e, in caso di anomalia richiamo la funzione "CancUltCrtDig" che si occupa della cancellazione dell'ultimo carattere immesso. Controllo anche che le eventuali cifre decimali siano soltanto due, attraverso il richiamo della funzione "ControlloDecimali":
function CancUltCrtDig(StrIniz: String; nuCrtDec: Integer): String;
var
incrDecr, lun: Integer;
conta:Integer = 0;
i: Integer = 0;
strFin: String;
begin
lun:= Length(StrIniz);
if (nuCrtDec > 2) then
begin
i:= lun;
incrDecr:= (-1);
end
else begin
i:= 1;
incrDecr:= 1;
end;
while (StrIniz[i] <> crtUltDig) do
begin
conta:= conta + 1;
i:= i + incrDecr;
end;
strFin:= LeftStr(StrIniz,(i - 1)) + RightStr(StrIniz, conta);
Result:= strFin
end;
//. . .
function ControlloDecimali(strInput: String): Integer;
var
lun, p: Integer;
decimali: Integer = 0;
begin
lun:= Length(strInput);
p:= Pos(',', strInput);
if (p > 0) then
begin
decimali:= lun - p;
end;
Result:= decimali;
end;
Alla fine della digitazione, la formula, viene ricavata in un campo numerico di tipo Real che va a riempire un altro controllo TEdit (EImporto), delle stesse dimensioni e coordinate di quello della formula, per la visualizzazione del totale. Non modifico così il contenuto della TEdit della formula che posso richiamare per la correzione di termini aritmetici, non corretti ai fini del risultato.
Può servire a qualcun altro, oltre che a me? ;)
program Project1;
{
Copyright (c) 2011 by Marco van de Voort(marco@freepascal.org)
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright. (LGPL-with-static-linking-exception)
Rock bottom example of new evaluator helper function.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
//{$mode objfpc}{$H+}
{$mode delphi}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes
{ you can add units after this },
Symbolic, sysutils;
{$R *.res}
var s : AnsiString;
a : extended;
b : integer;
begin
// quickevaluate('expression',[],[]); evaluates a constant expression to an
// extended result
s:='(5+5+10)*2';
writeln(s,'=',QuickEvaluate(s,[],[]):10:1);
// ... but still allows variables:
a:=2.0;
b:=3;
s:='(5+A+10)*B';
// variable names are case sensitive!
writeln(s,'=',QuickEvaluate(s,['A','B'],[a,b]):10:1,' with A=',a:0:1,' and B=',b);
// now let's do that again, but add a symbol (C) that we don't define:
try
a:=2.0;
b:=3;
s:='(5+A+10)*B+C';
// variable names are case sensitive!
writeln(s,'=',QuickEvaluate(s,['A','B'],[a,b]):10:1,' with A=',a:0:1,' and B=',b);
except
on E:Exception do
Writeln('An exception occurred: ',e.message);
end;
end.
Codice copiato pari pari da una vecchia utility di fpc, presente nella directory:
C:\lazarus\fpc\3.2.0\source\packages\symbolic\examples
(ammettendo che abbiate installato lazarus in c:\Lazarus).
Non è un parser di una TEdit, ma un evaluator .... penso possa esserti utile, e non solo a te.
Ciao
@ DragoRosso
Grazie. Tuttavia, quando riuscirò a far funzionare il mio codice digit con verifica della correttezza formale della formula, sarò più che soddisfatto.
Sto provando ora le mie istruzioni e ... il problema è che, con enorme sorpresa, ho incontrato un errore che, secondo la mia logica, non c'è. ???
Il passo di programma "anomalo" è il seguente
procedure TForm2.EImportFormulaKeyPress(Sender: TObject; var Key: char);
. . .
case key of
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ',', '.', '=', '{', '}', '(', ')', '+', '-', '*', '/', Char(8): // Char(8)= VK_Back (Cancella carattere prima)
begin
case key of
'=':
begin
. . . // funziona
end;
{':
begin
. . . // funziona
end;
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
begin
if (lun > 0) then
begin
WriteLn('LeftStr(EImportFormula.Text, 2)= "' + LeftStr(EImportFormula.Text, 2) + '"'); // contenuto: '={' (corretto)
if (LeftStr(EImportFormula.Text, 1) = '=') then
begin
// if ((Copy(EImportFormula.Text, 2, 1)) <> '{') then; istruzione modificata con le due successive, per capire l'errore
striMia:= Copy(EImportFormula.Text, 2, 1);
if (striMia <> Char(123)) then; // a questo punto sono sicuro che striMia contiene '{'
begin
key:= Char(0); // eppure, inspiegabilmente, viene eseguita questa istruzione ed il numero immesso viene annullato
end;
end;
end;
end;
Il problema nasce con la digitazione del primo carattere numerico, dopo "={" di inizio formula. Infatti, per capire se il numero digitato è interno ad una formula, verifico che i primi 2 caratteri immessi siano proprio "={", altrimenti possono essere accettati solo numeri.
Se la digitazione comprende solo numeri, il codice scritto funziona, se vengono digitati caratteri diversi dai numeri e diversi da "={" come primo e secondo digit, funziona, ma quando dovrei cominciare a vedere comparire i numeri, a partire dal 3° digit, ecco che NON funziona.
Ho risolto subito dopo il mio messaggio, interrogando la posizione di '{' :
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
begin
if (lun > 0) then
begin
if (LeftStr(EImportFormula.Text, 1) = '=') then
begin
p:= pos('{', EImportFormula.Text);
if (p <> 2) then
begin
key:= Char(0);
end;
end;
end;
end;
Ora il riconoscimento dei primi due digit ("={") è corretto ed i numeri immessi dopo vengono presi in carico e mostrati nella Tedit.
:D
Bene. Ora ho capito, anzi ho trovato l'errore.
Ritornando al gruppo di istruzioni che provocavano l'errore:
procedure TForm2.EImportFormulaKeyPress(Sender: TObject; var Key: char);
. . .
case key of
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ',', '.', '=', '{', '}', '(', ')', '+', '-', '*', '/', Char(8): // Char(8)= VK_Back (Cancella carattere prima)
begin
case key of
. . .
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
begin
if (lun > 0) then
begin
if (LeftStr(EImportFormula.Text, 1) = '=') then
begin
// if ((Copy(EImportFormula.Text, 2, 1)) <> '{') then; // è il ";" dopo then che ha provocato l'errore
if ((Copy(EImportFormula.Text, 2, 1)) <> '{') then // ora l'uscita dalla if è corretta.
begin
key:= Char(0);
end;
end;
end;
end;
Il ";" dopo then costituiva l'uscita dalla if per "diverso" e, quindi , l'uscita per "uguale" portava alla "key:= Char(0);", annullando così il numero digitato.
Una svista purtroppo dannosa, ma pur sempre una svista. Me ne sono accorto rileggendo il codice, dopo avere interrogato la posizione della "{", perchè non mi spiegavo come mai l'uscita funzionasse così e non come avevo fatto prima. Alla fine l'ho visto ed ho ripristinato il codice iniziale, eliminando il ";".
Vi ho fatto perdere altro tempo nel leggere anche questo messaggio di riflessione, ma era necessario chiarire e spiegare a chi cerca soluzioni cosa può provocare una semplice svista.
;)