Procedure ErrorInvalid ;
Begin
ShowMessage ( 'Invalid number') ;
end;
Function FractionToReal ( var Fraction: String ) : real ;
var
SpaceNdx,
E , ValErr,
Numerator,
Denominator: word ;
F ,N : double;
S : string ;
Begin
N := 0 ;
f := 0 ;
ValErr := 0 ;
S := '' ;
Fraction := trim(Fraction) ; // remove leading/trailing spaces
// extract integer part if there is one
SpaceNdx := Pos(' ',Fraction) ;
If SpaceNdx > 1 then // we have a space so X y/z
begin
S := (copy(Fraction,1,SpaceNdx-1)) ;
Val(S ,N,ValErr) ;
If ValErr > 0 then begin
ErrorInvalid ;
result := -1;
exit ;
end;
Delete(Fraction,1,SpaceNdx) ;
// remove any other extra space car
while (Pos(' ' , Fraction) > 0) and (Length (fraction) > 0) do delete(Fraction,Pos(' ',Fraction),1);
if Length(Fraction) > 0 then begin
// check for dividor sign
IF Pos('/',Fraction) = 0 then
begin // no / sign = error
ErrorInvalid;
result := -1 ;
exit;
end
Else
begin // there is a / sign
Val( Copy(Fraction,1,Pos('/', Fraction)-1),Numerator,ValErr) ;
E := ValErr ;
val(Copy(Fraction,Pos('/',Fraction)+1,Length(Fraction)),Denominator,ValErr) ;
If E + ValErr > 0 then
begin
ErrorInvalid;
result := -1 ;
exit;
end;
F := Numerator/Denominator ;
// reformat string for the display in case of too many spaces
if S <> '0' then Fraction := S + ' ' + Fraction ; // remove non significant 0
Result := N + F ;
exit ;
end ;
end;
end else // no space so it is either just a fraction or just a whole number
begin
// remove any other extra space car
while (Pos(' ' , Fraction) > 0) and (Length (fraction) > 0) do delete(Fraction,Pos(' ',Fraction),1);
ValErr := 0 ;
if Length(Fraction) > 0 then
begin
IF Pos('/',Fraction) = 0 then // check for dividor sign
begin // this is a whole number
Val( Fraction, F,ValErr) ;
If ValErr > 0 then
begin
ErrorInvalid;
result := -1 ;
exit;
end
Else
begin
result := N+F;
exit ;
end;
end
Else begin // there is a '/' sign
Val( Copy(Fraction,1,Pos('/', Fraction)-1),Numerator,ValErr) ;
E := ValErr ;
val(Copy(Fraction,Pos('/',Fraction)+1,Length(Fraction)),Denominator,ValErr) ;
If E + ValErr > 0 then
begin
ErrorInvalid;
result := -1 ;
exit;
end;
F := Numerator/Denominator ;
// reformat string for the display in case of too many spaces
if S <> '0' then Fraction := S + ' ' + Fraction ;
// could also use: Fraction := Nearest64(N+F) ;
end;
end; // length > 0
end; // no space
Result := N + F ;
end;