I'm trying to iterate over a Dynamic array passed into a generic function
I'm using TValue to achive this, but i can't get the length of the array and there for I can not get the elements.
I've written a small demo project to illustrate my problem:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.TypInfo, System.Rtti;
type
TMyEnum = (me_One, me_Two, me_Three);
Writer = class
public
class procedure Write<T>(Value: T);
end;
{ Writer }
class procedure Writer.Write<T>(Value: T);
var
ArrayValue: TValue;
TypeInfo: pTypeInfo;
begin
TypeInfo := System.TypeInfo(T);
if TypeInfo.Kind <> tkDynArray then
exit;
TValue.Make(nil, TypeInfo, ArrayValue);
Writeln(ArrayValue.GetArrayLength);
//Here I have my problem ArrayValue.GetArrayLength returns 0 and not 2
end;
var
Enums: array of TMyEnum;
Dummy : String;
begin
try
SetLength(Enums, 2);
Enums[0] := me_One;
Enums[1] := me_Two;
Writer.Write(Enums);
Readln(Dummy);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
I found the answer my self.
The problem where I was using TValue.Make and not TValue.From
This will do. Way more simple compared to where I started.
class function Writer.WriteLine<T>(AValue: T): string;
var
ElementValue, Value: TValue;
i: Integer;
begin
Value := TValue.From(AValue);
try
if not Value.IsArray then
Exit('');
if Value.GetArrayLength = 0 then
Exit('[]');
Result := '[';
for i := 0 to Value.GetArrayLength - 1 do
begin
ElementValue := Value.GetArrayElement(i);
Result := Result + ElementValue.ToString + ',';
end;
Result[Length(Result)] := ']';
finally
Writeln(Result);
end;
end;
Related
I have this code in my unit:
unit clsDate_u;
interface
type
TDate = class(TObject)
private
fDay, fMonth, fYear : integer;
public
constructor Create(sDate: string);
function MonthName: string;
function DaysPassedInYear: integer;
function LongDate: string;
function GetDay: integer;
function GetMonth: integer;
function GetYear: integer;
end;
implementation
{ TDate }
uses
SysUtils, DateUtils;
constructor TDate.Create(sDate: string);
begin
fDay := StrToInt(copy(sDate,1,2));
fMonth := StrToInt(copy(sDate,4,2));
fYear := StrToInt(copy(sDate,7,2));
if fYear <= 29 then
fYear := fYear + 2000
else
fYear := fYear + 1900;
end;
function TDate.DaysPassedInYear: integer;
var
iTotal, iCount: integer;
begin
iTotal := 0;
iCount := 1;
while iCount < fMonth do
begin
iTotal := iTotal + DaysInAMonth(fYear, iCount);
Inc(iCount);
end;
iTotal := iTotal + fDay;
result := iTotal;
end;
function TDate.GetDay: integer;
begin
result := fDay;
end;
function TDate.GetMonth: integer;
begin
result := fMonth;
end;
function TDate.GetYear: integer;
begin
result := fYear;
end;
function TDate.MonthName: string;
begin
result := LongMonthNames[fMonth];
end;
function TDate.LongDate: string;
begin
result := IntToStr(fDay) + ' ' + MonthName + ' ' + IntToStr(fYear);
end;
end.
I want to use the "LongMonthNames" variable in my function as you can see here:
function TDate.MonthName: string;
begin
result := LongMonthNames[fMonth];
end;
Delphi says it is an undeclared identifier and sees it as an error, but I did in fact add SysUtils and DateUtils in my uses clause.
Why does it not recognize "LongMonthNames"?
I am working in a seperate unit, but I doubt that has anything to do with the issue.
First, TDate is a poor name since it collides with the standard Delphi TDate type.
Second, the LongMonthNames thing you are looking for is a member of the TFormatSettings record. Consequently, to access this member, you need an instance of such a record.
For instance, if you want localized month names, you can use TFormatSettings.Create to create a format settings record for the current locale.
On the other hand, if you want non-localized (English) month names, you can use the TFormatSettings.Invariant class function.
For example,
var LMonthNames := TFormatSettings.Create.LongMonthNames;
for var LMonthName in LMonthNames do
ShowMessage(LMonthName);
gives you localized month names while
var LMonthNames := TFormatSettings.Invariant.LongMonthNames;
for var LMonthName in LMonthNames do
ShowMessage(LMonthName);
gives you non-localized month names.
(Obviously, in real code you would not recreate the format settings record every time.)
All I had to do was add "FormatSettings." before the "LongMonthNames", like this:
function TDate.MonthName: string;
begin
result := FormatSettings.LongMonthNames[fMonth];
end;
I am using a generic class to allow me to access a named property of a generic type and read/write its value. I am getting an EAccessViolation error when trying to access the result from a call to GetValue from a RTTIProperty record and also when setting a value using SetValue. When running a trace it seems both errors are being thrown when access the TValue. I have included a sample console app below that highlights the issue.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
System.RTTI;
Type
TTestClass = class
private
FItem: string;
public
Property Item: string read FItem write FItem;
end;
TAccessData<T> = class
Function GetTValue(AItem : T; AField : string) : TValue;
Procedure SetTValue(AItem : T; Afield : string; AValue : TValue);
end;
{ TAccessData<T> }
function TAccessData<T>.GetTValue(AItem: T; AField: string): TValue;
var
LContext : TRTTIContext;
LType : TRttiType;
LProperty : TRttiProperty;
begin
result := nil;
LType := LContext.GetType(Typeinfo(T));
LProperty := LType.GetProperty(Afield);
if LProperty <> nil then
Result := LProperty.GetValue(#AItem);
end;
var
LTestObj : TTestClass;
LAccessOBj : TAccessData<TTestClass>;
AValue : TValue;
procedure TAccessData<T>.SetTValue(AItem: T; Afield: string; AValue: TValue);
var
LContext : TRTTIContext;
LType : TRttiType;
LProperty : TRttiProperty;
begin
LType := LContext.GetType(Typeinfo(T));
LProperty := LType.GetProperty(Afield);
if LProperty <> nil then
LProperty.SetValue(#AItem, AValue);
end;
begin
try
LTestObj := TTestClass.Create;
LTestObj.Item := 'Hello';
Writeln(LTestObj.Item);
LAccessOBj := TAccessData<TTestClass>.Create;
AValue := LAccessObj.GetTValue(LTestObj, 'Item');
Writeln(AValue.TypeInfo^.Name);
if AValue.TypeInfo.Kind <> tkString then
Writeln('Not string');
Writeln(AValue.ToString); // <--- This results in a EAccessViolation
LAccessOBj.SetTValue(LTestObj,'Item','World'); // <--- This results in a EAccessViolation
Writeln(LTestObj.Item);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
I suspect I am missing something in the way I am accessing the properties of the generic types but have hit a wall as to why I am getting this behaviour. I have not made a constraint on the generic parameter as I need this to work with record types as well.
Using Tokyo update 1
Your code in GetTValue and SetTValue is defect as it passes #AItem to TRttiProperty.SetValue and GetValue. It needs to be PPointer(#AItem)^ or constrain T to class so you can directly hardcast with Pointer(AItem).
Due to the wrong passed AInstance the TValue contains some garbage memory which you can see if you introduce a string variable and assign the result of the ToString call to it before trying to pass it to Writeln. And the code in Writeln is then producing the AV.
I am using Delphi 10.1 Berlin update 2. Following is the code that reproduces the problem:
uses
System.SysUtils,
Rtti;
type
TEnum = (t1, t2);
TIndexedEnum = (to1=1, to2);
TClass1 = class
constructor Create(pEnum: TEnum);
end;
TClass2 = class
constructor Create(pEnum: TIndexedEnum);
end;
constructor TClass1.Create(pEnum: TEnum);
begin
end;
constructor TClass2.Create(pEnum: TIndexedEnum);
begin
end;
function MethodParamCount(pMethodName: String; pClass: TClass): Integer;
var
rContext: TRttiContext;
rType: TRttiType;
FMethods: TArray<TRttiMethod>;
I: Integer;
begin
rContext := TRttiContext.Create;
rType := rContext.GetType(pClass);
FMethods := rType.GetMethods;
for I := Low(FMethods) to High(FMethods) do
if SameText(pMethodName, FMethods[I].Name) then
begin
Result := Length(FMethods[I].GetParameters);
Exit;
end;
Result := -1;
end;
begin
WriteLn(IntToStr(MethodParamCount('Create', TClass1))); // Prints 1
WriteLn(IntToStr(MethodParamCount('Create', TClass2))); // Prints 0
ReadLn;
end.
Is that a bug of the RTTI implementation, or I am missing something? Is there a way to circumvent this issue without changing the class implementation?
Edit: I want to find a constructor without any parameters so I can call it using Invoke(). The thing is, RTTI is telling me there are no parameters for a method that actually has a parameter.
It is possible to create a function which accepts variable number of arguments:
function f(const x: array of const): String;
and use it this way:
f([1,3,4, "hello"]);
It is also possible to define an argument as "changeable":
function g(var x: Byte): String;
var B: Byte;
g(B);
But is it possible to define a function which can take any number of arguments of whatver type and change all of their values?
I know I can do this using pointers but then I don't know the type of the parameter passed so it is quite unsafe to mess with them.
I just want to create a function which can return variable number of variables of many different types, not just of 1 type or just 1 variable. And I don't want to write zillions of lines to use the function- it should just be the function itself, no SetLength() before the function call or anything. So here is the best thing I made so far:
type TVarArr = Array of Variant;
PVarArr = ^TVarArr;
Procedure f(a: PVarArr);
var
i:Integer;
begin
SetLength(A^, 4);
a^[0] := 46;
end;
ar: TVarArr;
begin
f(#ar);
caption := IntToStr(ar[0]);
Tom will not be able to use this answer as his Delphi version isn't high enough, but anybody on D2010 or higher will be able to put the extended rtti's TValue to good use on this type of challenge.
Following is a small console app showing how to:
create a dynamic array of TValue's from a open array parameter;
copy a dynamic array of TValue's to a new dynamic array modifying individual values on the way;
modify the items in a dynamic array of TValues "in place".
Enjoy.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.Rtti,
System.SysUtils,
System.TypInfo;
const
StringKinds: set of TTypeKind = [tkChar, tkString, tkWChar, tkLString, tkWString, tkUString];
type
TValueArray = array of TValue;
function ValueArrayFromConstArray(const aSource: array of TValue): TValueArray;
var
idx: Integer;
begin
SetLength(Result, Length(aSource));
for idx := Low(aSource) to High(aSource) do
Result[idx] := aSource[idx];
end;
function ReturnNewArray(const aSource: TValueArray): TValueArray;
var
idx: Integer;
begin
SetLength(Result, Length(aSource));
for idx := Low(aSource) to High(aSource) do
if aSource[idx].Kind in StringKinds then
Result[idx] := 'Dest' + aSource[idx].ToString
else
if aSource[idx].Kind in [tkInteger] then
Result[idx] := 10 + aSource[idx].AsInteger
else
Result[idx] := aSource[idx];
end;
procedure ModifyArrayValues(var aArray: TValueArray);
var
idx: Integer;
begin
for idx := Low(aArray) to High(aArray) do
if aArray[idx].Kind in StringKinds then
aArray[idx] := 'Dest' + aArray[idx].ToString
else
if aArray[idx].Kind in [tkInteger] then
aArray[idx] := 10 + aArray[idx].AsInteger
else
;//aArray[idx] := aArray[idx];
end;
var
Source: TValueArray;
Destination: TValueArray;
Item: TValue;
idx: Integer;
begin
Source := ValueArrayFromConstArray(['Some', 42, TObject]);
Destination := ReturnNewArray(Source);
idx := 0;
WriteLn('', #9, 'Old', #9, 'New');
WriteLn('-', #9, '----', #9, '----');
for Item in Source do
begin
WriteLn(idx, #9, Item.ToString, #9, Destination[idx].ToString);
Inc(idx);
end;
WriteLn;
WriteLn;
WriteLn('', #9, 'Modified');
WriteLn('-', #9, '----');
Source := ValueArrayFromConstArray(['first', 50, TValue.From<TFloatValue>(fvCurrency)]);
ModifyArrayValues(Source);
for Item in Source do
begin
WriteLn(idx, #9, Item.ToString);
end;
ReadLn;
end.
Procedure All(var a:Array of Variant);
var
i:Integer;
begin
for I := Low(a) to High(a) do
begin
if VarType(a[i])=258 then
a[i] := a[i] + ' modified';
end;
end;
Procedure AllConst( a:Array of Variant);
var
i:Integer;
begin
for I := Low(a) to High(a) do
begin
Showmessage(a[i]);
end;
end;
procedure TForm3.Button1Click(Sender: TObject);
var
a:Array of Variant;
begin
AllConst([1,2,'Test']);
SetLength(a,3);
a[0] := 3.141;
a[1] := 'Test';
a[2] := 27;
all(a);
Showmessage(a[1]);
end;
Is there a function in the Delphi standard library to search string arrays for a particular value?
e.g.
someArray:=TArray<string>.Create('One','Two','Three');
if ArrayContains(someArray, 'Two') then
ShowMessage('It contains Two');
There is absolutely no need to reinvent the wheel. StrUtils.MatchStr does the job.
procedure TForm1.FormCreate(Sender: TObject);
var
someArray: TArray<string>;
begin
someArray:=TArray<string>.Create('One','Two','Three');
if MatchStr('Two', someArray) then
ShowMessage('It contains Two');
end;
Note the parameter order convention.
Another note: MatchStr is a canonicalized name assigned to this function somewhen in between Delphi 7 and Delphi 2007. Historical name is AnsiMatchStr (convention is the same as in the rest of RTL: Str/Text suffix for case-sensitivity, Ansi prefix for MBCS/Locale)
I wrote one I modeled after the old Clipper AScan function (tested in XE). #RRUZ's answer is more correct (there is one existing), but mine doesn't require the array to be sorted first and is fast enough on small arrays. (It also works in pre-generics versions of Delphi.) I also overload it for various types of array - here are the implementations for string and integer:
// Returns the 0-based index of Value if it's found in the array,
// -1 if not. (Similar to TStrings.IndexOf)
function AScan(const Ar: array of string; const Value: string): Integer; overload;
var
i: Integer;
begin
Result := -1;
for i := Low(Ar) to High(Ar) do
if SameText(Ar[i], Value) then
begin
Result := i;
Break
end;
end;
function AScan(const Ar: array of Integer; const Value: Integer): Integer; overload;
var
i: Integer;
begin
Result := -1;
for i := Low(Ar) to High(Ar) do
if (Ar[i] = Value) then
begin
Result := i;
Break
end;
end;
procedure TForm2.FormShow(Sender: TObject);
var
someStrArray: TArray<string>;
someIntArray: TArray<Integer>;
Idx: Integer;
begin
someStrArray := TArray<string>.Create('One', 'Two', 'Three');
Idx := AScan(someStrArray, 'Two');
if Idx > -1 then
ShowMessage(Format('It contains Two at index %d', [Idx]))
else
ShowMessage('Not found');
someIntArray := TArray<Integer>.Create(8, 16, 32);
Idx := AScan(someIntArray, 32);
if Idx > -1 then
ShowMessage(Format('It contains 32 at %d', [Idx]))
else
ShowMessage('16 not found');
end;
For versions of Delphi that support generics, here's a version that doesn't require the array to be sorted, and that also allows you to provide the comparison function if needed:
Interface:
type
TGenericsUtils = class
public
class function AScan<T>(const Arr: array of T; const Value: T; const Comparer: IEqualityComparer<T>): Integer; overload;
class function AScan<T>(const Arr: array of T; const Value: T): Integer; overload;
end;
Implementation
class function TGenericsUtils.AScan<T>(const Arr: array of T; const Value: T): Integer;
begin
Result := AScan<T>(Arr, Value, TEqualityComparer<T>.Default);
end;
class function TGenericsUtils.AScan<T>(const Arr: array of T; const Value: T;
const Comparer: IEqualityComparer<T>): Integer;
var
i: Integer;
begin
for i := Low(Arr) to High(Arr) do
if Comparer.Equals(Arr[i], Value) then
Exit(i);
Exit(-1);
end;
Test code:
var
AIntTest: TIntegerDynArray;
AStrTest: TStringDynArray;
begin
AIntTest := TIntegerDynArray.Create(12, 15, 6, 1, 4, 9, 5);
AStrTest := TStringDynArray.Create('One', 'Six', 'Three', 'Four', 'Twelve');
WriteLn('AIntTest contains 9 at index ', TGenericsUtils.AScan<Integer>(AIntTest, 9));
WriteLn('AStrTest contains ''Four'' at index ', TGenericsUtils.AScan<String>(AStrTest, 'Four'));
ReadLn;
end.
you can use the TArray.BinarySearch function, which is part of the Generics.Collections unit.
check this sample
{$APPTYPE CONSOLE}
{$R *.res}
uses
Generics.Defaults,
Generics.Collections,
System.SysUtils;
Var
someArray: TArray<string>;
FoundIndex : Integer;
begin
try
someArray:=TArray<string>.Create('a','b','c');
if TArray.BinarySearch<String>(someArray, 'b', FoundIndex, TStringComparer.Ordinal) then
Writeln(Format('Found in index %d',[FoundIndex]))
else
Writeln('Not Found');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
Note: BinarySearch requires that the array be sorted.