We help IT Professionals succeed at work.

Stringlist sorting by column position

Kapusta
Kapusta asked
on
I am using Delphi 3 and a TStringList...

How can I sort the string list based upon column position?  IOW, let's say I have 100 strings in the TStringList, and all 100 strings are 80 characters in lenght.  I want to sort the strings based upon the data found starting at column 32 through column 36.  I would need to do this in both ascending, and then later in descending order.  Can Delphi do this?  If so, how?
Comment
Watch Question

Commented:
Sure you use the customSort method. Then on your handler you just check the substrings.

GL
Mike

Commented:
Hi Kapusta,

Edey is right.

Here is a sample:

function ColumnSortAscending(List: TStringList; Index1, Index2: Integer): Integer;
var
  lsStr1, lsStr2: string;
begin
  // get the strings to compare
  lsStr1 := Copy(List[Index1], 32, 5);
  lsStr2 := Copy(List[Index2], 32, 5);
  Result := AnsiCompareText(Str1, Str2);  
end;

function ColumnSortDescending(List: TStringList; Index1, Index2: Integer): Integer;
var
  lsStr1, lsStr2: string;
begin
  // get the strings to compare
  lsStr1 := Copy(List[Index1], 32, 5);
  lsStr2 := Copy(List[Index2], 32, 5);
  Result := - AnsiCompareText(Str1, Str2);  
end;

Now you can use this routine as follows

MyStringList.CustomSort(ColumnSortDescending);

or

MyStringList.CustomSort(ColumnSortAscending);

Regards Jacco

Commented:
Oops the

Result := AnsiCompareText(Str1, Str2)

should read

Result := AnsiCompareText(lsStr1, lsStr2)

I better copy/paste from Delphi in the future.

Regards
CERTIFIED EXPERT

Commented:
Hi all,
As far as I remember there is no TStringList.CustomSort method in Delphi3.

Regards, Geo

Author

Commented:
>> there is no TStringList.CustomSort method in Delphi3.

You appear to be correct.  That would make all of the other proposed answers invalid.

Author

Commented:
>> Edey is right.

Not for Delphi 3 he's not.

Commented:
What version of D3 are you using?

GL
Mike

Author

Commented:
>> What version of D3 are you using?

I assume the latest:

08/05/1997  03:01a           2,045,888 DELPHI32.EXE

Author

Commented:
Or perhaps you mean Pro, Desktop or C/S?  If so, then it's Pro.

Commented:
Well then I guess your choices are:

1)Find a 3rd party TStringList sorter
2)Write your own. (the test proc has been written for you)
3)Assign the data to a TList & use it's (quick)sort method. i _know_ that's available in D3

GL
Mike

Author

Commented:
>> Assign the data to a TList & use it's (quick)sort method

But that doesn't allow me to sort based upon a certain section of the string, such as the characters from position 32 to 35.

Commented:
sure it does. you have to provide a function that gets two pointers & returns an integer. It's up to you to decide how those two pointers should be sorted related to each other.

GL
Mike

Commented:
Here is the class that should do the job. I hope it complies in D3, I think it should.

Regards Jacco

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;

  TSpecialStringList = class(TStringList)
  private
    procedure CustomSort(Compare: TStringListSortCompare);
    procedure QuickSort(L, R: Integer; SCompare: TStringListSortCompare);
  end;

implementation

procedure TSpecialStringList.QuickSort(L, R: Integer; SCompare: TStringListSortCompare);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := (L + R) shr 1;
    repeat
      while SCompare(Self, I, P) < 0 do Inc(I);
      while SCompare(Self, J, P) > 0 do Dec(J);
      if I <= J then
      begin
        Exchange(I, J);
        if P = I then
          P := J
        else if P = J then
          P := I;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSort(L, J, SCompare);
    L := I;
  until I >= R;
end;

procedure TSpecialStringList.CustomSort(Compare: TStringListSortCompare);
begin
  if not Sorted and (Count > 1) then
  begin
    BeginUpdate;
    Changing;
    QuickSort(0, Count - 1, Compare);
    Changed;
    EndUpdate;
  end;
