CODEWITHSUNDEEP
regexstringdelphiword-wrap
user3209752
user3209752

Reputation: 649

Word wrap a Delphi string to a certain length using commas not spaces?

I am generating a comma separated list of names in a string eg

Mr John Blue, Miss A Green, Mr Posh Hyphenated-Surname, Mr Fred Green, Miss Helen Red, Ms Jean Yellow

I now want to display them in a memo box that will hold 50 characters on each line so that as many names as possible (and their trailing comma) appear on each line. so the above should look like

Mr John Blue, Miss A Green,
Mr Posh Hyphenated-Surname, Mr Fred Green,
Miss Helen Red, Ms Jean Yellow

I've played with 

Memo1.text := WrapText(Mystring,50)

but it broke lines at spaces between forename and surnames and I tried 

Memo1.text := WrapText(MyString, slinebreak, ',' ,50)

to force it to break only after a comma but that broke at spaces as well as commas. Both also tended to break at a hyphen and I note from Rob Kennedy's reply to a similar question that embedded quotes cause problems with Wrap() so a name like Mr John O'Donald would cause problems.

I even tried rolling my own function by counting characters and looking for commas but got bogged down in multiple nested IFs (Too embarassed to show the dreadful code for that!)

Can anyone offer any help or code showing how this can be done?

PS I have looked at

and other similar posts but none seem to match what I am looking for.

Upvotes: 3

Views: 3369

Answers (2)

moskito-x
moskito-x

Reputation: 11968

Set Memo1.WordWrap:=False;

There are many solutions, I show here just one.
But take care :
If you are using it with large amounts of data then the execution is quite slow

procedure TForm1.AddTextToMemo(needle,xsSrc:string);
var
xsNew:string;
mposOld,mposNew:integer;
start:byte;
begin
xsNew:=xsSrc;
repeat
  repeat
   mposOld:=mposNew;
   mposNew:=Pos(needle,xsSrc);
   if mposNew>0 then xsSrc[mposNew]:='*';
  until (mposNew > 50) OR (mposNew = 0);
  if  mposOld > 0  then begin
     if xsNew[1] = ' ' then start := 2 else start := 1;
     if mposNew = 0 then mposOld:=Length(xsNew);
     Memo1.Lines.Add(copy(xsNew,start,mposOld));
     if mposNew = 0 then exit;
     xsNew:=copy(xsNew,mposOld+1,Length(xsNew)-mposOld);
     xsSrc:=xsNew;
     mposNew:=0;
  end else xsSrc:='';
until xsSrc = '';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
AddTextToMemo(',','Mr John Blue, Miss A Green, Mr Posh Hyphenated-Surname, '+
                  'Mr Fred Green, Miss Helen Red, Ms Jean Yellow');
end;

UPDATE

if you have a small amount of data here is fast and easy to read.

...
var
 Form1: TForm1;
 NameList: TStrings;

...
 NameList := TStringList.Create;
...

procedure TForm1.AddTextToMemoB(needle,xsSrc:string);
var
xsNew:string;
i:integer;
sumLen:byte;

begin
xsNew:=''; sumLen:=0;
nameList.Text:=StringReplace(xsSrc,needle,needle+#13#10,[rfReplaceAll]);
for i := 0 to nameList.Count - 1 do begin
  sumLen:=SumLen+Length(nameList[i]);
  if i < nameList.Count - 1 then begin
    if (sumLen + Length(nameList[i+1]) > 50) then begin
       if xsNew='' then xsNew:=nameList[i];
       Memo1.Lines.Add(xsNew);
       xsNew:='';
       sumLen:=0;
    end else if xsNew='' then xsNew:=nameList[i]+nameList[i+1] else   
                              xsNew:=xsNew+nameList[i+1];
  end else Memo1.Lines.Add(xsNew);
end; // for
end;

Upvotes: 1

Disillusioned
Disillusioned

Reputation: 14832

I haven't tested it, but something along the following lines ought to do the trick. 

for LCh in S do
begin
  case LCh of
    ',' : //Comma completes a word
    begin
      LWord := LWord + LCh;
      if  (LLine <> '') and //Don't wrap if we haven't started a line
          ((Length(LLine) + Length(LWord)) > ALineLimit) then
      begin
        //Break the current line if the new word makes it too long
        AStrings.Add(LLine);
        LLine := '';
      end;
      if (LLine <> ' ') then LLine := LLine + ' '; //One space between words
      LLine := LLine + LWord;
      LWord := '';
    end;
  else
    if (LWord = '') and (LCh in [' ', #9]) then
    begin
      //Ignore whitespace at start of word.
      //We'll explicitly add one space when needed.
      //This might remove some extraneous spaces.
      //Consider it a bonus feature.
    end else
    begin
      LWord := LWord + LCh;
    end;
  end;
end;

//Add the remainder
if  (LLine <> '') and //Don't wrap if we haven't started a line
    ((Length(LLine) + Length(LWord)) > ALineLimit) then
begin
  //Break the current line if the new word makes it too long
  AStrings.Add(LLine);
  LLine := '';
end;
if (LLine <> ' ') then LLine := LLine + ' '; //One space between words
LLine := LLine + LWord;
AStrings.Add(LLine);

Of course you may have noted the duplication that should be moved to a sub-routine.
Tweak away to your hearts content.

Upvotes: 1

Related Questions