I am having issues with loading a CSV into a StringGrid. Occasionally, it runs out of memory, but also it seems to have blank columns after each value. I've not really read from a CSV as opposed to output to one, so I took a stock example online and modified it for my needs.
This is what I've currently got:
procedure x.LoadCSVtoGrid(ACSVFile : String; AStringGrid: TStringGrid)
var
LRowIndex, LColIndex: Integer;
LStrLine: string;
LFile: TStringList;
begin
AStringGrid.RowCount := 0;
AStringGrid.ColCount := 0;
if not FileExists(ACSVFile) then
exit;
LFile := TStringList.Create;
try
LFile.LoadFromFile(ACSVFile);
if LFile.Count = 0 then
exit;
AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCount(LFile[0], [',', '"'], '"'));
AStringGrid.RowCount := LFile.Count;
for LRowIndex := 0 to LFile.Count - 1 do
begin
LStrLine := LFile[LRowIndex];
LColIndex := 0;
while LStrLine <> '' do
begin
if Pos('"', LStrLine) = 1 then
begin
Delete(LStrLine, 1, 1);
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos('"', LStrLine) - 1);
Delete(LStrLine, 1, Pos('"', LStrLine));
end
else
begin
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos(',', LStrLine) - 1);
Delete(LStrLine, 1, Pos(',', LStrLine));
end;
Inc(LColIndex);
end;
end;
finally
LFile.Free;
end;
For smaller CSV files, it does fine. I think it's reading up to 250-300 lines before. Some of the files it has to deal with now are 500+.
To be honest, I don't do much handling of the data of the CSV until it's been imported into the StringGrid, but once it's in the StringGrid, it's validated. I've got to make sure that commas within speech marks, ie "text, here", are ignored, as it's part of the value. Again, this appears to handle the reading fine.
Another issue I think I might run into is AStringGrid.RowCount := LFile.Count;, as some of the CSV files have blank lines. If there is a way to deal with this, I am happy to take suggestions.
There are a few versions of CSV files it should be able to read, ie the calculation of column counts and such. Code for WordCount:
function x.WordCount(const S: string; const WordDelims: TSysCharSet; const QuoteChar: Char) : Integer;
var
LInWord: Boolean;
LQuoteOpen: Boolean;
i: Integer;
begin
Result := 0;
LInWord := False;
LQuoteOpen := False;
for i := 1 to Length(S) do
begin
if S[i] in WordDelims then
begin
if not LInWord or LQuoteOpen then
LInWord := False
else
begin
LInWord := True;
Inc(Result);
end;
end
else
begin
if S[i] = QuoteChar then
LQuoteOpen := not LQuoteOpen;
LInWord := True;
end;
end;
if LInWord and (not LQuoteOpen) then
Inc(Result);
I've tried multiple files, for the most part this issue only happens with larger CSV files with more content. I've tried various versions of CSV-to-StringGrid procedures to see if there is something innately wrong with the example I took above. The example works, but only on smaller files.
Let me know if you need more information.
Memory issue
First you create a TStringList and then load it with data
LFile := TStringList.Create;
LFile.LoadFromFile(ACSVFile);
Because you load the whole file into the string list, you need that much of memory, plus equally much to hold the data in the TStringGrid.
Reduce memory requirement by reading the file in chunks of, say, 1000 lines at the time, which you then can throw away after they are moved to the string grid.
OTOH, your "Out of memory" problem might also be caused by the errors in your code. I experienced an "Out of memory" error with my very small test file when run with your unaltered code.
Issues with code
In my tests I used a simple file with a few records and a quoted field in different locations. The file content is:
one,two,"text, including comma",four,five
one,two,three,four,five
"text, including comma",two,three,four,five
one,two,three,four,"text, including comma"
You determine required number of columns in the TStringGrid, by calling the WordCount() function, to which you pass the first string from the string list.
WordCount(const S: string; const WordDelims: TSysCharSet; const QuoteChar: Char) : Integer;
When I pass in the first test string,
'one,two,three,four,five',
WordCount returns correctly 5
Then, control returns to LoadCSVtoGrid(), and after assigning AStringGrid.ColCount and RowCount the for LRowIndex loop starts to fill the grid with data for the current row. Pay attention to the second part, after else:
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos(',', LStrLine) - 1);
Delete(LStrLine, 1, Pos(',', LStrLine));
The Delete() deletes from beginning of LStrLine to Pos(',', LStrLine). This works ok for items "one,", "two,", "three," and "four,", but not for "five" as there is no comma after the last item.
This is the major flaw in the code as it never deletes the last item. Instead, since the loop runs while LString <> '' it just continues incrementing LColIndex
On my machine it stops after a couple of minutes with an out-of-memory error.
Here is my take on WordCount (renamed WordCountNew) function:
function TForm50.WordCountNew(const s: string; const Delimiter: Char;
const QuoteChar: Char): Integer;
var
InWord, InQuote: boolean;
i: integer;
begin
if s = '' then // Just in case we are fed an empty string
Exit(0);
Result := 1; // Init, at least one data item
InWord := False; // Init
InQuote:= False; // Init
for i := 1 to Length(s) do
begin
if s[i] = QuoteChar then // The field is quoted
InQuote := not InQuote; // make note about it
if s[i] = Delimiter then // Delimiter found
begin
if not InQuote then // ... but only count it,
inc(Result); // if not within a quote
end;
end;
end;
Then the LoadCSVtoGrid procedure:
procedure TForm50.LoadCSVtoGrid(ACSVFile: String; AStringGrid: TStringGrid);
var
LRowIndex, LColIndex: Integer;
LStrLine: string;
LFile: TStringList;
CommaPos: integer; // added
begin
AStringGrid.RowCount := 0;
AStringGrid.ColCount := 0;
if not FileExists(ACSVFile) then
exit;
LFile := TStringList.Create;
try
LFile.LoadFromFile(ACSVFile);
if LFile.Count = 0 then
exit;
// When determining column count we should ONLY count the field separator, comma.
// A quote character is not an indication of a new column / field.
// Therefore we remove the array of chars, `[',', '"']` and replace with `','`
// AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCount(LFile[0], [',', '"'], '"'));
AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCountNew(LFile[0], ',', '"'));
AStringGrid.RowCount := LFile.Count;
for LRowIndex := 0 to LFile.Count - 1 do
begin
LStrLine := LFile[LRowIndex];
LColIndex := 0;
while LStrLine <> '' do
begin
if Pos('"', LStrLine) = 1 then
begin
Delete(LStrLine, 1, 1);
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos('"', LStrLine) - 1);
AStringGrid.UpdateControlState;
Delete(LStrLine, 1, Pos('"', LStrLine));
Delete(LStrLine, 1, Pos(',', LStrLine));
end
else
begin
CommaPos := Pos(',', LStrLine);
if CommaPos = 0 then CommaPos := Length(LStrLine)+1;
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, CommaPos-1); //Pos(',', LStrLine) - 1);
AStringGrid.UpdateControlState;
Delete(LStrLine, 1, CommaPos); // Pos(',', LStrLine));
end;
Inc(LColIndex);
end;
end;
finally
LFile.Free;
end;
end;
I added the CommaPos variable, to make it easier to artificially simulate a comma at the end of the string.
With these changes the test file is properly read into the grid.
I'm having a problem with structured text in Codesys V3.5 SP9 Patch 5. What I want to do is to be able to use a timer within a function created by me, which is called in a POU. I've done the same without using function by putting timer directly into POU and it is working.
My function declaration:
FUNCTION AssignDOORStatus : USINT
VAR_INPUT
DDUC_ComSta_Dcux_x: BOOL; //No communication
DDUC_DCUxEmHdler_x: BOOL; //Emergency handler
END_VAR
VAR
Timer: TP; //Timer to do intermittence between current doors status and emergency handler
CurrentDoorStatus: USINT;
TONProcessTime: TIME := T#1S; //TONProcesTime
END_VAR
My function code:
IF DDUC_ComSta_Dcux_x THEN
CurrentDoorStatus := 0;
ELSE
CurrentDoorStatus := 1;
END_IF
IF DDUC_DCUxEmHdler_x THEN
Timer(IN := NOT Timer.Q, PT := TONProcessTime); //Timer starts
Timer();
IF Timer.Q THEN //When TONProcessTime has gone by
IF AssignDOORStatus <> CurrentDoorStatus THEN
AssignDOORStatus := CurrentDoorStatus;
ELSE AssignDOORStatus := 10;
END_IF
END_IF
ELSE
AssignDOORStatus := CurrentDoorStatus;
END_IF
My code in POU main:
testdoor := AssignDOORStatus(DDUC_ComSta_Dcu1_S1_T,DDUC_DCU1EmHdler_S1_T);
This code is used to assign to "AssignDOORStatus" 0 or 1 depending on variable "DDUC_ComSta_Dcux_x " and then, when "DDUC_DCUxEmHdler_x " is true, it flips "AssignDOORStatus" value from "0 or 1" to 10, using timer.
I have to call in POU many times this function.
Thanks in advance!
Functions have no memory. Therefore all variables declared inside VAR are temporary and are reset to their default for each new call.
FunctionBlocks/Programs have memory. Therefore all variables declared inside VAR remain their values between each call.
That's why you should not use a function, which will forget everything between each call from MAIN. For instance the timer will be reset from the previous call.
Instead you should write a function block (or FB), which can be re-used for the several doors you want to handle. Inside the function block will be a set of variables (especially the timer), which will be unique for each instance and also be remembered from call to call.
The above is a very short description so you should really look up the function block in your compilers help file to get a proper explanation, e.g. for input/output parameters.
Below is my suggestion for a program that uses the same FB for three different door instances:
(The FB, first the declaration and then it's code)
FUNCTION_BLOCK FB_AssignDOORStatus
VAR_INPUT
DDUC_ComSta_Dcux_x: BOOL; //No communication
DDUC_DCUxEmHdler_x: BOOL; //Emergency handler
END_VAR
VAR_OUTPUT
AssignDoorStatus: USINT;
END_VAR
VAR
Timer: TP; //Timer to do intermittence between current doors status and emergency handler
CurrentDoorStatus: USINT;
TONProcessTime: TIME := T#1S; //TONProcesTime
END_VAR
----------
IF DDUC_ComSta_Dcux_x THEN
CurrentDoorStatus := 0;
ELSE
CurrentDoorStatus := 1;
END_IF
IF DDUC_DCUxEmHdler_x THEN
Timer(IN := NOT Timer.Q, PT := TONProcessTime); //Timer starts
Timer();
IF Timer.Q THEN //When TONProcessTime has gone by
IF AssignDOORStatus <> CurrentDoorStatus THEN
AssignDOORStatus := CurrentDoorStatus;
ELSE
AssignDOORStatus := 10;
END_IF
END_IF
ELSE
AssignDOORStatus := CurrentDoorStatus;
END_IF
(MAIN, first the declaration and then it's code)
PROGRAM MAIN
VAR
// You must make an instance of your function block(s). This instance will live from call to call.
fbAssignDOORStatus_1: FB_AssignDOORStatus;
fbAssignDOORStatus_2: FB_AssignDOORStatus;
fbAssignDOORStatus_3: FB_AssignDOORStatus;
// ...
// Better to use an array to hold the many FB instances needed...
// You could use a for loop in the MAIN program to call all the instances.
// Test variables to hand to the fb's during runtime.
ComSta: BOOL;
EmHdler: BOOL;
TestDoor1, TestDoor2, TestDoor3: USINT;
// Here you could also use an array or re-use some common variable...
END_VAR
----------
fbAssignDOORStatus_1(
DDUC_ComSta_Dcux_x := ComSta,
DDUC_DCUxEmHdler_x := FALSE,
AssignDoorStatus => TestDoor1);
fbAssignDOORStatus_2(
DDUC_ComSta_Dcux_x := TRUE,
DDUC_DCUxEmHdler_x := EmHdler,
AssignDoorStatus => TestDoor2);
fbAssignDOORStatus_3(
DDUC_ComSta_Dcux_x := ComSta,
DDUC_DCUxEmHdler_x := EmHdler,
AssignDoorStatus => TestDoor3);
I am trying to use the DSiGetHtmlFormatFromClipboard function from the well known DSiWin32 library.
Edit: There is a much newer version of DSIWin32.pas 1.94 from 2016-10-19 which is contained in the current version of OmniThreadLibrary_3.07.1. The one I've linked to in the first line of my question is much older: 1.66 from 2012-04-20. However, also in this newer version of DSIWin32.pas the function DSiGetHtmlFormatFromClipboard does not work although I've made sure that no other clipboard programs are running.
So I put some text on the clipboard which includes the HTML format e.g. by copying some text from Chrome web-browser.
And then I use this code to get the HTML format from the clipboard:
if DSiWin32.DSiIsHtmlFormatOnClipboard then
begin
CodeSite.Send('HTML-Format string:', DSiWin32.DSiGetHtmlFormatFromClipboard);
end;
While the DSiIsHtmlFormatOnClipboard function does work (it gives back True if there is HTML Format on the clipboard and gives back False if there is no HTML Format on the clipboard), the DSiGetHtmlFormatFromClipboard function always gives back an empty string although there is HTML Format in the clipboard:
So I debugged function DSiGetHtmlFormatFromClipboard: string; in DSiWin32.pas:
On this line:
hClipData := GetClipboardData(GCF_HTML);
hClipData is always 0, so the following code is not executed.
GetClipboardData is a function from Winapi.Windows and according to MSDN documentation:
Retrieves data from the clipboard in a specified format. The clipboard
must have been opened previously.
Which is the case in the DSiWin32 code.
So why does the DSiGetHtmlFormatFromClipboard always give back an empty string?
OS: Windows 7 x64
GetLastError retrieved immediately after the line hClipData := GetClipboardData(GCF_HTML);:
ERROR_CLIPBOARD_NOT_OPEN 1418 (0x58A) Thread does not have a
clipboard open.
This is strange because the preceding line is: Win32Check(OpenClipboard(0)); and it does not fail.
Here is the relevant parts of the MCVE:
var
GCF_HTML: UINT;
function DSiIsHtmlFormatOnClipboard: boolean;
begin
Result := IsClipboardFormatAvailable(GCF_HTML);
end; { DSiIsHtmlFormatOnClipboard }
function DSiGetHtmlFormatFromClipboard: string;
var
hClipData : THandle;
idxEndFragment : integer;
idxStartFragment: integer;
pClipData : PChar;
begin
Result := '';
if DSiIsHtmlFormatOnClipboard then
begin
Win32Check(OpenClipboard(0));
try
hClipData := GetClipboardData(GCF_HTML);
if hClipData = 0 then
RaiseLastOSError;
pClipData := GlobalLock(hClipData);
Win32Check(assigned(pClipData));
try
idxStartFragment := Pos('<!--StartFragment-->', pClipData); // len = 20
idxEndFragment := Pos('<!--EndFragment-->', pClipData);
if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then
Result := Copy(pClipData, idxStartFragment + 20, idxEndFragment - idxStartFragment - 20);
finally GlobalUnlock(hClipData); end;
finally Win32Check(CloseClipboard); end;
end;
end; { DSiGetHtmlFormatFromClipboard }
procedure TForm1.Button1Click(Sender: TObject);
begin
if DSiIsHtmlFormatOnClipboard then
ShowMessage(DSiGetHtmlFormatFromClipboard)
else
ShowMessage('No HTML Format on Clipboard');
end;
initialization
GCF_HTML := RegisterClipboardFormat('HTML Format');
end.
This is my first time on this site. Usually, I have no problem to found replies in the old posts but I don't success with my actual problem.
I would like to know how use RTTI functions to know at running time the properties/members of a record under Lazarus/FPC? I know how to do it for a class (Tpersistent descendant and published properties) but not for FPC. Some links indicates how to do it under Delphi (From D2010), but I don't know how to transpose it under Lazarus.
Thanks in advance for help and assistance.
Salim Larhrib.
To kevin : As I told before, this is my first demand. But I understand. You are right. This is my code
procedure TMainForm.btRecordTHashListClick(Sender: TObject);
var
pTData : PTypeData;
pTInfo : PTypeInfo;
TablePtr : PatableRecord;
Loop : Integer;
begin
// Set of Record pointers + HashList
// Create Container
if not Assigned(FTableRecList) then FTableRecList := TFPHashList.Create;
// Insert data
new(TablePtr);
TablePtr^.description := 'Dictionnaire des tables.';
FTableRecList.add('atable', TablePtr );
new(TablePtr);
TablePtr^.description := 'Dictionnaire des fonctions.';
FTableRecList.add('afunction', TablePtr );
new(TablePtr);
TablePtr^.description := 'Dictionnaire des listes d''option.';
FTableRecList.add('alist', TablePtr );
// Read records
for Loop:=0 to FTableRecList.Count-1 do
begin
TablePtr := FTableRecList[Loop];
ShowMessage('Parcours Index : ' + TablePtr^.description);
end;
// Find records
try
TablePtr := FTableRecList.Find('ddafunction');
ShowMessage('Record finded : ' + TablePtr^.description);
except
ShowMessage('Not such record .');
end;
try
TablePtr := FTableRecList.Find('afunction');
ShowMessage('Record finded : ' + TablePtr^.description);
except
ShowMessage('No such record.');
end;
// Free memory : To put later in TFPHashList wrapper
for Loop:=0 to FTableRecList.Count-1 do Dispose(PatableRecord(FTableRecList[Loop]));
// RTTI
pTInfo := TypeInfo(TatableRecord);
pTData := GetTypeData(pTInfo);
ShowMessage('Member count = '+IntToStr(pTData^.PropCount));
end;
WARNING: It works with FPC 2.7.1 or later.
You can deal with record fields using pointers. Here is example:
program rttitest;
uses
TypInfo;
type
TMyRec = record
p1: Integer;
p2: string;
end;
var
td: PTypeData;
ti: PTypeInfo;
mf: PManagedField;
p: Pointer;
f: Pointer;
r: TMyRec;
begin
r.p1 := 312;
r.p2 := 'foo-bar';
ti := TypeInfo(r);
td := GetTypeData(ti);
Writeln(td^.ManagedFldCount); // Get count of record fields
// After ManagedFldCount TTypeData contains list of the TManagedField records
// So ...
p := #(td^.ManagedFldCount); // Point to the ManagedFldCount ...
// Inc(p, SizeOf(Integer)); // Skip it (Wrong for 64-bit targets)
// Next line works for both
Inc(p, SizeOf(td^.ManagedFldCount)); // Skip it
mf := p; // And now in the mf we have data about first record's field
Writeln(mf^.TypeRef^.Name);
Write(r.p1); // Current value
f := #r;
Inc(f, mf^.FldOffset); // Point to the first field
Integer(f^) := 645; // Set field value
Writeln(r.p1); // New value
// Repeat for the second field
Inc(p, SizeOf(TManagedField));
mf := p;
Writeln(mf^.TypeRef^.Name);
Write(r.p2);
f := #r;
Inc(f, mf^.FldOffset);
string(f^) := 'abrakadabra';
Writeln(r.p2);
Readln;
end.
I need to go through a HTML string and replace characters with 0 (zero), except tags, spaces and line breaks. I created this code bellow, but it is too slow. Please, can someone help me to make it faster (optimize)?
procedure TForm1.btn1Click(Sender: TObject);
var
Txt: String;
Idx: Integer;
Tag: Boolean;
begin
Tag := False;
Txt := mem1.Text;
For Idx := 0 to Length(Txt) - 1 Do
Begin
If (Txt[Idx] = '<') Then
Tag := True Else
If (Txt[Idx] = '>') Then
Begin
Tag := False;
Continue;
end;
If Tag Then Continue;
If (not (Txt[Idx] in [#10, #13, #32])) Then
Txt[Idx] := '0';
end;
mem2.Text := Txt;
end;
The HTML text will never have "<" or ">" outside tags (in the middle of text), so I do not need to worry about this.
Thank you!
That looks pretty straightforward. It's hard to be sure without profiling the code against the data you're using, (which is always a good idea; if you need to optimize Delphi code, try running it through Sampling Profiler first to get an idea where you're actually spending all your time,) but if I had to make an educated guess, I'd guess that your bottleneck is in this line:
Txt[Idx] := '0';
As part of the compiler's guarantee of safe copy-on-write semantics for the string type, every write to an individual element (character) of a string involves a hidden call to the UniqueString routine. This makes sure that you're not changing a string that something else, somewhere else, holds a reference to.
In this particular case, that's not necessary, because you got the string fresh in the start of this routine and you know it's unique. There's a way around it, if you're careful.
CLEAR AND UNAMBIGUOUS WARNING: Do not do what I'm about to explain without making sure you have a unique string first! The easiest way to accomplish this is to call UniqueString manually. Also, do not do anything during the loop that could assign this string to any other variable. While we're doing this, it's not being treated as a normal string. Failure to heed this warning can cause data corruption.
OK, now that that's been explained, you can use a pointer to access the characters of the string directly, and get around the compiler's safeguards, like so:
procedure TForm1.btn1Click(Sender: TObject);
var
Txt: String;
Idx: Integer;
Tag: Boolean;
current: PChar; //pointer to a character
begin
Tag := False;
Txt := mem1.Text;
UniqueString(txt); //very important
if length(txt) = 0 then
Exit; //If you don't check this, the next line will raise an AV on a blank string
current := #txt[1];
dec(current); //you need to start before element 1, but the compiler won't let you
//assign to element 0
For Idx := 0 to Length(Txt) - 1 Do
Begin
inc(current); //put this at the top of the loop, to handle Continue cases correctly
If (current^ = '<') Then
Tag := True Else
If (current^ = '>') Then
Begin
Tag := False;
Continue;
end;
If Tag Then Continue;
If (not (current^ in [#10, #13, #32])) Then
current^ := '0';
end;
mem2.Text := Txt;
end;
This changes the metaphor. Instead of indexing into the string as an array, we're treating it like a tape, with the pointer as the head, moving forward one character at a time, scanning from beginning to end, and changing the character under it when appropriate. No redundant calls to UniqueString, and no repeatedly calculating offsets, which means this can be a lot faster.
Be very careful when using pointers like this. The compiler's safety checks are there for a good reason, and using pointers steps outside of them. But sometimes, they can really help speed things up in your code. And again, profile before trying anything like this. Make sure that you know what's slowing things down, instead of just thinking you know. If it turns out to be something else that's running slow, don't do this; find a solution to the real problem instead.
Edit: Looks like I was wrong - UniqueString is not the problem. The actual bottleneck seems to be accessing the string by character. Given that my entire answer was irrelevent, I've completely replaced it.
If you use a PChar to avoid recalculating the string offset, while still updating the string via Txt[Idx], the method is much faster (5 seconds down to 0.5 seconds in my test of 1000 runs).
Here's my version:
procedure TForm1.btn1Click(Sender: TObject);
var
Idx: Integer;
Tag: Boolean;
p : PChar;
Txt : string;
begin
Tag := False;
Txt := Mem1.Text;
p := PChar(txt);
Dec(p);
For Idx := 0 to Length(Txt) - 1 Do
Begin
Inc(p);
If (not Tag and (p^ = '<')) Then begin
Tag := True;
Continue;
end
Else If (Tag and (p^ = '>')) Then
Begin
Tag := False;
Continue;
end;
If Tag Then Continue;
If (not (p^ in [#10, #13, #32])) Then begin
Txt[Idx] := '0';
end;
end;
mem2.Text := Txt;
end;
I did some profiling and came up with this solution.
A test for > #32 instead of [#10,#13,#32] gains some speed (thanks #DavidHeffernan).
A better logic in the loop also gives a bit extra speed.
Accessing the string exclusively with the help of a PChar is more effective.
procedure TransformHTML( var Txt : String);
var
IterCnt : Integer;
PTxt : PChar;
tag : Boolean;
begin
PTxt := PChar(Txt);
Dec(PTxt);
tag := false;
for IterCnt := 0 to Length(Txt)-1 do
begin
Inc(PTxt);
if (PTxt^ = '<') then
tag := true
else
if (PTxt^ = '>') then
tag := false
else
if (not tag) and (PTxt^ > #32) then
PTxt^ := '0';
end;
end;
This solution is about 30% more effective than Mason's solution and 2.5 times more effective than Blorgbeard's.