I'm looking for some easy code to do the following.
Say I have a list like this:
dog training
dog breeds
dog health
dog food
dog beds
dog training school
the best dog breeds
dog treats
red dog treats
blue dog treats
What I want to do is for each line
(1) Work out which is the longest word
(2) Move all entries from the list that have that longest word in them to another list
until the end of the file...
So I would end up with the following lists:
(1) dog training, dog training school
(2) dog breeds, the best dog breeds
(3) dog health
(4) dog food
(5) dog beds
(6) dog treats, red dog treats, blue dog treats
PAS File
==========================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
ListBox2: TListBox;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses StrUtils;
{$R *.dfm}
function SortByStringLength(List: TStringList; Index1, Index2: Integer): Integer;
begin
result:= length(List[Index1]) - Length(List[Index1]);
end;
procedure TForm1.Button1Click(Sender
var src, dest: TStringList;
function GetLongestWord(s: string): string;
const WordDelimiters: set of char = [' ', ',', '.'];
var words: array of string;
i: integer;
begin
result:= '';
SetLength(words, length(words)+1);
try
for i:= 0 to length(s)-1 do
begin
if s[i+1] in WordDelimiters
then SetLength(words, length(words)+1)
else words[length(words)-1]:= words[length(words)-1]+s[i
end;
for i:= low(words) to High(words) do
if Length(result) < Length(words[i])
then result:= words[i];
finally
SetLength(words, 0);
end;
end;
procedure MoveBasedOnLongestWord(Lon
var i: integer;
s: string;
begin
s:= '';
for i:= src.Count-1 downto 0 do
if Pos(LongestWord, Src[i]) <> 0 then
begin
s:= s + Src[i]+', ';
Src.delete(i);
end;
if s <> '' then
begin
SetLength(s, length(s)-2); //remove last comma space pair
ListBox2.Items.Add(s);
end;
end;
begin
ListBox2.Clear;
src:= TStringList.Create;
try
src.Assign(ListBox1.Items)
while src.Count > 0
do MoveBasedOnLongestWord(Get
finally
src.Free;
end;
end;
end.
DFM File
==========================
object Form1: TForm1
Left = 192
Top = 114
Width = 551
Height = 338
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object ListBox1: TListBox
Left = 16
Top = 24
Width = 121
Height = 257
ItemHeight = 13
Items.Strings = (
'dog training'
'dog breeds'
'dog health'
'dog food'
'dog beds'
'dog training school'
'the best dog breeds'
'dog treats'
'red dog treats'
'blue dog treats')
TabOrder = 0
end
object Button1: TButton
Left = 168
Top = 32
Width = 75
Height = 49
Caption = 'Sort by length and move'
TabOrder = 1
WordWrap = True
OnClick = Button1Click
end
object ListBox2: TListBox
Left = 280
Top = 24
Width = 241
Height = 257
ItemHeight = 13
TabOrder = 2
end
end
Kind regards
Pierre