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

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.

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;

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

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.

Delphi Application.CreateForm is the Handle Unique for each Form?

I have a TreeList , with many Items , each item has it's own unique ID .
I allow the user to open multiple IDs at once . But I would like to prevent the user from opening the same ID twice .
So I thought about creating a simple Dynamic Array where I store which TreeList ID is connected to which Form HWND . If I find a ID on my list with a Matching HWND, then I simply bring the Form which is already Created to Foreground.
Application.CreateForm(TChapter, Chapter);
Chapter.PopupParent:=Main;
Chapter.FID:=qryTreeID.Value;
Chapter.Caption:=qryTreeName.Value+Cardinal(Chapter.Handle).ToString;
Chapter.Show;
This is how I create a Form . This is just a "basic" example . I just wanted to make sure that the Handle is Unique , I opened Multiple Forms the Numbers were always different. But I want to make sure.
Thank you!
If you want to maintain your own lookup, a TDictionary would make more sense than a dynamic array. But either way, you should map the ID to the actual TForm object rather than to its HWND. The HWND is guaranteed to be unique, but not persistent, as it can change during the Form's lifetime. It would also save you from the extra step of having to get the TForm object from the HWND.
For example:
var
Chapters: TDictionary<Integer, TChapter> = nil;
procedure ChapterDestroyed(Self: Pointer; Sender: TObject);
begin
if Chapters <> nil then
Chapters.Remove(TChapter(Sender).FID);
end;
function FindChapterByID(ID: Integer): TChapter;
// var I: Integer;
begin
{
for I := 0 to Screen.FormCount-1 do
begin
if Screen.Forms[I] is TChapter then
begin
Result := TChapter(Screen.Forms[I]);
if Result.FID = ID then Exit;
end;
end;
Result := nil;
}
if not Chapters.TryGetValue(ID, Result) then
Result := nil;
end;
function CreateChapter(ID: Integer): TChapter;
var
Event: TNotifyEvent;
begin
TMethod(Event).Data := nil;
TMethod(Event).Code = #ChapterDestroyed;
Result := TChapter.Create(Main);
try
Result.FID := ID;
Result.PopupParent := Main;
Result.Caption := qryTreeName.Value + ID.ToString;
Result.OnDestroy := Event;
Chapters.Add(ID, Result);
except
Result.Free;
raise;
end;
end;
function ShowChapterByID(ID: Integer): TChapter;
begin
Result := FindChapterByID(ID);
if Result = nil then Result := CreateChapter(ID);
Result.Show;
end;
initialization
Chapters := TDictionary<Integer, TChapter>.Create;
finalization
FreeAndNil(Chapters);
Chapter := ShowChapterByID(qryTreeID.Value);
Thank you for both of you. I took SilverWariors advice , because of the simplicity :)
for i := 0 to Screen.FormCount-1 do
begin
if Screen.Forms[i] is TChapter then
if (Screen.Forms[i] as TChapter).FID = qryTreeID.Value then
begin
(Screen.Forms[i] as TChapter).BringToFront;
Exit;
end;
end;

Get text[] value from sql table with FireDAC on Delphi

On pgAdmin with a simple query 'select * from data' I got only one record containing a field type text[] with value '{"1","2","3"}'.
The following simplified code gives back only the "1" part of the value:
function GetData: string;
var
q: TFDQuery;
s: string;
i: integer;
av: array of variant;
as: array of string;
begin
result:='';
q:=TFDQuery.Create(nil);
try
q.Connection:=FDConnection;
q.SQL.Text:='select * from data';
try
q.Open;
while not q.Eof do
begin
//s:=q.FieldByName('data_array').AsString; //s = '1'
//as:=q.FieldByName('data_array').AsVariant; //as length = 1; as[0] = '1'
av:=q.FieldByName('data_array').AsVariant;
for i:=0 to Length(av)-1 do s:=s+av[i]; //av length = 1; s = '1'
q.Next;
end;
result:=q.RecordCount;
except
result:=-2;
end;
finally
q.Free;
sl.Free;
end;
end;
What is the way to get the whole data?
Although Embarcadero documentation says you should use TArrayField casting (It works for Interbase):
procedure TFrmMain.Button1Click(Sender: TObject);
var
F: TArrayField;
V: Variant;
begin
F := TArrayField(q.FieldByName('data_array'));
V := F.FieldValues[0];
ShowMessage(VarToStr(V));
end;
It seem not to work correctly for PostgreSQL ( at least with C++ builder XE6 i am getting only first array item). Firedac handles PostgreSQL array fields as nested datasets, therefore if above doesn't work for you as well,
in C++ you might use PG array as ordinary DataSet, accessing items by moving cursor e.g :
TDataSetField * TT = (TDataSetField*)q->FieldByName("data_array");
TT->NestedDataSet->RecNo=2; // or while(!q->NestedDataSet->eof) etc.
ShowMessage(TT->NestedDataSet->Fields->Fields[0]->AsString);
wchich translated to delphi in your case would look like ( may be misspelled):
...
var
TT: TDataSetField;
...
begin
TT:= TDataSetField(q.FieldByName('data_array'));
while not TT.NestedDataSet.Eof do
begin
s:= s+ TT.NestedDataSet.Fields.Fields[0].AsString; //0 - only single dimension supported
TT.NestedDataSet.Next;
end;
end;
Kind regards