Unit StringMatheLib;
//ich tippe hier nur die Ergänzungen, alles andere von himi sollte man beibehalten
interface
uses Variants;
type
TMatheVarData =
packed record
VType: TVarType;
Reserved1, Reserved2, Reserved3: Word;
Mathe:
String;
//Man könnte hier auch TMathe drin speichern und den String in die Klasse legen, wäre etwas elegenater und sicherer, da man mit der automatischen Verwaltung der Strings nicht kollidieren kann. Ich wollte nur grad die Klasse TMathe nicht umschreiben.
Reserved4: LongInt;
end;
TMatheVariant=class(TCustomVariantType)
public
procedure BinaryOp(
var Left: TVarData;
const Right: TVarData;
const Operator: TVarOp);
override;
procedure UnaryOp(
var Right: TVarData;
const Operator: TVarOp);
override;
function CompareOp(
const Left, Right: TVarData;
const Operator: TVarOp): Boolean;
override;
procedure Compare(
const Left, Right: TVarData;
var Relationship: TVarCompareResult);
override;
procedure Cast(
var Dest: TVarData;
const Source: TVarData);
override;
procedure CastTo(
var Dest: TVarData;
const Source: TVarData;
const AVarType: TVarType);
override;
procedure Clear(
var V: TVarData);
override;
procedure Copy(
var Dest: TVarData;
const Source: TVarData;
const Indirect: Boolean);
override;
function IsClear(
const V: TVarData): Boolean;
override;
protected
function LeftPromotion(
const V: TVarData;
const Operator: TVarOp;
out RequiredVarType: TVarType): Boolean;
override;
function RightPromotion(
const V: TVarData;
const Operator: TVarOp;
out RequiredVarType: TVarType): Boolean;
override;
end;
function VarMatheCreate:Variant;
overload;
function VarMatheCreate(
const Init:
string):Variant;
overload;
function VarMatheCreate(
const Init:Integer):Variant;
overload;
implementation
var TempMatheVariant:TMatheVariant=nil;
Mathe:TMathe=nil;
function VarMatheCreate(
const Init:
string):Variant;
begin
VarClear(Result);
TMatheVarData(Result).VType:=TempMatheVariant.VarType;
TMatheVarData(Result).Mathe:=Init;
end;
function VarMatheCreate:Variant;
begin
result:=VarMatheCreate('
0');
end;
function VarMatheCreate(
const Init:Integer):Variant;
var s:
string;
begin
str(init,s);
result:=VarMatheCreate(s);
end;
{ TMatheVariant }
procedure TMatheVariant.BinaryOp(
var Left: TVarData;
const Right: TVarData;
const Operator: TVarOp);
var sRight:
string;
begin
if TMatheVarData(Left).VType<>TempMatheVariant.VarType
then
RaiseInvalidOp;
if TMatheVarData(Right).VType=TempMatheVariant.VarType
then
sRight:=TMatheVarData(Right).Mathe
else
sRight:=VarToStr(Variant(Right));
case Operator of
opAdd:
TMatheVarData(Left).Mathe:=Mathe.Summe(TMatheVarData(Left).Mathe,
sRight);
opSubtract:
TMatheVarData(Left).Mathe:=Mathe.Differenz(TMatheVarData(Left).Mathe,
sRight);
opMultiply:
TMatheVarData(Left).Mathe:=Mathe.Produkt(TMatheVarData(Left).Mathe,
sRight);
opIntDivide:
TMatheVarData(Left).Mathe:=Mathe.Quotient(TMatheVarData(Left).Mathe,
sRight);
opModulus:
TMatheVarData(Left).Mathe:=Mathe.Modulo(TMatheVarData(Left).Mathe,
sRight);
else
RaiseInvalidOp;
end;
end;
procedure TMatheVariant.Cast(
var Dest: TVarData;
const Source: TVarData);
begin
VarDataClear(Dest);
fillchar(Dest,sizeof(dest),0);
TMatheVarData(Dest).VType:=TempMatheVariant.VarType;
if TMatheVarData(Source).VType=TempMatheVariant.VarType
then
TMatheVarData(Dest).Mathe:=TMatheVarData(Source).Mathe
else
TMatheVarData(Dest).Mathe:=VarToStr(Variant(Source));
end;
procedure TMatheVariant.CastTo(
var Dest: TVarData;
const Source: TVarData;
const AVarType: TVarType);
var Temp:TVarData;
begin
if TMatheVarData(Source).VType=TempMatheVariant.VarType
then
begin
fillchar(temp,sizeof(temp),0);
Temp.VType:=varstring;
Temp.VString:=Pointer(TMatheVarData(Source).Mathe);
VarDataCastTo(Dest,Temp,aVarType);
end else
inherited;
end;
procedure TMatheVariant.Clear(
var V: TVarData);
begin
if TMatheVarData(V).VType=TempMatheVariant.VarType
then
begin
TMatheVarData(V).VType:=varEmpty;
TMatheVarData(V).Mathe:='
';
end else
inherited;
end;
procedure TMatheVariant.Compare(
const Left, Right: TVarData;
var Relationship: TVarCompareResult);
var sRight:
string;
begin
if TMatheVarData(Left).VType<>TempMatheVariant.VarType
then
RaiseInvalidOp;
if TMatheVarData(Right).VType=TempMatheVariant.VarType
then
sRight:=TMatheVarData(Right).Mathe
else
sRight:=VarToStr(Variant(Right));
case Mathe.Vergleich(TMatheVarData(Left).Mathe,sRight)
of
LessThanValue: RelationShip:=crLessThan;
EqualsValue : RelationShip:=crEqual;
GreaterThanValue : RelationShip:=crGreaterThan;
end;
end;
function TMatheVariant.CompareOp(
const Left, Right: TVarData;
const Operator: TVarOp): Boolean;
var sRight:
string;
Art:TVergleich;
begin
if TMatheVarData(Left).VType<>TempMatheVariant.VarType
then
RaiseInvalidOp;
if TMatheVarData(Right).VType=TempMatheVariant.VarType
then
sRight:=TMatheVarData(Left).Mathe
else
sRight:=VarToStr(Variant(Right));
Art:=vGleich;
case Operator of
opCmpNE:Art:=vUngleich;
opCmpLT:Art:=vKleiner;
opCmpLE:Art:=vKleinerGleich;
opCmpGT:Art:=vGroesser;
opCmpGE:Art:=vGroesserGleich;
end;
result:=Mathe.Vergleich(TMatheVarData(Left).Mathe,sRight,Art);
end;
procedure TMatheVariant.Copy(
var Dest: TVarData;
const Source: TVarData;
const Indirect: Boolean);
begin
if Indirect
and VarDataIsByRef(Source)
then
VarDataCopyNoInd(Dest, Source)
else
begin
TMatheVarData(Dest).VType:=TempMatheVariant.VarType;
TMatheVarData(Dest).Mathe:=TMatheVarData(Source).Mathe;
end;
end;
function TMatheVariant.IsClear(
const V: TVarData): Boolean;
begin
result:=TMatheVarData(V).Mathe='
';
end;
function TMatheVariant.LeftPromotion(
const V: TVarData;
const Operator: TVarOp;
out RequiredVarType: TVarType): Boolean;
begin
result:=inherited LeftPromotion(V,
Operator,RequiredVarType);
end;
function TMatheVariant.RightPromotion(
const V: TVarData;
const Operator: TVarOp;
out RequiredVarType: TVarType): Boolean;
begin
result:=inherited RightPromotion(V,
Operator, RequiredVarType);
end;
procedure TMatheVariant.UnaryOp(
var Right: TVarData;
const Operator: TVarOp);
begin
if Right.VType = VarType
then
case Operator of
opNegate:
Mathe.Negieren(TMatheVarData(Right).Mathe);
else
RaiseInvalidOp;
end
else
RaiseInvalidOp;
end;
initialization
Mathe:=TMathe.Create;
TempMatheVariant:=TMatheVariant.Create;
finalization
TempMatheVariant.Free;
TempMatheVariant:=nil;
Mathe.Free;
Mathe:=nil;
End.
Zitat
Baum-Darstellung
