Geek asks and answers

Word wraps a Delphi string to a specific length using commas rather than spaces?

I am creating a comma separated list of names in a string like

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

Now I want to display them in the memo field, which will contain 50 characters in each line, so that as many names as possible (and their final comma) are displayed 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 played with

Memo1.text := WrapText(Mystring,50)

but he broke the lines between the first and last names, and I tried

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

to make it break only after the comma, but it broke both in spaces and in commas. Both tend to hyphenate, and I notice from Rob Kennedy an answer to a similar question that inline quotes cause problems with Wrap (), so a name like Mr John O'Donald will cause problems.

, , IFs ( , !)

- - , , ?

PS

  • 'Word wrap TMemo (+) char'
  • ' "" ?
  • ' ,

, , .

+3
2

Memo1.WordWrap:=False;

, .
:
,

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

, .

...
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;
+1

, - .

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);

, , , , .
.

+1

More articles:


All Articles