In my Delphi development,
I want to pass an "array of const"(that can contains class too) to a procedure, and in procedure loop on elements and detect type of element as bellow.
Procedure Test(const Args : array of const);
begin
end;
and in my code call it with some variables
Procedure Test();
begin
cls := TMyObject.create;
i := 123;
j := 'book';
l := False;
Test([i,j,l, cls, 37.8])
end;
How loop on sent array elements and detect it's type?
Assuming you are using Unicode Delphi (otherwise, you have to alter the string case):
procedure test(const args: array of const);
var
i: Integer;
begin
for i := low(args) to high(args) do
case args[i].VType of
vtInteger: ShowMessage(IntToStr(args[i].VInteger));
vtUnicodeString: ShowMessage(string(args[i].VUnicodeString));
vtBoolean: ShowMessage(BoolToStr(args[i].VBoolean, true));
vtExtended: ShowMessage(FloatToStr(args[i].VExtended^));
vtObject: ShowMessage(TForm(args[i].VObject).Caption);
// and so on
end;
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
test(['alpha', 5, true, Pi, Self]);
end;
for I := Low(Args) to High(Args) do
case TVarRec(Args[I]).VType of
vtInteger:
...
end;
Related
Is it possible to convert this:
program RangeLoop;
type
TIndexedProc = reference to procedure(idx: Integer);
var
i: Integer;
p: TIndexedProc;
begin
p := procedure(ix: Integer)
var LocalVar: Integer;
begin
//Do some processing
end;
for i in [2..7] do p(i);
end.
into something like this:
program RangeLoop;
var
i: Integer;
begin
for i in [2..7] do procedure(ix: Integer)
var LocalVar: Boolean;
begin
//Do some processing
end;
end.
?
I know that the last code block is invalid.
In Delphi 10.3 and later, you can use an inline variable inside the loop to hold the anonymous procedure, eg:
program RangeLoop;
var
i: Integer;
begin
for i in [2..7] do
begin
var p := procedure(ix: Integer)
begin
//Do some processing
var LocalVar := ...;
end;
p(i);
end;
end.
Prior to 10.3, what you are asking for is simply not doable the way you want. Defining p above the loop is your best choice, unless you use a standalone procedure, eg:
program RangeLoop;
procedure p(ix: Integer);
var
LocalVar: Integer;
begin
//Do some processing
end;
var
i: Integer;
begin
for i in [2..7] do p(i);
end.
Or, if you can use TParallel.For() instead, if your loop iterations are thread-safe and not dependent on each other's results:
program RangeLoop;
uses
System.Threading;
begin
TParallel.For(2, 7, procedure(ix: Integer)
begin
//Do some processing
end;
);
end.
I'm trying to assign a dynamic array type to a TArray<string> variable
type
TMyStringArray = array of string;
function Test() : TMyStringArray;
begin
...
end;
...
var
MyArray : TArray<string>;
begin
MyArray := Test();
end;
On compiling, Delphi says:
[dcc32 Error] Unit1.pas(39): E2010 Incompatible types:
'System.TArray' and 'TMyStringArray'
I did it simply by using a type cast and it seems to work.
I would be glad to know I can fall into some problems doing this way
type
TMyStringArray = array of string;
function Test() : TMyStringArray;
begin
SetLength(Result, 2);
Result[0] := 'Hello';
Result[1] := 'World';
end;
procedure TForm1.FormCreate(Sender: TObject);
var
MyArray : TArray<string>;
i : integer;
begin
MyArray := TArray<string>(Test());
i := 0;
while(i < Length(MyArray)) do
begin
ShowMessage(MyArray[i]);
Inc(i);
end;
end;
I am trying to create a program that prints 11 buttons so I wanted to use an array. The only change with these buttons is the name.
When I try to compile, I get the error "illegal qualifier" at my first array assignment.
type
buttonName = array[0..11] of String;
procedure PopulateButton(const buttonName);
begin
buttonName[0] := 'Sequence';
buttonName[1] := 'Repetition';
buttonName[2]:= 'Modularisation';
buttonName[3]:= 'Function';
buttonName[4]:= 'Variable';
buttonName[5]:= 'Type';
buttonName[6]:= 'Program';
buttonName[7]:= 'If and case';
buttonName[8]:= 'Procedure';
buttonName[9]:= 'Constant';
buttonName[10]:= 'Array';
buttonName[11]:= 'For, while, repeat';
end;
and in main I am trying to use this for loop
for i:=0 to High(buttonName) do
begin
DrawButton(x, y, buttonName[i]);
y:= y+70;
end;
Please know, I am very new to this and am not too confident of my knowledge in arrays, parameters/calling by constant and such.
Thank you
The parameter definition of PopulateButton() is wrong.
Try this:
type
TButtonNames = array[0..11] of String;
procedure PopulateButtons(var AButtonNames: TButtonNames);
begin
AButtonNames[0] := 'Sequence';
...
end;
...
var lButtonNames: TButtonNames;
PopulateButtons(lButtonNames);
for i := Low(lButtonNames) to High(lButtonNames) do
begin
DrawButton(x, y, lButtonNames[i]);
y:= y+70;
end;
Also pay attention to the naming conventions. Types normally begin with a T and function parameters start with an A.
(I already asked this at CodeReview where it got closed as off-topic. Hopefully it's on-topic here.)
I have a static arrays of a derived type (like LabelsA: array[0..3] of TLabel; in the following sample code) and a routine accepting an open array of the base type (like procedure DoSomethingWithControls(const AControls: array of TControl);), and I want to call DoSomethingWithControls with those static arrays. Please see my sample:
procedure DoSomethingWithControls(const AControls: array of TControl);
var
i: Integer;
begin
for i := Low(AControls) to High(AControls) do
Writeln(AControls[i].Name);
end;
procedure Test;
var
LabelsA: array[0..3] of TLabel;
LabelsB: array[0..1] of TLabel;
procedure Variant1;
type
TArray1 = array[Low(LabelsA)..High(LabelsA)] of TControl;
TArray2 = array[Low(LabelsB)..High(LabelsB)] of TControl;
begin
DoSomethingWithControls(TArray1(LabelsA));
DoSomethingWithControls(TArray2(LabelsB));
end;
procedure Variant2;
type
TControlArray = array[0..Pred(MaxInt div SizeOf(TControl))] of TControl;
PControlArray = ^TControlArray;
begin
DoSomethingWithControls(Slice(PControlArray(#LabelsA)^, Length(LabelsA)));
DoSomethingWithControls(Slice(PControlArray(#LabelsB)^, Length(LabelsB)));
end;
procedure Variant3;
var
ControlsA: array[Low(LabelsA)..High(LabelsA)] of TControl absolute LabelsA;
ControlsB: array[Low(LabelsB)..High(LabelsB)] of TControl absolute LabelsB;
begin
DoSomethingWithControls(ControlsA);
DoSomethingWithControls(ControlsB);
end;
begin
Variant1;
Variant2;
Variant3;
end;
There are some possible variants of calling DoSomethingWithControls:
Variant 1 is quite simple but needs an "adapter" types like TArray1
for every size of TLabel array. I would like it to be more flexible.
Variant 2 is more flexible and uniform but ugly and error prone.
Variant 3 (courtesy of
TOndrej) is similar to
Variant 1 - it doesn't need an explicit cast, but Variant 1 offers a
tiny bit more compiler security if you mess something up (e.g.
getting the array bounds wrong while copy-pasting).
Any ideas how i can formulate these calls without these disadvantages (without changing the element types of the arrays)? It should work with D2007 and XE6.
These casts are all rather ugly. They will all work, but using them makes you feel dirty. It's perfectly reasonable to use a helper function:
type
TControlArray = array of TControl;
function ControlArrayFromLabelArray(const Items: array of TLabel): TControlArray;
var
i: Integer;
begin
SetLength(Result, Length(Items));
for i := 0 to high(Items) do
Result[i] := Items[i];
end;
And then you call your function like this:
DoSomethingWithControls(ControlArrayFromLabelArray(...));
Of course, this would be so much cleaner if you could use generics.
Not extremely beautiful either but you could trick the compiler like this:
procedure Variant3;
var
ControlsA: array[Low(LabelsA)..High(LabelsA)] of TControl absolute LabelsA;
begin
DoSomethingWithControls(ControlsA);
end;
Declare an overloaded procedure:
procedure DoSomethingWithControls(const AControls: array of TControl); overload;
var
i: Integer;
begin
for i := 0 to High(AControls) do
if Assigned(AControls[i]) then
Writeln(AControls[i].Name)
else
WriteLn('Control item: ',i);
end;
procedure DoSomethingWithControls(const ALabels: array of TLabel); overload;
type
TControlArray = array[0..Pred(MaxInt div SizeOf(TControl))] of TControl;
PControlArray = ^TControlArray;
begin
DoSomethingWithControls(Slice(PControlArray(#ALabels)^, Length(ALabels)));
end;
This is a general solution to your variant2. One declaration for all cases, so less prone to errors.
Below example is based on how open array parameters are internally implemented. It won't work with "typed # operator" however.
procedure Variant4;
type
TCallProc = procedure (AControls: Pointer; HighBound: Integer);
var
CallProc: TCallProc;
begin
CallProc := #DoSomethingWithControls;
CallProc(#LabelsA, Length(LabelsA) - 1);
CallProc(#LabelsB, Length(LabelsB) - 1);
end;
Passing High(Labels) for HighBound is perhaps better as long as all static arrays are 0 based.
Since a dynamic array can be passed into method as an open array, and option would be to convert the static array to a dynamic array.
If you don't mind the overhead of copying the array, consider the following:
Write a function to convert an open array of labels into a dynamic TControlArray array.
type
TControlArray = array of TControl;
{$IFOPT R+} {$DEFINE R_ON} {$R-} {$ENDIF}
function MakeControlArray(const ALabels: array of TLabel): TControlArray;
begin
SetLength(Result, Length(ALabels));
Move(ALabels[0], Result[0], Length(ALabels) * SizeOf(TObject));
end;
{$IFDEF R_ON} {$R+} {$UNDEF R_ON} {$ENDIF}
Now Variant4 can be written as:
procedure Variant4;
begin
DoSomethingWithControls(MakeControlArray(LabelsA));
DoSomethingWithControls(MakeControlArray(LabelsB));
end;
Test cases:
procedure TAdHocTests.TestLabelsToControls;
const
LLabelsA: array[0..3] of TLabel = (Pointer(0),Pointer(1),Pointer(2),Pointer(3));
var
LLoopI: Integer;
LLabelsB: array[0..9] of TLabel;
LEmptyArray: TLabelArray;
begin
for LLoopI := Low(LLabelsB) to High(LLabelsB) do
begin
LLabelsB[LLoopI] := Pointer(LLoopI);
end;
DoSomethingWithControls(MakeControlArray(LLabelsA), Length(LLabelsA));
DoSomethingWithControls(MakeControlArray(LLabelsB), Length(LLabelsB));
DoSomethingWithControls(MakeControlArray([]), 0);
DoSomethingWithControls(MakeControlArray(LEmptyArray), 0);
end;
procedure TAdHocTests.DoSomethingWithControls(
const AControls: array of TControl;
AExpectedLength: Integer);
var
LLoopI: Integer;
begin
CheckEquals(AExpectedLength, Length(AControls), 'Length incorrect');
for LLoopI := Low(AControls) to High(AControls) do
begin
CheckEquals(LLoopI, Integer(AControls[LLoopI]));
end;
end;
I'm trying to create my own class object and use it to store various data types for my application, this all works fine when using Published Properties, I can stream these to disk and back with no problems. But I need to stream some Arrays of both integer and strings data types as well.
I understand that Arrays, amongst other data types can't be published properties because Delphi doesn't know how to stream them, I was led to believe you need to use DefineProperties to accomplish this, I've created a test Array of String as a Public property, I can read and write to it just fine, however I need to stream it to disk so i can save it for future use.
The only thing i can find that touches on this subject is here:
Array of a custom class as a property
I've attempted to copy this code and manipulate it to archive what I need but I cannot get it to save, I'm seemingly missing something obvious, my test code I'm using is below, I get no errors with this code, published properties stream to disk ok but my private array does not. Any help would be greatly appreciated.
Thanks.
unit UnitDataSet;
//------------------------------------------------------------------------------
interface
uses System.Classes;
{$M+}
//------------------------------------------------------------------------------
type
TDataStrings = Array [1..50] of String;
TDataSet = class(TComponent)
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader: TReader);
procedure WriteArray(Writer: TWriter);
private
FArrayToSave : TDataStrings;
FPStr : String;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
property Items[I: Integer]: String read GetItem write SetItem;
published
property StringItem : String read FPStr write FPStr;
end;
//------------------------------------------------------------------------------
var
DataSet: TDataSet;
implementation
uses TypInfo, Sysutils;
{ TDataSet }
//------------------------------------------------------------------------------
procedure TDataSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
destructor TDataSet.Destroy;
begin
inherited;
end;
//------------------------------------------------------------------------------
function TDataSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > 0) and (I < Length(FArrayToSave)) then
Result := FArrayToSave[I];
end;
//------------------------------------------------------------------------------
procedure TDataSet.SetItem(I: Integer; Value: string);
begin
if (I > 0) and (I < Length(FArrayToSave)) then
FArrayToSave[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromStream(const Stream: TStream);
var
Reader: TReader;
PropName, PropValue: string;
begin
Reader := TReader.Create(Stream, $FFF);
Stream.Position := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do
begin
PropName := Reader.ReadString;
PropValue := Reader.ReadString;
SetPropValue(Self, PropName, PropValue);
end;
FreeAndNil(Reader);
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToStream(const Stream: TStream);
var
PropName, PropValue: string;
cnt: Integer;
lPropInfo: PPropInfo;
lPropCount: Integer;
lPropList: PPropList;
lPropType: PPTypeInfo;
Writer: TWriter;
begin
lPropCount := GetPropList(PTypeInfo(ClassInfo), lPropList);
Writer := TWriter.Create(Stream, $FFF);
Stream.Size := 0;
Writer.WriteListBegin;
for cnt := 0 to lPropCount - 1 do
begin
lPropInfo := lPropList^[cnt];
lPropType := lPropInfo^.PropType;
if lPropType^.Kind = tkMethod then Continue;
PropName := lPropInfo.Name;
PropValue := GetPropValue(Self, lPropInfo);
Writer.WriteString(PropName);
Writer.WriteString(PropValue);
end;
Writer.WriteListEnd;
FreeAndNil(Writer);
end;
//------------------------------------------------------------------------------
constructor TDataSet.Create(aOwner: TComponent);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TDataSet.ReadArray(Reader: TReader);
var
N: Integer;
begin
N := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do begin
Reader.ReadListBegin;
FArrayToSave[N] := Reader.ReadString;
Reader.ReadListEnd;
Inc(N);
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := 1 to High(FArrayToSave) do begin
Writer.WriteListBegin;
Writer.WriteString(FArrayToSave[I]);
Writer.WriteListEnd;
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
DataSet := TDataSet.Create(Nil);
finalization
FreeAndNil(DataSet);
end.
//------------------------------------------------------------------------------
Here is my Class code re-written with Arioch's suggested code modifications from below:
unit UnitCharSett;
interface
//------------------------------------------------------------------------------
uses System.Classes;
//------------------------------------------------------------------------------
type
TCustomDatSetA = Array [0..99] of String;
TCustomCharSet = class(TComponent)
public
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
end;
TZCharSet = class(TCustomCharSet)
private
FFullArray : TCustomDatSetA;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader:TReader);
procedure WriteArray(Writer:TWriter);
public
property Items[Index: Integer]: string read GetItem write SetItem;
published
end;
//------------------------------------------------------------------------------
implementation
uses
System.TypInfo, System.SysUtils;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(Self);
end;
//------------------------------------------------------------------------------
{ TZCharSett }
//------------------------------------------------------------------------------
procedure TZCharSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
function TZCharSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > -1) and (I < Length(FFullArray)) then
Result := FFullArray[I];
end;
//------------------------------------------------------------------------------
procedure TZCharSet.ReadArray(Reader: TReader);
var
N: Integer;
S: String;
begin
for N := Low(FFullArray) to High(FFullArray) do begin
FFullArray[N] := '';
end;
Reader.ReadListBegin;
N := Reader.ReadInteger;
if N = Length(FFullArray) then
begin
N := Low(FFullArray);
while not Reader.EndOfList do
begin
S := Reader.ReadString;
if N <= High(FFullArray) then
FFullArray[N] := S;
Inc(N);
end;
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.SetItem(I: Integer; Value: string);
begin
if (I > -1) and (I < Length(FFullArray)) then
FFullArray[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
Writer.WriteInteger(Length(FFullArray));
for I := Low(FFullArray) to High(FFullArray) do begin
Writer.WriteString(FFullArray[I]);
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
RegisterClasses([TZCharSet]);
//------------------------------------------------------------------------------
end.
HOW do you actually try to read and write it ? I think you're trying to make complex incompatible things when there instead of using standard methods.
Why not to use standard VCL streaming procedures?
procedure TMyDataSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(self);
end;
procedure TMyDataSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(self);
end;
However if instead of using TFiler and standard VCL streamer you make your custom code using RTTI (GetPropList) - then it would not call those virtual properties APi custom to TFiler and would only show real properties.
So my advice is just to use standard emthods like shown above and to streamline and harden the code.
And since RegisterClass works by the classname you'd better choose another name, not clashing with a real TDataSet from stock DB unit.
Fix the name and do register the class, so VCL streamer could find it by name! For example:
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
S := Reader.ReadString; // even if we would not save it - we should remove it from the input
if N <= High(FArrayToSave) then
FArrayToSave[N] := S;
Inc(N);
end;
Reader.ReadListEnd;
end;
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
Writer.WriteString(FArrayToSave[I]);
end;
Writer.WriteListEnd;
end;
initialization
DataSet := TMyDataSet.Create(Nil);
RegisterClasses([TMyDataSet]);
finalization
DataSet.Free;
end.
Additionally, i think you'd better - for future extensibility - save the array length in DFM.
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteInteger(Length(FArrayToSave));
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
....
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
for N := Low(FArrayToSave) to High(FArrayToSave) do begin
FArrayToSave := ''; // in case DFM would have less elements than 50
N := Reader.ReadInteger;
if N <> Length(FArrayToSave) then... recovery from unexpected DFM version error
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
PS. you do not need {$M+} there since TComponent already is derived from TPersistent
PPS. Wanted to comment upon update in the question, but the phone refuses to do (too long?) so putting it here.
1: since we moved away from using RTTI, the Typinfo unit no more needed in uses. 2: if N = Length(FFullArray) then lacks ELSE path. Okay, now we learned that DFM is broken or incompatible, what then? I think we better raise some error. Or try to remove list of N strings, so next property could be read. Or even remove the list of elements of any type/quantity until list end. Future compatibly is never warranted, but at least some attempt can be done, even just to explicitly halt with error. Skipping reading and silently leaving the reader inside middle of property, so next properties would get crazy, I think is not the way to do it.
And generally David is correct about ignoring incorrect indices in the setter and getter. Unless you would intentionally come with some unusual pattern of implicit item creation from default template in sparse array by setting or getting with "free" "unbound" index (which is no code for either) the better approach at least in Delphi would be "fail early". That is what users of your class would expect by default. So kinda
Procedure class.CheckArrayIdx(const i: integer);
Var mx, mn : integer;
Begin
Mn := low(myarray) ; Mx := high(myarray);
If (i <= mx) and (I >= mn) then exit;
Raise ERangeError.CreateFmt('%s.Items index should be %d <= %d <= %d', [
Self.ClassName, mn, I, mx]) ;
End;
This procedure can be called as 1st line in both setter and getter. Then you can just work with surely correct index value.