How can I use a class property index to assign a variable? - class

I have created a class:
type
TShape = class
private
FHeight: Integer;
FWidth: Integer;
FDepth: Integer;
public
constructor CreateShape(AHeight: Integer; AWidth: Integer; ADepth: Integer);
property height: Integer index 0 read FHeight write FHeight;
property width: Integer index 1 read FWidth write FWidth;
property depth: Integer index 2 read FDepth write FDepth;
end;
.
constructor TShape.CreateShape(AHeight: Integer; AWidth: Integer;
ADepth: Integer);
begin
inherited Create;
FHeight := AHeight;
FWidth := AWidth;
FDepth := ADepth;
end;
And currently I assign the values by using the name of the property to assign a variable:
cube := TShape.CreateShape(5, 5, 5);
height1 := cube.FHeight;
width1 := cube.FWidth;
depth1 := cube.FDepth;
But how do I use the index instead of the name to assign a property, so height1 := cube.FHeight would instead be height1 := cube[0]?

I think you have misunderstood how index specifiers work. They allow you to use a single getter or setter function for several properties:
TTest = class
private
function GetColor(AIndex: Integer): TColor;
public
property BackgroundColor: TColor index 0 read GetColor;
property ForegroundColor: TColor index 1 read GetColor;
end;
// ...
function TTest.GetColor(AIndex: Integer): TColor;
begin
case AIndex of
0:
Result := clRed; // background colour
1:
Result := clBlue; // foreground colour
else
Result := clBlack;
end;
end;
Hence, it can only be used with getter and setter functions; you cannot use fields.
You seem to be interested in something different, an array property, which is in addition default. An array property is a property that is an array to the object's user (like Memo1.Lines[4]). Hence, it is a single property which is an array.
In your case, you could add a public property
property Dimensions[Index: Integer]: Integer read GetDimension;
where the private getter function
function GetDimension(Index: Integer): Integer;
is defined as
function TShape.GetDimension(Index: Integer): Integer;
begin
case Index of
0:
Result := FHeight;
1:
Result := FWidth;
2:
Result := FDepth;
else
Result := 0; // or raise an exception
end;
end;
This would still use your FHeight, FWidth, and FDepth fields to store the data under the hood.
Alternatively, you could store the data in a static or dynamic array of integers. Then you could create indexed properties Width, Height, and Depth and use the same getter function as for the array property:
type
TShape = class
private
FDimensions: array[0..2] of Integer;
function GetDimension(Index: Integer): Integer;
public
constructor CreateShape(AHeight: Integer; AWidth: Integer; ADepth: Integer);
property Height: Integer index 0 read GetDimension;
property Width: Integer index 1 read GetDimension;
property Depth: Integer index 2 read GetDimension;
property Dimensions[Index: Integer]: Integer read GetDimension;
end;
// ...
{ TShape }
constructor TShape.CreateShape(AHeight, AWidth, ADepth: Integer);
begin
FDimensions[0] := AHeight;
FDimensions[1] := AWidth;
FDimensions[2] := ADepth;
end;
function TShape.GetDimension(Index: Integer): Integer;
begin
if InRange(Index, Low(FDimensions), High(FDimensions)) then
Result := FDimensions[Index]
else
raise Exception.CreateFmt('Invalid dimension index: %d', [Index]);
end;
Now you can access MyShape.Height, MyShape.Width, and MyShape.Depth, as well as MyShape.Dimensions[0], MyShape.Dimensions[1], and MyShape.Dimensions[2].
If you mark the array property as default,
property Dimensions[Index: Integer]: Integer read GetDimension; default;
you can also write MyShape[0], MyShape[1], and MyShape[2].
Note: For simplicity, my examples above only use getters. But setters work as well.

Related

Record is empty?

