How to split StringList in Lazarus - lazarus

I have big problem with StringList. I have text file with text like this:
51,179 km=Powiat Ostrzeszowski
51,179 - 61,402 km=Powiat Wieruszowski
61,402 - 64,559 km (d. DW450)=Powiat Wieruszowski
64,559 km (d. DW450)=Powiat Kępiński
I want to import this file and show first values, before "=" in RadioGroup. Second values after "=" i want to show on Label in moment when user clicks proper value on RadioGroup.
I would like to operate on Names and Values of StrongList.
Something like this: https://i.stack.imgur.com/dkLih.png
In *.pas file I have:
var
Form1: TForm1;
list: TStringList;
i: Integer;
On FormCreate:
list := TStringList.Create;
list.LoadFromFile('dat\a1pik.dat');
RadioGroup1.Visible := true;
RadioGroup1.Items.Clear;
for i := 0 to list.Count-1 do
begin
RadioGroup1.Items.Add(list.Names[i]);
end;
And first values I have on RadioGroup.
I try with RadioGroup like this:
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
Label.Caption := list.Values[list.Names[RadioGroup1.ItemIndex]];
end;
But doesn't work. What I do wrong?
P.S. Sorry for my English :)

Related

Sorting TObjectList<T> swaps equal values [duplicate]

This question already has an answer here:
How Can I Replace StringList.Sort with a Stable Sort in Delphi?
(1 answer)
Closed 1 year ago.
I have the following (simplified) class definition:
TMyObject = class
private
FDoubleValue: Double;
FText: string;
protected
public
constructor Create(ADoubleValue: Double; AText: string);
property DoubleValue: Double read FDoubleValue write FDoubleValue;
property Text: string read FText write FText;
end;
The following sample code, shows how I am sorting the TObjectList<TMyObject> (FMyObjects) and displaying them in a TListBox.
constructor TfrmMain.Create(AOwner: TComponent);
begin
inherited;
FMyObjects := TObjectList<TMyObject>.Create;
FMyObjects.OwnsObjects := true; // Default but for clarity
end;
destructor TfrmMain.Destroy;
begin
FMyObjects.Free;
inherited;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var
ii: Integer;
begin
FMyObjects.Add(TMyObject.Create(100.00, 'Item 1'));
FMyObjects.Add(TMyObject.Create(200.00, 'Item 2'));
FMyObjects.Add(TMyObject.Create(300.00, 'Item 3')); // Duplicate sort value
FMyObjects.Add(TMyObject.Create(300.00, 'Item 4')); // Duplicate sort value
FMyObjects.Add(TMyObject.Create(400.00, 'Item 5'));
ObjectsToListBox;
end;
procedure TfrmMain.SortList;
var
Comparer: IComparer<TMyObject>;
begin
Comparer := TDelegatedComparer<TMyObject>.Create(
function(const MyObject1, MyObject2: TMyObject): Integer
begin
result := CompareValue(MyObject1.DoubleValue, MyObject2.DoubleValue, 0);
end);
FMyObjects.Sort(Comparer);
end;
procedure TfrmMain.ObjectsToListBox;
var
ii: Integer;
begin
ListBox1.Items.Clear;
for ii := 0 to FMyObjects.Count - 1 do
ListBox1.Items.Add(Format('%d - %.1f - %s', [ii, FMyObjects[ii].DoubleValue,
FMyObjects[ii].Text]));
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
SortList;
ObjectsToListBox;
end;
Every time Button1 is clicked (and the list sorted), FMyObjects[2] (Item3) and FMyObjects[3] ('Item4') swap position in the list. In my "real world" (drawing) application this is undesirable.
I also experimented with different values for Epsilon in the CompareValue function call and also a different implementation of the anonymous function (comparing values and returning 1, -1 or 0), but neither seems to make a difference.
Am I missing something (e.g. a property that controls this behavior) or is this "by design" and it cannot be prevented?
This is by design. The internally used Quicksort implementation is not a stable one, so reorder of equal items is expected. To make the sort stable you need to extend your comparer to take that into account. F.i. you can compare the Text properties when the DoubleValue properties are equal.

How to dislay correct x-axis (bottom axis) label from datasource using Teechart (Delphi)

