I am following this tutorial on importing CSV file to Delphi. I drafted the code provided below. The program compiles with no problems but when I attempt to execute function to read the file I get the grid out of range error message.
unit geoimp;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Buttons, Vcl.StdCtrls,
Vcl.Grids, Vcl.DBGrids, Data.DB, Datasnap.DBClient;
const
shfolder = 'ShFolder.dll';
type
TMainForm = class(TForm)
MainPageControl: TPageControl;
ImportTab: TTabSheet;
MapPreviewTab: TTabSheet;
GeoMatchingTab: TTabSheet;
ImportLbl: TLabel;
SlctImportDta: TSpeedButton;
MainOpenDialog: TOpenDialog;
MainListBox: TListBox;
SG1: TStringGrid;
procedure SlctImportDtaClick(Sender: TObject);
private
{ Private declarations }
procedure ParseRecord(sRecord: string; Row: integer);
procedure ReadCSVFile;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.ParseRecord(sRecord: string; Row: integer);
var
Col, PosComma: integer;
sField: string;
begin
sRecord := StringReplace(sRecord, '"', '',
[rfReplaceAll] ); // 1.
Col := 0; // first column of stringgrid
repeat
PosComma := Pos(',', sRecord); // 2.
if PosComma > 0 then
sField := Copy(sRecord, 1, PosComma - 1) // 3.a
else
sField := sRecord; // 3.b
SG1.Cells[Col, Row] := sField; // 4.
if PosComma > 0 then begin // 5.
Delete(sRecord, 1, PosComma);
Col := Col + 1; // next column
end;
until PosComma = 0; // 6.
end;
procedure TMainForm.ReadCSVFile;
var
FileName1, sRecord: string;
Row: integer;
begin
FileName1 := MainOpenDialog.FileName;
MainListBox.Items.LoadFromFile(FileName1);
SG1.RowCount := MainListBox.Items.Count;
for Row := 0 to MainListBox.Items.Count - 1 do begin
sRecord := MainListBox.Items[Row];
ParseRecord(sRecord, Row);
end;
// 5. Select first "data" cell
SG1.Row := 1;
SG1.Col := 0;
SG1.SetFocus;
end;
procedure TMainForm.SlctImportDtaClick(Sender: TObject);
begin
// Create the open dialog object - assign to our open dialog variable
MainOpenDialog := TOpenDialog.Create(self);
// Set up the starting directory to be the current one
MainOpenDialog.InitialDir := GetCurrentDir;
// Only allow existing files to be selected
MainOpenDialog.Options := [ofFileMustExist];
// Allow only .dpr and .pas files to be selected
MainOpenDialog.Filter :=
'CSV Files|*.csv';
// Select pascal files as the starting filter type
MainOpenDialog.FilterIndex := 2;
// Display the open file dialog
if MainOpenDialog.Execute
then ReadCSVFile
else ShowMessage('Open file was cancelled');
// Free up the dialog
MainOpenDialog.Free;
end;
end.
Without seeing the data, you've made some dangerous assumptions by removing the quotes from the input strings. It's perfectly valid to have commas embedded inside of quoted strings in CSV files -- indeed, that's why they allow quoted strings. All you need is one embedded comma in one record and it'll blow up if you don't have enough columns defined.
You don't show how you're setting the grid's ColCount. By default it's set to 5.
The FixedRows/FixedColumns values need to be accommodated in the RowCount/ColCount as well.
Above line 6 you could insert this:
if (col >= (SG1.ColCount+SG1.FixedColumns)) then
SG1.ColCount := SG1.ColCount + 1;
That will grow the number of columns in the grid and allow you to see the results of any errant commas embedded inside of quoted strings in your CSV data.
In the 3rd line of ReadCSVFile where you set SG1.RowCount, it will be short if SG1.FixedRows > 0.
These are all possible causes of the exceptions you're getting.
Related
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.
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;
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.
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;
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