I'm trying to sort a TStringList in an especific order.
Instead of A,B,C.. I'm trying to order it in B,C,A.
I've declarated a const array with the order that I need.
I've tried with CustomSorte, but I can't understand how to write the function.
I'm trying with for loops now, but it is going really hard and confusing!
I'm not a Delphi Expert...
Thank you guys in advance!
From the help about the TStringListSortCompare function type:
Index1 and Index2 are indexes of the items in List to compare.
The callback returns:
a value less than 0 if the string identified by Index1 comes before the string identified by Index2
0 if the two strings are equivalent
a value greater than 0 if the string with Index1 comes after the string identified by Index2.
So if you subtract your custom order of the second item from the custom order of the first one, then the items will be sorted like you want.
const
Order: array[0..6] of String = ('B', 'C', 'A', 'D', 'G', 'F', 'E');
function GetStringOrder(const S: String; CaseSensitive: Boolean): Integer;
begin
for Result := 0 to Length(Order) - 1 do
if (CaseSensitive and (CompareStr(Order[Result], S) = 0)) or
(not CaseSensitive and (CompareText(Order[Result], S) = 0)) then
Exit;
Result := Length(Order);
end;
function MyCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := GetStringOrder(List[Index1], List.CaseSensitive) -
GetStringOrder(List[Index2], List.CaseSensitive);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
List: TStringList;
begin
List := TStringList.Create;
try
List.CommaText := 'A,G,a,C,B,b,F,a,B,C,c,D,d,E,D,F,G,C,A,G,d,e,f,g';
List.CaseSensitive := True;
List.CustomSort(MyCompareStrings);
ListBox1.Items.Assign(List);
finally
List.Free;
end;
end;
Related
I have a TStringList in Delphi.
after the items are inserted i call .sort procedure to sort the items.
the Items are first names followed by last names. for example: "John Smith".
I want to sort the items by last name. I mean by the first character after the space.
how can I do this?
and also the items may be unicode strings like persian characters.
I'd use the CustomSort method of TStringList to supply a custom compare function. First of all, let's imagine that we have already got the compare function:
function NameCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := ...;
end;
This function will (in due course) return negative to mean less than, positive to mean greater than and zero to mean equal.
Then we sort the list like this:
List.CustomSort(NameCompareFunc);
So, that's the easy bit done. But how do we implement NameCompareFunc? First of all let's split the name into last name and the rest.
procedure SplitName(const Name: string; out Last, Rest: string);
var
P: Integer;
begin
P := Pos(' ', Name);
if P = 0 then begin
Last := Trim(Name);
Rest := '';
end else begin
Last := Trim(Copy(Name, P+1, MaxInt));
Rest := Trim(Copy(Name, 1, P-1));
end;
end;
This is a pretty naive way to split a name. You'd probably want to search for separators starting from the end of the name, but I'll let you decide how to do that.
Now we can implement the compare function:
function NameCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
var
Last1, Last2, Rest1, Rest2: string;
begin
SplitName(List[Index1], Last1, Rest1);
SplitName(List[Index2], Last2, Rest2);
Result := AnsiCompareText(Last1, Last2);
if Result = 0 then begin
Result := AnsiCompareText(Rest1, Rest2);
end;
end;
Some notes:
I'm assuming that name comparison should always be case-insensitive.
We use AnsiCompareText to perform locale aware comparison.
If we encounter two names that have the same last name, then we implement a secondary comparison o the rest of the name.
You could use the CustomSort methos of Stringlist:
function LastNameCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
var
S1, S2: string;
SpaceIndex: Integer;
begin
S1 := List[Index1];
SpaceIndex := Pos(' ', S1);
if SpaceIndex <> 0 then
S1 := Copy(S1, 1, SpaceIndex - 1);
S2 := List[Index2];
SpaceIndex := Pos(' ', S2);
if SpaceIndex <> 0 then
S2 := Copy(S2, 1, SpaceIndex - 1);
if List.CaseSensitive then
Result := AnsiCompareStr(S1, S2)
else
Result := AnsiCompareText(S1, S2);
end;
procedure TForm7.ButtonFirstNameClick(Sender: TObject);
begin
NameBuffer.Sort;
Memo1.Lines.Assign(NameBuffer);
end;
procedure TForm7.ButtonLastNameClick(Sender: TObject);
begin
NameBuffer.CustomSort(#LastNameCompareStrings);
Memo1.Lines.Assign(NameBuffer);
end;
I my example I have all your names in a StringList called NameBuffer. Then I've added two buttons to a form where I sort mylist, and display the result on the Screen.
You could iterate through each item of your StringList (lets call it FullNames),
split each string and put the "splits" in two new separate stringlists which you could call
FirstNameList and LastNameList.
Now create a third stringlist which you can call ReverseFirstLast,
and combine the items from LastNameList with FirstNameList and put them in ReverseNames.
Now you have all names in reverse order. Last name first, and first name last.
You can now sort the ReverseFirstLast-list and do a split&combine method again to reverse orders again and maintain the sorting.
That is one way to do it to get a rough method up and running.
I have a TStringList of Name/Value pairs. The names are all integer values 9stored as strings of course) and the values are all strings (comma separated).
e.g.
5016=Catch the Fish!,honeyman,0
30686=Ozarktree1 Goes to town,ozarktreel,0
.
.
.
I would like to call the add routine and add new lines in the TStringlist, but need a way to sort the list afterwards.
e.g.
Tags.Add(frmTag.edtTagNo.Text + '=' +
frmTag.edtTitle.Text + ',' +
frmTag.edtCreator.Text + ',' +
IntToStr(ord(frmTag.cbxOwned.Checked)));
Tags.Sort;
Here is what I tried:
Tags:= TStringList.Create;
Tags.CustomSort(StringListSortComparefn);
Tags.Sorted:= True;
my custom sort routine:
function StringListSortComparefn(List: TStringList; Index1, Index2: Integer): Integer;
var
i1, i2 : Integer;
begin
i1 := StrToIntDef(List.Names[Index1], 0);
i2 := StrToIntDef(List.Names[Index2], 0);
Result:= CompareValue(i1, i2);
end;
However, it still seems to be sorting them like strings instead of integers.
I even tried creating my own class:
type
TXStringList = class(TStringList)
procedure Sort;override;
end;
implementation
function StringListSortComparefn(List: TStringList; Index1, Index2: Integer): Integer;
var
i1, i2 : Integer;
begin
i1 := StrToIntDef(List.Names[Index1], 0);
i2 := StrToIntDef(List.Names[Index2], 0);
Result:= CompareValue(i1, i2);
end;
procedure TXStringList.Sort;
begin
CustomSort(StringListSortComparefn);
end;
I even tried some examples on SO (e.g. Sorting TSTringList Names property as integers instead of strings)
Can someone tell me what I am doing wrong? Everytime, the list gets sorted as strings and not as integers.
30686=Ozarktree1 Goes to town,ozarktreel,0
5016=Catch the Fish!,honeyman,0
You can do a simple integer subtraction:
function StringListSortComparefn(List: TStringList; Index1, Index2: Integer): Integer;
var
i1, i2 : Integer;
begin
i1 := StrToIntDef(List.Names[Index1], 0);
i2 := StrToIntDef(List.Names[Index2], 0);
Result := i1 - i2
end;
To reverse the sort order, simply reverse the operands in the subtraction:
Result := i2 - i1;
Here's a quick, compiilable console example:
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes;
function StringListSortProc(List: TStringList; Index1, Index2: Integer): Integer;
var
i1, i2: Integer;
begin
i1 := StrToIntDef(List.Names[Index1], -1);
i2 := StrToIntDef(List.Names[Index2], -1);
Result := i1 - i2;
end;
var
SL: TStringList;
s: string;
begin
SL := TStringList.Create;
SL.Add('3456=Line 1');
SL.Add('345=Line 2');
SL.Add('123=Line 3');
SL.Add('59231=Line 4');
SL.Add('545=Line 5');
WriteLn('Before sort');
for s in SL do
WriteLn(#32#32 + s);
SL.CustomSort(StringListSortProc);
WriteLn('');
WriteLn('After sort');
for s in SL do
WriteLn(#32#32 + s);
ReadLn;
SL.Free;
end.
And the resulting output:
Before sort
3456=Line 1
345=Line 2
123=Line 3
59231=Line 4
545=Line 5
After sort
123=Line 3
345=Line 2
545=Line 5
3456=Line 1
59231=Line 4
The question is, do you require the list to remain sorted? Or is it sufficient to sort it at the end, after all the items have been added.
If you just need to be able to sort the list as needed, you're first example is almost correct. You just need to call CustomSort at the end, after your items have been added.
Tags := tStringList . Create;
Tags . Add ( '5016=Catch the Fish!,honeyman,0' );
Tags . Add ( '30686=Ozarktree1 Goes to town,ozarktreel,0' );
Tags.CustomSort(StringListSortComparefn);
If you need the list to stay sorted, then you need to override CompareStrings.
type
TXStringList = class(TStringList)
function CompareStrings(const S1, S2: string): Integer; override;
end;
function NumberOfNameValue ( const S : string ) : integer;
begin
Result := StrToIntDef(copy(S,1,pos('=',S)-1), 0);
end;
function txStringList . CompareStrings ( const S1, S2 : string ) : integer;
var
i1, i2 : Integer;
begin
i1 := NumberOfNameValue ( S1 );
i2 := NumberOfNameValue ( S2 );
Result:= CompareValue(i1, i2);
end;
begin
Tags := txstringlist . Create;
Tags . Sorted := true;
Tags . Add ( '5016=Catch the Fish!,honeyman,0' );
Tags . Add ( '30686=Ozarktree1 Goes to town,ozarktreel,0' );
// List will be correctly sorted at this point.
end;
The CustomSort command is a one-time operation. You appear to be using it as though you're setting a property so that further sorting will use the custom comparison function, but that's not really how it works. It sorts the (newly created, empty) list once. Then, when you set the Sorted property, you re-sort the list using the default comparison, and you specify that any further additions to the list should be inserted using that default sort order.
When you override the Sort method, you're a little closer to a solution, but insertions to a sorted list (where Sorted=True) do not actually call Sort! Instead, they perform a binary search for the correct insertion location and then insert there. Instead of overriding Sort, you could try overriding CompareStrings:
type
TXStringList = class(TStringList)
protected
function CompareStrings(const S1, S2: string): Integer; override;
end;
function TXStringList.CompareStrings(const S1, S2: string): Integer;
var
i1, i2, e1, e2: Integer;
begin
Val(S1, i1, e1);
Assert((e1 = 0) or (S1[e1] = NameValueSeparator));
Val(S2, i2, e2);
Assert((e2 = 0) or (S2[e2] = NameValueSeparator));
Result := CompareValue(i1, i2);
end;
Beware that this will break the IndexOf method, though. It might also break Find, but you might want that, depending on how you want to treat elements with the same numeric key. (Find is what's used to locate the correct insertion point of a sorted list, and with the above code, it would treat all elements with the same key as equal.) They all use CompareStrings just like Sort does.
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);
I have a huge list of users and every user has it's id , but it id numbers are messed up so if anyone can show me how can I sort users by numbers , every value has this form
1:Stackoverflow
or
145000:Google
If I do that manually I think I will lose my mind since tehere are more than 700000 records.Thanks for your time and help....
Extract the number like this:
function ID(const str: string): Integer;
var
p: Integer;
begin
p := Pos(':', str);
if p=0 then
raise Exception.CreateFmt('Invalid string format: %s', [str]);
Result := StrToInt(Copy(str, 1, p-1));
end;
Once you can extract the ID as an integer you can then write a compare function. Like this:
function CompareIDs(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := CompareValue(
ID(List[Index1]),
ID(List[Index2])
);
end;
CompareValue is an RTL function that returns -1, 0 or 1 depending on the relative values of the two operands.
Feed these building blocks into TStringList.CustomSort and your job is done.
MyStringList.CustomSort(CompareIDs);
I want to create a function that receive multiples strings as parameters.
Like the function printf("Hello %s",name); of C. but I don't want to pass a ready array, it wouldn't be readable.
Edit1.text:=lang('Hello');
Edit2.text:=lang('Welcome to {1} guest',place);
Edit3.text:=lang('Hi {1}, is your {2} time in {3}','Victor','first','Disney');
output should be:
Hello
Welcome to Disney guest
Hi Victor is your first time in Disney
how I create the function TForm1.lang(parameters:String):String;, I did a research, but I can't get it work.
I need to access the parameters[] and the parameters.length also.
I'm needing this to turn my App to multilang.
Here's an example function of how you can do this:
function TForm1.lang(s: String; params: array of String): String;
var
i: Integer;
begin
for i := 0 to High(params) do
begin
ShowMessage(params[i]);
end;
end;
Call it like this:
lang('My format string', ['this', 'that']);
or like this:
var
b: String;
begin
b := 'this';
lang('My format string', [b, 'that']);
end;
Not sure what you mean by not readable
DoSomething(['Param1','Param2']);
for
procedure DoSomething(args : Array of String);
Var
Index : Integer;
Begin
for index := Low(args) to High(args) Do
ShowMessage(args[Index]);
End;
Seems okay to me. Course if you want to call it from outside delphi then you have an issue.
Quick fix is just to pass in a delimited string and then user TStringList to split it.
You could write a wee function to do that, don't forget to free it when you are done.
All your three examples could be fixed by using SysUtils.Format:
Edit1.text := format('%s',['Hello']));
Edit1.text := format('Welcome to %s guest',[place]));
Edit1.text := format('Hi %s, is your %s time in %s',['Victor','first','Disney']));
Personally I think it's quite readable. If you can have what you need from a basic sysutils function, you should seriously consider doing that, rather than to write your own version. On the other hand, you may need more complex functionality that doesn't show in your question. If that's the case, I think paulsm4's suggestion of using a stringlist seems like a good way to go.
Delphi does not support CREATING functions withvararg-style parameters that work exactly like printf() does. It only supports CONSUMING such functions from external libraries. The closest Delphi comes to supporting the creation of functions with variable parameter lists is to use "open array" parameters, like what SysUtils.Format() uses.
As Tony mentions above, I also recommend using a deliminated string. Except, a little more than just deliminating, but using more of a parsing technique. If I understand right, this function you're making for formatting shall NOT include an array in the parameters, but technically, that doesn't mean we can't use arrays anywhere at all (arrays are very ideal to use for this scenario for fast performance).
This method will allow virtually anything to be passed in the parameters, including the deliminator, without affecting the output. The idea is to do A) Size of parameter string, B) Deliminator between size and parameter, and C) parameter string... And repeat...
const
MY_DELIM = '|'; //Define a deliminator
type
TStringArray = array of String;
/////////////////////////////////
//Convert an array of string to a single parsable string
// (Will be the first step before calling your format function)
function MakeParams(const Params: array of String): String;
var
X: Integer;
S: String;
begin
Result:= '';
for X:= 0 to Length(Params)-1 do begin
S:= Params[X];
Result:= Result + IntToStr(Length(S)) + MY_DELIM + S;
end;
end;
//Convert a single parsable string to an array of string
// (Will be called inside your format function to decode)
// This is more or less called parsing
function ExtractParams(const Params: String): TStringArray;
var
S: String; //Used for temporary parsing
T: String; //Used for copying temporary data from string
P: Integer; //Used for finding positions
C: Integer; //Used for keeping track of param count
Z: Integer; //Used for keeping track of parameter sizes
begin
S:= Params; //Because we'll be using 'Delete' command
C:= 0; //Set count to 0 to start
SetLength(Result, 0); //Prepare result array to 0 parameters
while Length(S) > 0 do begin //Do loop until nothing's left
P:= Pos(MY_DELIM, S); //Get position of next deliminator
if P > 1 then begin //If deliminator was found...
C:= C + 1; //We have a new parameter
SetLength(Result, C); //Set array length to new parameter count
T:= Copy(S, 1, P-1); //Get all text up to where deliminator was found
Delete(S, 1, P); //Delete what we just copied, including deliminator
Z:= StrToIntDef(T, 0); //Convert T:String to Z: Integer for size of parameter
T:= Copy(S, 1, Z); //Get all text up to 'Z' (size of parameter)
Delete(S, 1, Z); //Delete what we just copied
Result[C-1]:= T; //Assign the new parameter to end of array result
end else begin //If deliminator was NOT found...
S:= ''; //Clear S to exit loop (possible bad format if this happens)
end;
end;
end;
//Main formatting routine
function MyFormat(const Input: String; const Params: String): String;
var
A: TStringArray;
X: Integer;
S: String;
P: Integer;
R: String;
begin
R:= Input;
A:= ExtractParams(Params);
//At this point, A contains all the parameters parsed from 'Params'
for X:= 0 to Length(A)-1 do begin
S:= A[X];
P:= Pos('%s', R);
if P > 0 then begin
Delete(R, P, 2);
Insert(S, R, P);
end;
end;
Result:= R;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Pars: String;
begin
Pars:= MakeParams(['this', 'that', 'something else']);
Edit1.Text:= MyFormat('%s is %s but not %s', Pars);
end;
As you probably know, SysUtils.Format() implements "varargs" by using a set.
In your case, however, why not just pass a TStringList? The function will simply check "list.Count". Voila - you're done!