end;

end.

Author

Commented:
>> Here is the class that should do the job.  <<

Unfortunately I do not know how to utilize your code.  I do not understand how to call these functions.   Calling the functions thusly do not work:

var
Item : TStringList;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 SpecialStringList.QuickSort(1, 5, Item);
 TSpecialStringList.QuickSort(1, 5, Item);
 QuickSort(1,5, Item);
end;

None of the above 3 will compile after I insert your above code into my D3 application.
Commented:
You should utilize it like this:

var
  List: TSpecialStringList;

function ColumnSortAscending(List: TStringList; Index1, Index2: Integer): Integer;
var
 lsStr1, lsStr2: string;
begin
 // get the strings to compare
 // this will sort the list from the 10th to 15th col
 lsStr1 := Copy(List[Index1], 10, 5);
 lsStr2 := Copy(List[Index2], 10, 5);
 Result := AnsiCompareText(Str1, Str2);  
end;

procedure TForm1.Button1Click;
begin
  // create the list
  List := TSpecialStringList.Create;
  // fill the list
  List.Add('this is one string');
  List.Add('now this is the second one');
  List.Add('this is another string');
  List.Add('now this is the third one');
  // sort the list
  List.CustomSort(ColumnSortAscending);
  // output result
  Memo1.Lines.Assign(List);
  // free the list
  List.Free;
end;

Hope this helps.

Regards Jacco

Author

Commented:
Thanks for the example, however you have an error in your code, at line "Result := AnsiCompareText(Str1, Str2);"

Also, part of my original question was regarding DESCENDING sorting.  Your example only shows AScending.
ADMINISTRATION WILL BE CONTACTING YOU SHORTLY.  Moderators Computer101 or Netminder will return to finalize these if still open in seven days.  Please post closing recommendations before that time.

Question(s) below appears to have been abandoned. Your options are:
 
1. Accept a Comment As Answer (use the button next to the Expert's name).
2. Close the question if the information was not useful to you, but may help others. You must tell the participants why you wish to do this, and allow for Expert response.  This choice will include a refund to you, and will move this question to our PAQ (Previously Asked Question) database.  If you found information outside this question thread, please add it.
3. Ask Community Support to help split points between participating experts, or just comment here with details and we'll respond with the process.
4. Delete the question (if it has no potential value for others).
   --> Post comments for expert of your intention to delete and why
   --> YOU CANNOT DELETE A QUESTION with comments; special handling by a Moderator is required.

For special handling needs, please post a zero point question in the link below and include the URL (question QID/link) that it regards with details.
http://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
 
Please click this link for Help Desk, Guidelines/Member Agreement and the Question/Answer process.  http://www.experts-exchange.com/jsp/cmtyHelpDesk.jsp

Click you Member Profile to view your question history and keep them updated as the collaboration effort continues, to maintain your open and locked questions.  If you are a  KnowledgePro user, use the Power Search option to find them.  Anytime you have questions which are LOCKED with a Proposed Answer which does not serve your needs, please reject it and add comments as to why.  In addition, when you do grade the question, if the grade is less than an A, please add a comment as to why.  This helps all involved, as well as future persons who may access this item for help.

To view your open questions, please click the following link(s) and keep them all current with updates.
http://www.experts-exchange.com/questions/Q.20131737.html
http://www.experts-exchange.com/questions/Q.20191758.html


To view your locked questions, please click the following link(s) and evaluate the proposed answer.
http://www.experts-exchange.com/questions/Q.20271372.html

**** PLEASE DO NOT AWARD THE POINTS TO ME. *****
 
------------>  EXPERTS:  Please leave your closing recommendations if this item remains inactive another seven (7) days.  If you are interested in the cleanup effort, please click this link http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=commspt&qid=20274643 
POINTS FOR EXPERTS awaiting comments are listed here -> http://www.experts-exchange.com/commspt/Q.20277028.html
 

Moderators will finalize this question if still open in @7 days, by either moving this to the PAQ (Previously Asked Questions) at zero points, deleting it or awarding expert(s) when recommendations are made, or an independent determination can be made.  Expert input is always appreciated to determine the fair outcome.
 
Thank you everyone.
 
Moondancer
Moderator @ Experts Exchange

Author

Commented:
The expert did not fully answer my question, but it appears that the administrator want to close this question, so I have awarded the points albeit reluctantly.
Kapusta.  In the event the participating expert or experts return here to complete this journey with you to get the last piece of the puzzle solved, let me know... I can change the grade and make adjustments (as needed).

Your last comment to them in November was:
 From: Kapusta  Date: 11/03/2001 09:25AM PST  
Thanks for the example, however you have an error in your code, at line "Result := AnsiCompareText(Str1,
Str2);"