Is there any data in a Record Type with Delphi? How is it understood?
For example, supposedly get a Record Type like this;
type
TDummy = PACKED record
Text : String;
Number : Integer;
end;
var
aRecord : TDummy;
begin
aRecord := default(TDummy); // In this state "aRecord" is empty. (Text = '' and Number = 0)
aRecord.Text := 'TEST'; // This is no longer empty
end;
So is there any way to figure out this without browsing through the Record Items?
Using a member function
By far the cleanest approach, IMHO, is to declare a method TDummy.IsEmpty: Boolean:
type
TDummy = record
Text: string;
Number: Integer;
function IsEmpty: Boolean;
end;
{ TDummy }
function TDummy.IsEmpty: Boolean;
begin
Result := (Text = '') and (Number = 0);
end;
Then you can always use this method to see if the record is empty:
procedure TForm1.FormCreate(Sender: TObject);
var
D: TDummy;
begin
D := Default(TDummy);
if D.IsEmpty then
ShowMessage('D is empty.');
D.Number := 394;
if D.IsEmpty then
ShowMessage('D is empty.');
end;
Using the equals operator
A different approach:
type
TDummy = record
Text: string;
Number: Integer;
class operator Equal(const Left, Right: TDummy): Boolean;
class operator NotEqual(const Left, Right: TDummy): Boolean;
end;
const
EmptyDummy: TDummy = ();
{ TDummy }
class operator TDummy.Equal(const Left, Right: TDummy): Boolean;
begin
Result := (Left.Text = Right.Text) and (Left.Number = Right.Number);
end;
class operator TDummy.NotEqual(const Left, Right: TDummy): Boolean;
begin
Result := not (Left = Right);
end;
Now you can do
procedure TForm1.FormCreate(Sender: TObject);
var
D: TDummy;
begin
D := Default(TDummy);
if D = EmptyDummy then
ShowMessage('D is empty.');
D.Number := 394;
if D = EmptyDummy then
ShowMessage('D is empty.');
end;
Crazy stuff
If you absolutely do not want to compare each member separately, you can under some circumstances compare the bytes.
But please notice that in general, you cannot compare two records by comparing their bytes. Just to mention two obvious reasons:
String members may be semantically equal even though they are represented by two different string heap objects (so that comparer says "not equal" while in fact they are equal).
Records may have padding if they are not packed (so the comparer might say "not equal" while in fact they are equal).
But you only want to compare against the "default" (zeroed) value, and as a bonus your record type happens to be packed, so you could get away with
type
TDummy = packed record
Text: string;
Number: Integer;
end;
TZeroRecord<T: record> = record
class function IsZero([Ref] const ARecord: T): Boolean; static;
end;
{ TZeroRecord<T> }
class function TZeroRecord<T>.IsZero([Ref] const ARecord: T): Boolean;
begin
var DefT := Default(T);
Result := CompareMem(#ARecord, #DefT, SizeOf(T));
end;
and
procedure TForm1.FormCreate(Sender: TObject);
var
D: TDummy;
begin
D := Default(TDummy);
if TZeroRecord<TDummy>.IsZero(D) then
ShowMessage('D is empty.');
D.Number := 394;
if TZeroRecord<TDummy>.IsZero(D) then
ShowMessage('D is empty.');
end;
But this is fairly crazy.

How to fill an ADT parameter in Firedac on Delphi?

I have a stored procedure in the database (PostgreSql) and it receives a record as a parameter. When an FdStoredProc is prepared with this function, the parameter is created with the following definitions:
DataType = ftADT
FDDataType = dtRowRef
ParamType = ptInput
I would like to know how to fill this parameter in execution mode.
See a function example
CREATE TYPE t_row_param AS
(
one_field INTEGER,
other_field NUMERIC,
another_field TEXT
--...
);
CREATE FUNCTION my_function(_asuper_row t_row_param)
RETURNS void
LANGUAGE sql
STABLE
AS
$$
--...process row
$$;
and that is the sample Delphi code:
type
TMyRow = record
one_field: integer;
other_field Double;
another_field : String;
end;
procedure DB_MyFunction(_arow: TMyRow);
var
aproc := TFDStoredProc;
begin
aproc := TFDStoredProc.Create(nil);
aproc.Connection := aconnection;
aproc.StoredProcName := 'my_function';
aproc.Prepare;
//aproc.params.ParamByName('_asuper_row')AsXXX := ???; how do it?
//...finalize
end;

Delphi How to avoid Access violation when creating Tlist inside a Class definition [duplicate]

This question already has answers here:
Access violation when assigning a value to my component Bitmap property [closed]
(1 answer)
Keep getting access violation when trying to access array
(1 answer)
Inaccessible value causing Access violation [duplicate]
(1 answer)
Delphi: TImage.Create causes Access violation
(2 answers)
Closed 3 years ago.
I have made a Class representing a 2D array of strings using a type Tlist defined as
type
T2DimensionalStringlist = Tlist<Tstringlist>;
TwoDstringlistClass = class
private
TwoDimStringlist : T2DimensionalStringlist;
etc.
However I get an access violation when I call the constructor. All the constructor does is create the list using
TwoDimStringlist:= T2DimensionalStringlist.Create;
I haven't made many classes yet but the the full code of this one is at the bottom of this post.
Please can someone tell me what I have done wrong that would cause the access violation in the class constructor?
What I have tried
I've looked at this SO thread but it didn't really answer my question.
I've also tried turning the whole thing into a simple unit instead of a class and defining the list type and variable as globals eg
type
T2DimensionalStringlist = Tlist<Tstringlist>;
var
TwoDimStringlist: T2DimensionalStringlist ;
Then, if I create the list in the initialization with
TwoDimStringlist:= T2DimensionalStringlist.Create;
and free it in the finalization with
for i := 0 to TwoDimStringlist.Count - 1 do
TwoDimStringlist[i].free;
TwoDimStringlist.free;
then it works fine and I can use it as a 2D array of strings with various other procedures and functions like those in the class unit.
I've also tried moving the
type
T2DimensionalStringlist = Tlist<Tstringlist>;
to inside the class instead of outside but still got the error.
Here is the full code of the class
unit U_TwoDstringlist;
interface
uses
classes, //for Tstringlist
Generics.Collections; //for Tlist
type
T2DimensionalStringlist = Tlist<Tstringlist>;
TwoDstringlistClass = class
private
TwoDimStringlist : T2DimensionalStringlist;
public
function AddStringlist : integer; //returns index of newnly created stringlist
function AddString(ListIndex : integer; S : string) : boolean; //adds a string to the list at index ListIndex
function GetStringlist(ListIndex : integer): Tstringlist; //retuns the stringlist from index ListIndex
function ListCount : integer ; //returns number of used elements
function StringlistCount(ListIndex : integer) : integer ; //returns number of used elements in a particular stringlist
function GetString(ListIndex,StringlistIndex : integer) : string; //returns string at 2D index ListIndex,StringlistIndex
constructor Create; overload;
destructor Destroy; override;
end; //class
implementation
constructor TwoDstringlistClass.Create;
begin
TwoDimStringlist := T2DimensionalStringlist.Create;
end;
destructor TwoDstringlistClass.Destroy;
var
i : integer;
begin
for i := 0 to TwoDimStringlist.Count - 1 do
TwoDimStringlist[i].free;
TwoDimStringlist.free;
inherited;
end;
function TwoDstringlistClass.AddString(ListIndex: integer; S: string): boolean;
begin
try
TwoDimStringlist[ListIndex].add(s) ;
result := true;
except
result := false;
end;
end;
function TwoDstringlistClass.AddStringlist: integer;
begin
TwoDimStringlist.add(Tstringlist.create);
result := TwoDimStringlist.count -1;
end;
function TwoDstringlistClass.GetString(ListIndex, StringlistIndex: integer): string;
begin
try
result := TwoDimStringlist[ListIndex][StringlistIndex];
except
result := '';
end;
end;
function TwoDstringlistClass.GetStringlist(ListIndex: integer): Tstringlist;
begin
try
result := TwoDimStringlist[ListIndex] ;
except
result := nil;
end;
end;
function TwoDstringlistClass.ListCount: integer;
begin
result := TwoDimStringlist.count;
end;
function TwoDstringlistClass.StringlistCount(ListIndex: integer): integer;
begin
try
result := TwoDimStringlist[ListIndex].count
except
result := -1
end;
end;
end.
and the main form uses this class like this
implementation
var
My2dList : TwoDstringlistClass;
begin
procedure TForm1.btnCreateClick(Sender: TObject);
begin
My2dList.create;
end;
etc.

How to initialize row datatype variables?

I would like to create a function that initialize and return the row datatype of a table as
CREATE FUNCTION get_default_table_row_object()
RETURNS mytable AS $$
DECLARE
row mytable;
BEGIN
row.field1 := 0;
row.field2 := -1;
row.record_reg_id := 1;
row.record_upd_id := 1;
row.record_reg_date := current_timestamp;
row.record_upd_date := current_timestamp;
RETURN row;
END;
$$ LANGUAGE plpgsql;
becuase my table has alot of columns and I need to create dozens of variables at several functions. I would like to use above function as
CREATE FUNCTION some_function() RETURNS VOID AS $$
DECLARE
i_obj1 mytable := get_default_table_row_object(); -- declare and initialize default values
BEGIN
-- function body
END;
$$ LANGUAGE plpgsql;
But this give me the error ERROR: default value for row or record variable is not supported. Has someway to figure it out ?
You can set it in the body instead, like so:
CREATE FUNCTION some_function() RETURNS VOID AS $$
DECLARE
i_obj1 mytable; -- declare only
BEGIN
i_obj1 := get_default_table_row_object(); -- set default values
END;
$$ LANGUAGE plpgsql;

Initialize multiple variables as records in postgresql stored procedure

I have a stored procedure where I declare three variables as records and initialize them later as below:
CREATE OR REPLACE FUNCTION calculateUnitPrice()
RETURNS VOID AS
$$
DECLARE
amenities RECORD;
paramValues RECORD;
logsumAccessebility RECORD;
propertyType integer;
unitPrice float;
freehold integer;
tazId bigint;
unit RECORD;
BEGIN
FOR unit IN (SELECT * from main2012.fm_unit_res)
LOOP
amenities := getAmenitiesById(unit.sla_address_id);
tazId := toBigint(amenities.taz_id);
logsumAccessebility := getLogsumByTazId(tazId);
propertyType := getPropertyTypeFromUnitType(unit.unit_type);
paramValues := getParamValuesByPropertyType(propertyType);
freehold := 0;
unitPrice := paramValues.intercept + (paramValues.floor_area * ln(unit.floor_area)) + (paramValues.freehold * freehold) + (paramValues.logsum_accessebility * logsumAccessebility.accessibility);
UPDATE main2012.fm_unit_res SET rent = unitPrice WHERE fm_unit_id = unit.fm_unit_id;
END LOOP;
RETURN;
END;
$$ LANGUAGE plpgsql;
But when I run the function I am getting an error like this:
ERROR: record "paramvalues" is not assigned yet
SQL state: 55000
Detail: The tuple structure of a not-yet-assigned record is indeterminate.
Context: PL/pgSQL function calculateunitprice() line 20 at assignment
Please give me your ideas. Am I doing anything wrong here (syntax) or is there a limit in the number of records I can initialize within a stored procedure?
Debug the output, by adding
raise info '%',getPropertyTypeFromUnitType(unit.unit_type);
raise info '%',getPropertyTypeFromUnitType(unit.unit_type);
before declaring paramValues