I would like to ask some help on displaying my datasource’s clientname at the bottom of my stacked bar chart. It seems from all the examples that I researched, the bottom chart axis label is set "automatically" by TeeChart looking at the datasource. However I cant seem to get it to work. Below is a picture of what I am trying to achieve.
Picture of what I am trying to achieve
I have three series' which I use to build the stacked chart. I have included a picture of each datasource I use for each query.
Datasources for three series' queries
From my research it seems I can also use the DBChart1GetAxisLabel() to custom set the labels. But I am struggling to understand how to ensure that the correct custom label name is associated with the correct "clientname" from my queries.
Here is a code sample of how I build the charts:
procedure TfrmSupplierAnalytics.btnOKClick(Sender: TObject);
var
S,NewTypeStr, test, clientSql : string;
var seriasNormalOrders:TBarSeries;
var seriasCreditNoteOrders:TBarSeries;
var seriasPartialOrders:TBarSeries;
N, i : integer;
begin
qCreditNoteOrders.Close;
qNormalOrders.Close;
qPartialOrders.Close;
qGetClientIdFromName.Close;
qClients.Close;
DBChart1.CleanupInstance;
DBChart1.ClearChart;
try
for N := 0 to clbClients.Items.Count-1 do
if clbClients.State[N] = cbChecked then begin
test := string(clbClients.Items[N]);
NewTypeStr := NewTypeStr + '(E.clientid = '+
IntToStr(FindClientID(test)) + ')';
clientSql := clientSql + NewTypeStr;
NewTypeStr := ' or ';
end;
except
on E : Exception do
ShowMessage(E.ClassName+' error raised, with message :
'+E.Message);
end;
OpenQueryCreditNoteOrders(clientSql);
OpenQueryPartialOrders(clientSql);
OpenQueryNormalOrders(clientSql);
seriasNormalOrders :=TBarSeries.Create(self);
DBChart1.AddSeries(seriasNormalOrders);
seriasCreditNoteOrders :=TBarSeries.Create(self);
DBChart1.AddSeries(seriasCreditNoteOrders);
seriasPartialOrders :=TBarSeries.Create(self);
DBChart1.AddSeries(seriasPartialOrders);
seriasNormalOrders.MultiBar := mbStacked;
seriasCreditNoteOrders.MultiBar := mbStacked;
seriasPartialOrders.MultiBar := mbStacked;
seriasNormalOrders.Marks.Visible := true;
seriasNormalOrders.MarksLocation:= mlCenter;
seriasNormalOrders.MarksOnBar := True;
seriasNormalOrders.YValues.ValueSource := 'NormalOrders';
seriasNormalOrders.DataSource := qNormalOrders;
seriasNormalOrders.Title := 'Correct Orders';
seriasNormalOrders.Marks.Visible := True;
seriasNormalOrders.Marks.AutoPosition := true;
seriasCreditNoteOrders.YValues.ValueSource := 'CreditNoteOrders';
seriasCreditNoteOrders.DataSource := qCreditNoteOrders;
seriasCreditNoteOrders.Title := 'Credit Note Orders';
seriasPartialOrders.YValues.ValueSource := 'PartialOrders';
seriasPartialOrders.DataSource := qPartialOrders;
seriasPartialOrders.Title := 'Short Orders';
seriasNormalOrders.CheckDataSource;
seriasCreditNoteOrders.CheckDataSource;
seriasPartialOrders.CheckDataSource;
end;
So, just to sum up, is there some setting in my code which I am missing that would show the "clientname" below each stacked bar, or must I use custom labels?
If I must use custom labels, I would appreciate some direction on how to ensure that I replace the correct "clientname" from the datasource to the correct ValueIndex in the DBChart1GetAxisLabel?
Thanks in advance.
I managed to get an answer.
You could set the XLabelsSource to show the text from the DataSource and then set the series Marks.Style to smsValue to force it showing values instead of showing the labels. Ie:
<pre>
procedure TForm1.FormCreate(Sender: TObject);
var ADOQuery1: TADOQuery;
i: Integer;
begin
ADOQuery1:=TADOQuery.Create(Self);
with ADOQuery1 do
begin
ConnectionString:='Provider=MSDASQL.1;Persist Security Info=False;Data
Source=TeeChart Pro Database';
SQL.Add('SELECT SALARY, LASTNAME from Employee WHERE LASTNAME='#39'Smith'#39);
end;
for i:=0 to 1 do
with DBChart1.AddSeries(TBarSeries) as TBarSeries do
begin
XLabelsSource:='LASTNAME';
DataSource:=ADOQuery1;
MultiBar:=mbStacked;
YValues.ValueSource:='SALARY';
Marks.Style:=smsValue;
end;
ADOQuery1.Open;
end;
</pre>
I tested it in my project and it works.

Delphi - Sort TList<TObject> based on the object's properties [duplicate]

I'm kinda a Delphi-newbie and I don't get how the Sort method of a TList of Records is called in order to sort the records by ascending integer value.
I have a record like the following:
type
TMyRecord = record
str1: string;
str2: string;
intVal: integer;
end;
And a generic list of such records:
TListMyRecord = TList<TMyRecord>;
Have tried to find a code-example in the help files and found this one:
MyList.Sort(#CompareNames);
Which I can't use, since it uses classes. So I tried to write my own compare function with a little different parameters:
function CompareIntVal(i1, i2: TMyRecord): Integer;
begin
Result := i1.intVal - i2.intVal;
end;
But the compiler always throws a 'not enough parameters' - error when I call it with open.Sort(CompareIntVal);, which seems obvious; so I tried to stay closer to the help file:
function SortKB(Item1, Item2: Pointer): Integer;
begin
Result:=PMyRecord(Item1)^.intVal - PMyRecord(Item2)^.intVal;
end;
with PMyRecord as PMyRecord = ^TMyRecord;
I have tried different ways of calling a function, always getting some error...
The Sort overload you should be using is this one:
procedure Sort(const AComparer: IComparer<TMyRecord>);
Now, you can create an IComparer<TMyRecord> by calling TComparer<TMyRecord>.Construct. Like this:
var
Comparison: TComparison<TMyRecord>;
....
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal-Right.intVal;
end;
List.Sort(TComparer<TMyRecord>.Construct(Comparison));
I've written the Comparison function as an anonymous method, but you could also use a plain old style non-OOP function, or a method of an object.
One potential problem with your comparison function is that you may suffer from integer overflow. So you could instead use the default integer comparer.
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := TComparer<Integer>.Default.Compare(Left.intVal, Right.intVal);
end;
It might be expensive to call TComparer<Integer>.Default repeatedly so you could store it away in a global variable:
var
IntegerComparer: IComparer<Integer>;
....
initialization
IntegerComparer := TComparer<Integer>.Default;
Another option to consider is to pass in the comparer when you create the list. If you only ever sort the list using this ordering then that's more convenient.
List := TList<TMyRecord>.Create(TComparer<TMyRecord>.Construct(Comparison));
And then you can sort the list with
List.Sort;
The concise answer:
uses
.. System.Generics.Defaults // Contains TComparer
myList.Sort(
TComparer<TMyRecord>.Construct(
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal - Right.intVal;
end
)
);
I want to share my solution (based on the input I have gathered here).
It's a standard setup. A filedata class that holds data of a single file in a generic TObjectList. The list has the two private attributes fCurrentSortedColumn and fCurrentSortAscending to control the sort order. The AsString-method is the path and filename combined.
function TFileList.SortByColumn(aColumn: TSortByColums): boolean;
var
Comparison: TComparison<TFileData>;
begin
result := false;
Comparison := nil;
case aColumn of
sbcUnsorted : ;
sbcPathAndName: begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcSize : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<int64>.Default.Compare(Left.Size,Right.Size);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcDate : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TDateTime>.Default.Compare(Left.Date,Right.Date);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcState : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TFileDataTestResults>.Default.Compare(Left.FileDataResult,Right.FileDataResult);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
end;
if assigned(Comparison) then
begin
Sort(TComparer<TFileData>.Construct(Comparison));
// Control the sort order
if fCurrentSortedColumn = aColumn then
fCurrentSortAscending := not fCurrentSortAscending
else begin
fCurrentSortedColumn := aColumn;
fCurrentSortAscending := true;
end;
if not fCurrentSortAscending then
Reverse;
result := true;
end;
end;
I found a much simpler modified sort function to alphabetize a TList of records or nonstandard list of items.
Example
PList = ^TContact;
TContact = record //Record for database of user contact records
firstname1 : string[20];
lastname1 : string[20];
phonemobile : Integer; //Fields in the database for contact info
phonehome : Integer;
street1 : string;
street2 : string;
type
TListSortCompare = function (Item1,
Item2: TContact): Integer;
var
Form1: TForm1;
Contact : PList; //declare record database for contacts
arecord : TContact;
Contacts : TList; //List for the Array of Contacts
function CompareNames(i1, i2: TContact): Integer;
begin
Result := CompareText(i1.lastname1, i2.lastname1) ;
end;
and the function to call to sort your list
Contacts.Sort(#CompareNames);

pass two difference arrays for same array

I was trying to use same printing procedure for two types of arrays(1st arry length was 10, 2nd array length was 15).
I could not find any solution over internet. Did any one have any solution for this problem.
this is the Two arrays
program pp1;
const
m=10;
n=15;
type
matrix1=array[1..m] of integer;
matrix2=array[1..n] of integer;
var
m1:matrix1;
m2:matrix2;
this is the method which it tried. in method 'x' mens the length of the array.
procedure writeMatrix(var data: array of integer ;x:integer);
var
j:integer;
begin
for j:=1 to x do
begin
write(data[j]:3);
end;
end;
my main method
begin
writeMatrix(m1,10);
writeMatrix(m2,10);
end.
How can i use the same this writeMatrix method to print both of the arrays.. Is there any stranded way to do it.
As I said in my comment before, your implementation is fine, but you have to put something in your matrix before printing it, or you will get a bunch of zeroes in the screen (in the best).
Try this:
program pp1;
const
m=10;
n=15;
type
matrix1=array[1..m] of integer;
matrix2=array[1..n] of integer;
var
m1:matrix1;
m2:matrix2;
procedure fillMatrix(var data:array of integer; x:integer);
var
j:integer;
begin
for j:= 1 to x do begin
data[j]:=j;
end;
end;
procedure writeMatrix(var data: array of integer; x:integer);
var
j:integer;
begin
for j:=1 to x do
begin
write(data[j]:3);
end;
end;
begin
fillMatrix(m1,10);
fillMatrix(m2,10);
writeMatrix(m1,10);
writeMatrix(m2,10);
readln;
readln;
end.
Hint: consider avoid using global variables, m1 and m2 in this case should be declared in the main program.
How can i use the same this writeMatrix method to print both of the arrays.. Is there any stranded way to do it.
Yes, there is a standard way to this. It is called conformant-array parameters. It is standardized in (level 1) of the ISO standard 7185 (Standard “Unextended” Pascal). It looks like this:
procedure print(protected matrix: array[
columnMinimum..columnMaximum: integer;
rowMinimum..rowMaximum: integer
] of integer);
const
totalWidth = 6;
var
x: type of columnMinimum;
y: type of rowMinimum;
begin
for y := rowMinimum to rowMaximum do
begin
for x := columnMinimum to columnMaximum do
begin
write(matrix[x, y]:totalWidth);
end;
writeLn;
end;
end;
It’s as if there were additional const values, but they are dynamic depending on the passed matrix. This code furthermore uses type inquiries (type of …) and the protected modifier, both defined in ISO 10206 (Extended Pascal) which builds on top of ISO 7185. In EP you could and would also consider schemata to pass such data as parameters.

Reading from text file into list in FreePascal

I have a text file including:
John###198cm###90kg###19age
Tom###120cm###34kg###8age
And I want to read them from file into two lists in FreePascal.
I have tried to use LoadFromFile function, which should make a line into list, but it is not working for me.
This is a variation of your question Reading from file FreePascal.
Here is an example using ReplaceStr() to convert the ### characters into a CR LF pair.
When assigned to the text property of a new list, it will be splitted into items.
Uses
StrUtils;
procedure HandleText;
var
i : Integer;
sSourceList : TStringList;
sExpandedList : TStringList;
begin
sSourceList := TStringList.Create;
sExpandedList := TStringList.Create;
try
sSourceList.LoadFromFile('MySource.txt');
for i := 0 to sSourceList.Count-1 do begin
sExpandedList.Text := ReplaceStr(sSourceList[i],'###',#13#10);
// Do something with your lists
// sExpandedList[0] = 'John' etc ...
end;
finally
sSourceList.Free;
sExpandedList.Free;
end;
end;

Resources