Also, part of my original question was regarding DESCENDING sorting.  Your example only shows AScending.

If something further transpires here, please let me know in Community Support, as you did in the other question.

Thanks all,
Moondancer - EE Moderator
 

Commented:
Hi Kapusta and Moondancer

I am sorry that I couldn't finish the exploration. It is never my intention to abandon a question! I did't get Email notifications for a while.

Here is the final code for the problem. (I don't have D3 so there might be some small problem). My Email notification works now, so if there is a problem let me know. Maybe you solved the problem some other way or the solution has become of no use to you any more. But for completeness I worked on the code for a while longer.

It is now a complete working (tested) sample.

I hope you can reconsider my grade... I do not get C's very often.

Regards Jacco

*** start of code ***
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TSpecialStringList = class;
 
  TSpecialStringListSortCompare = function(aList: TSpecialStringList; aIndex1, aIndex2: Integer): Integer;

  TSpecialStringList = class(TStringList)
  private
    fStartCol: Integer;
    fLength: Integer;
    fSortDescending: Boolean;
  protected
    procedure CustomSort(Compare: TSpecialStringListSortCompare; aStartCol, aLength: Integer; aDescending: Boolean); virtual;
    procedure QuickSort(L, R: Integer; SCompare: TSpecialStringListSortCompare); virtual;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    A1_10: TButton;
    A11_20: TButton;
    A21_30: TButton;
    D1_10: TButton;
    D11_20: TButton;
    D21_30: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure A1_10Click(Sender: TObject);
    procedure A11_20Click(Sender: TObject);
    procedure A21_30Click(Sender: TObject);
    procedure D1_10Click(Sender: TObject);
    procedure D11_20Click(Sender: TObject);
    procedure D21_30Click(Sender: TObject);
  private
    fList: TSpecialStringList;
  public
    { Public declarations }
    procedure SortMemo(aStartCol, aLength: Integer; aDescending: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TSpecialStringList }

procedure TSpecialStringList.QuickSort(L, R: Integer; SCompare: TSpecialStringListSortCompare);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := (L + R) shr 1;
    repeat
      while SCompare(Self, I, P) < 0 do Inc(I);
      while SCompare(Self, J, P) > 0 do Dec(J);
      if I <= J then
      begin
        Exchange(I, J);
        if P = I then
          P := J
        else if P = J then
          P := I;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSort(L, J, SCompare);
    L := I;
  until I >= R;
end;

procedure TSpecialStringList.CustomSort(Compare: TSpecialStringListSortCompare; aStartCol, aLength: Integer; aDescending: Boolean);
begin
  fStartCol := aStartCol;
  fLength := aLength;
  fSortDescending := aDescending;
  if not Sorted and (Count > 1) then
  begin
    BeginUpdate;
    Changing;
    QuickSort(0, Count - 1, Compare);
    Changed;
    EndUpdate;
  end;
end;

function ColumnSort(List: TSpecialStringList; Index1, Index2: Integer): Integer;
var
 lsStr1, lsStr2: string;
begin
 // get the strings to compare
 lsStr1 := Copy(List[Index1], List.fStartCol, List.fLength);
 lsStr2 := Copy(List[Index2], List.fStartCol, List.fLength);
 Result := AnsiCompareText(lsStr1, lsStr2);
 if List.fSortDescending then
   Result := - Result;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fList := TSpecialStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  fList.Free;
end;

procedure TForm1.SortMemo(aStartCol, aLength: Integer; aDescending: Boolean);
begin
 with fList do
 begin
   // clear the list
   fList.Clear;
   // fill the list
   fList.AddStrings(Memo1.Lines);
   // sort the list Ascending
   fList.CustomSort(ColumnSort, aStartCol, aLength, aDescending);
   // output result
   Memo2.Lines.Assign(fList);
 end
end;

procedure TForm1.A1_10Click(Sender: TObject);
begin
  SortMemo(1, 10, False);
end;

procedure TForm1.A11_20Click(Sender: TObject);
begin
  SortMemo(11, 10, False);
end;

procedure TForm1.A21_30Click(Sender: TObject);
begin
  SortMemo(21, 10, False);
end;

procedure TForm1.D1_10Click(Sender: TObject);
begin
  SortMemo(1, 10, True);
end;

procedure TForm1.D11_20Click(Sender: TObject);
begin
  SortMemo(11, 10, True);
end;

procedure TForm1.D21_30Click(Sender: TObject);
begin
  SortMemo(21, 10, True);
end;

end.

*** end of code ***

Commented:
Just for completeness here is the DFM that goes with the PAS

Remembere when opening the form you might get some property warnings. If you just ignore them everything should be all right.

Regards Jacco

*** start of DFM ***
object Form1: TForm1
  Left = 343
  Top = 199
  Width = 257
  Height = 352
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 8
    Top = 8
    Width = 233
    Height = 113
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Pitch = fpFixed
    Font.Style = []
    Lines.Strings = (
      '0123456789012345678901234567890'
      'Jacco     Edey      GeoBul'
      'Edey      Kapusta   Moondancer'
      'GeoBul    MoondancerJacco'
      'Kapusta   Jacco     Kapusta'
      'MoondancerGeoBul    Edey')
    ParentFont = False
    TabOrder = 0
    WordWrap = False
  end
  object Memo2: TMemo
    Left = 8
    Top = 192
    Width = 233
    Height = 113
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Pitch = fpFixed
    Font.Style = []
    Lines.Strings = (
      'Memo2')
    ParentFont = False
    TabOrder = 1
    WordWrap = False
  end
  object A1_10: TButton
    Left = 8
    Top = 128
    Width = 75
    Height = 25
    Caption = '1-10 A'
    TabOrder = 2
    OnClick = A1_10Click
  end
  object A11_20: TButton
    Left = 88
    Top = 128
    Width = 75
    Height = 25
    Caption = '11 - 20 A'
    TabOrder = 3
    OnClick = A11_20Click
  end
  object A21_30: TButton
    Left = 168
    Top = 128
    Width = 75
    Height = 25
    Caption = '21 - 30 A'
    TabOrder = 4
    OnClick = A21_30Click
  end
  object D1_10: TButton
    Left = 8
    Top = 160
    Width = 75
    Height = 25
    Caption = '1-10 D'
    TabOrder = 5
    OnClick = D1_10Click
  end
  object D11_20: TButton
    Left = 88
    Top = 160
    Width = 75
    Height = 25
    Caption = '11 - 20 D'
    TabOrder = 6
    OnClick = D11_20Click
  end
  object D21_30: TButton
    Left = 168
    Top = 160
    Width = 75
    Height = 25
    Caption = '21 - 30 D'
    TabOrder = 7
    OnClick = D21_30Click
  end
end
*** end of DFM ***
Thank you, Jacco, for responding.  We did, indeed, have Email notification problems in the past, most of which have been resolved in the many diligent efforts by our Engineering team.  I'm very pleased you returned and updated this, and that you are continuing on this collaboration effort.  I also believe that changing this grade now will meet with Kapusta's agreement, and have done so.

Again thank you, and hopefully this has resulted in the excellence you wish to deliver and if more is needed, will continue to collaborate further here with Kapusta.

Thank you all, you make all my time here very worthwhile.
:)
Moondancer - EE Moderator