📄 variantrtn.pas
字号:
{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ InterBase databases }
{ }
{ FIBPlus is based in part on the product }
{ Free IB Components, written by Gregory H. Deatz for }
{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
{ mailto:gdeatz@hlmdd.com }
{ }
{ Copyright (c) 1998-2007 Devrace Ltd. }
{ Written by Serge Buzadzhy (buzz@devrace.com) }
{ }
{ ------------------------------------------------------------- }
{ FIBPlus home page: http://www.fibplus.com/ }
{ FIBPlus support : http://www.devrace.com/support/ }
{ ------------------------------------------------------------- }
{ }
{ Please see the file License.txt for full license information }
{***************************************************************}
{********************************************************************}
{ Read/Write routine for varArray variant }
{ based on System.pas , Delphi 5 }
{ }
{ Copyright (c) 04.2000 by }
{ V.A.Pronov email: VAPronov@usa.net }
{ and Serge Buzadzhy }
{ email: buzz@devrace.com }
{ }
{********************************************************************}
unit VariantRtn;
interface
{$I FIBPlus.inc}
uses
{$IFDEF WINDOWS}
Windows, Messages, SysUtils
{$IFDEF D6+}, Variants{$ENDIF}
;
{$ENDIF}
{$IFDEF LINUX}
Types, SysUtils, Variants,VarUtils ;
{$ENDIF}
type
// CallBack procedures definitions
TProcReadElementValue=procedure (Value:Variant; IndexValue:array of integer;
const HighBoundInd:integer;
Var Continue:boolean
);
TProcWriteElementValue=
procedure (OldValue:Variant; IndexValue:array of integer;
Var NewValue:Variant; Var Continue:boolean
);
// End CallBack procedures definitions
function SafeVarArrayCreate(const Bounds: array of Integer;
VarType,DimCount: Integer):Variant;
function VarArrayGet(const A: Variant; const Indices: array of Integer;
const HighBound:integer
):Variant;
procedure VarArrayPut
(var A: Variant; const Value: Variant; const Indices: array of Integer;
const HighBound:integer
);
function CycleReadArray(vArray:Variant;CallBackProc:TProcReadElementValue):boolean;
function CycleWriteArray(var vArray:Variant;CallBackProc:TProcWriteElementValue):boolean;
function CompareVarArray1(vArray1,vArray2:Variant):boolean;
function EasyCompareVarArray1(vArray1,vArray2:Variant;HighBound:integer):boolean;
function NeedCastForCompare(const v,v1:Variant):boolean;
{$IFNDEF D6+}
function VarTypeIsNumeric(const AVarType: word): Boolean;
function VarIsNumeric(const V: Variant): Boolean;
{$ENDIF}
function CompareVariantsEQ(const v,v1:Variant):boolean;
function CompareVariants(const v,v1:Variant):Integer;
function ComparePDoubleAndVariant(P:PDouble;const v:Variant):Integer;
function ComparePIntegerAndVariant(P:PInteger;const v:Variant):Integer;
function ComparePInt64AndVariant(P:PInt64;const v:Variant):Integer;
function ComparePByteAndVariant(P:PByte;const v:Variant):Integer;
function ComparePDateAndVariant(P:PDateTime;const v:Variant):Integer;
function ComparePSmallAndVariant(P:PSmallInt;const v:Variant):Integer;
function CompareWideStringAndVariant(P:Pointer;const v:Variant):Integer;
function ComparePCurrencyAndVariant(P:PCurrency;const v:Variant):Integer;
function ComparePShortAndVariant(P:PShortInt;const v:Variant):Integer;
implementation
uses FIBConsts;
{$IFNDEF D6+}
function VarTypeIsNumeric(const AVarType: Word): Boolean;
begin
Result := AVarType in [varSmallInt, varInteger, varBoolean,
varByte, varSingle,varDouble,varCurrency];
end;
function VarIsNumeric(const V: Variant): Boolean;
begin
Result := VarTypeIsNumeric(TVarData(V).VType);
end;
{$ENDIF}
// CompareRnts
function GetVariantData(const v: Variant):Pointer;
begin
case TVarData(v).VType of
varSmallInt:
result:=@TVarData(v).VSmallInt;
varInteger:
result:=@TVarData(v).VInteger;
varSingle :
result:=@TVarData(v).VSingle;
{$IFDEF D6+}
varInt64:
result:=@TVarData(v).VInt64;
varShortInt:
result:=@TVarData(v).VShortInt;
varWord:
result:=@TVarData(v).VWord;
varLongWord:
result:=@TVarData(v).VLongWord;
{$ENDIF}
varByte:
result:=@TVarData(v).VByte;
varDouble : result:=@TVarData(v).VDouble;
varCurrency: result:=@TVarData(v).VCurrency;
varDate : result:=@TVarData(v).VDate;
varOleStr : result:=TVarData(v).VOleStr;
varBoolean : result:=@TVarData(v).VBoolean;
varVariant,varByRef: result:=GetVariantData(PVariant(@TVarData(v).VPointer)^);
varString : result:=TVarData(v).VString;
else
result := nil;
end;
end;
{$DEFINE BODY_NUMERIC_COMPARE_EQ}
{$WARNINGS OFF}
function ComparePIntegerAndVariant(P:PInteger;const v:Variant):Integer;
{$I VarFnc.inc}
function ComparePSmallAndVariant(P:PSmallInt;const v:Variant):Integer;
{$I VarFnc.inc}
function ComparePSingleAndVariant(P:PSingle;const v:Variant):Integer;
{$I VarFnc.inc}
function ComparePDoubleAndVariant(P:PDouble;const v:Variant):Integer;
{$I VarFnc.inc}
function ComparePCurrencyAndVariant(P:PCurrency;const v:Variant):Integer;
{$I VarFnc.inc}
function ComparePDateAndVariant(P:PDateTime;const v:Variant):Integer;
{$I VarFnc.inc}
function ComparePInt64AndVariant(P:PInt64;const v:Variant):Integer;
{$DEFINE C_INT64}
{$I VarFnc.inc}
{$UNDEF C_INT64}
function ComparePByteAndVariant(P:PByte;const v:Variant):Integer;
{$I VarFnc.inc}
function ComparePShortAndVariant(P:PShortInt;const v:Variant):Integer;
{$I VarFnc.inc}
{$IFDEF D6+}
function ComparePWordAndVariant(P:PWord;const v:Variant):Integer;
{$I VarFnc.inc}
function ComparePLongWordAndVariant(P:PLongWord;const v:Variant):Integer;
{$I VarFnc.inc}
{$ENDIF}
{$WARNINGS ON}
{$UNDEF BODY_NUMERIC_COMPARE_EQ}
function CompareWideStringAndVariantEQ(P:Pointer;const v:Variant):boolean;
begin
case VarType(v) of
varString: result:=WideString(P)=string(TVarData(v).VString);
varOleStr: result:=WideString(P)=WideString(TVarData(v).VOleStr);
else
Result := WideString(P)=VarToStr(V);
end;
end;
function CompareStringAndVariantEQ(P:Pointer;const v:Variant):boolean;
begin
case VarType(v) of
varString: result:=String(P)=String(TVarData(v).VString);
varOleStr: result:=String(P)=WideString(TVarData(v).VOleStr);
else
result := String(P)=VarToStr(V); //腩爨弪 铒蜩扈玷痤忄螯
end;
end;
function CompareWideStringAndVariant(P:Pointer;const v:Variant):Integer;
begin
case VarType(v) of
varString:
begin
if WideString(P)=string(TVarData(v).VString) then
Result := 0
else
if WideString(P)>string(TVarData(v).VString) then
Result:=1
else
Result := -1;
end;
varOleStr:
begin
if WideString(P)=WideString(TVarData(v).VOleStr) then
Result := 0
else
if WideString(P)>WideString(TVarData(v).VOleStr) then
Result:=1
else
Result := -1;
end;
else
if WideString(P)=VarToStr(V) then
Result :=0
else
if WideString(P)>VarToStr(V) then
Result:=1
else
Result := -1;
end;
end;
function CompareStringAndVariant(P:Pointer;const v:Variant):Integer;
begin
case VarType(v) of
varString:
begin
if String(P)=String(TVarData(v).VString) then
Result :=0
else
if String(P)>String(TVarData(v).VString) then
Result :=1
else
Result :=-1
end;
varOleStr:
begin
if String(P)=WideString(TVarData(v).VOleStr) then
Result :=0
else
if String(P)>WideString(TVarData(v).VOleStr) then
Result :=1
else
Result :=-1
end;
else
if String(P)=VarToStr(V) then
Result :=0
else
if String(P)>VarToStr(V) then
Result:=1
else
Result := -1;
end;
end;
function CompareVariants(const v,v1:Variant):Integer;
begin
case TVarData(v).VType of
varSmallInt:
result:=ComparePSmallAndVariant(GetVariantData(v),v1);
varInteger :
result:=ComparePIntegerAndVariant(GetVariantData(v),v1);
varSingle :
result:=ComparePSingleAndVariant(GetVariantData(v),v1);
varDouble :
result:=ComparePDoubleAndVariant(GetVariantData(v),v1);
varCurrency:
result:=ComparePCurrencyAndVariant(GetVariantData(v),v1);
varDate :
result:=ComparePDateAndVariant(GetVariantData(v),v1);
varOleStr:
result:=CompareWideStringAndVariant(GetVariantData(v),v1);
{$IFDEF D6+}
varShortInt:
result:=ComparePShortAndVariant(GetVariantData(v),v1);
varByte :
result:=ComparePByteAndVariant(GetVariantData(v),v1);
varWord :
result:=ComparePWordAndVariant(GetVariantData(v),v1);
varLongWord:
result:=ComparePLongWordAndVariant(GetVariantData(v),v1);
varInt64 :
result:=ComparePInt64AndVariant(GetVariantData(v),v1);
{$ENDIF}
varString :
result:=CompareStringAndVariant(GetVariantData(v),v1);
else
if v=v1 then
Result := 0
else
if v>v1 then
Result:=1
else
Result:=-1
end;
end;
function CompareVariantsEQ(const v,v1:Variant):boolean;
begin
case TVarData(v).VType of
varSmallInt:
result:=ComparePSmallAndVariant(GetVariantData(v),v1)=0;
varInteger :
result:=ComparePIntegerAndVariant(GetVariantData(v),v1)=0;
varSingle :
result:=ComparePSingleAndVariant(GetVariantData(v),v1)=0;
varDouble :
result:=ComparePDoubleAndVariant(GetVariantData(v),v1)=0;
varCurrency:
result:=ComparePCurrencyAndVariant(GetVariantData(v),v1)=0;
varDate :
result:=ComparePDateAndVariant(GetVariantData(v),v1)=0;
varOleStr:
result:=CompareWideStringAndVariantEQ(GetVariantData(v),v1);
{$IFDEF D6+}
varShortInt:
result:=ComparePShortAndVariant(GetVariantData(v),v1)=0;
varByte :
result:=ComparePByteAndVariant(GetVariantData(v),v1)=0;
varWord :
result:=ComparePWordAndVariant(GetVariantData(v),v1)=0;
varLongWord:
result:=ComparePLongWordAndVariant(GetVariantData(v),v1)=0;
varInt64 :
result:=ComparePInt64AndVariant(GetVariantData(v),v1)=0;
{$ENDIF}
varString :
result:=CompareStringAndVariantEQ(GetVariantData(v),v1);
else
result:=v=v1;
end;
end;
//////
function NeedCastForCompare(const v,v1:Variant):boolean;
begin
case VarType(v) of
varDate: Result:= not (VarIsNumeric(v1) or (VarType(v1)=varDate));
varBoolean:Result:= VarType(v1)<>varBoolean;
else
case VarType(v1) of
varDate : Result:= not (VarIsNumeric(v) {or (VarType(v)=varDate)});
varBoolean: Result:= True;
else
Result:= (VarIsNumeric(v1) xor VarIsNumeric(v))
end
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -