Newsgroup: it.comp.lang.delphi
Titolo: formattare un testo

 Ciao a tutti,
Ho creato tempo fa una procedurina che formatta il testo a 70 caratteri 
per riga... dopo alcuni mesi mi č stato sottolineato il fatto che questa 
tronca le parole costringendo l'utente ad una ulteriore sistemazione del 
documento, come posso fare a modificare questa procedura in modo che non 
tronchi le parole?
Grazie in anticipo 
procedure TMainForm.FilterExecute(Sender: TObject);
var
  Child: TMDIChild;
  AppLine, Testo: string;
  j: integer;
  point: tpoint;
begin
  Child:=TMDIChild(MainForm.ActiveMDIChild);
  LockControl(Child,TRUE);
  Point:=Child.Memo1.CaretPos;
  if Child<> nil then
  begin
  Child.Memo1.Clear;
  j := 1;
  while (j <= length(Testo)) do
  begin
    if (length(AppLine) = 70) or (Testo[j] = chr(13)) then
    begin
      if AppLine <> '' then
        Child.Memo1.Lines.add(AppLine)
      else
        Child.Memo1.Lines.add('.');
      if Testo[j] = chr(13) then
      begin
        j := j + 1;
        AppLine := '';
      end
      else
        AppLine := Testo[j];
    end
    else
      AppLine := AppLine + Testo[j];
    j := j + 1;
  end;
  if AppLine <> '' then
    Child.Memo1.Lines.add(AppLine);
 // point.X := length(Child.Memo1.Lines[Child.Memo1.Lines.Count - 1]);
 // point.Y := Child.Memo1.Lines.Count - 1;
  Child.Memo1.CaretPos := point;
  LockControl(Child,FALSE);
  end;
end;
--- posted by geoForum on 
http://www.delphiedintorni.it

 tronchi le parole?
http://web.infinito.it/utenti/c/catand/Tips/ttsu2.htm
Ciao
ACSH
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

No coment non è quello il problema


 No coment non è quello il problema
Perche'?


Quello che hai postato è un link di come impostare il memo
in modo che non faccia righe piu lunghe di tot caratteri durante la 
digitazione. Probblema che ho gia risolto direi discretamente. Ma qui 
chiedevo se il testo x non è formattato come deve essere la procedura di 
formattazione???


 formattazione???
Rispondo ora sperando che tu nel frattempo abbia gia' risolto il tuo
problema.
In ogni caso, non capisco di cosa hai bisogno. Il tuo codice non e'
molto leggibile
e non vedo da quale fonte arriva il "testo non formattato" (qualunque
cosa questo significhi per te).
Ora, ipotizzando che tu abbia una stringa di lunghezza indefinita, la
cosa e' abbastanza banale:
- leggi settanta caratteri della stringa;
- se l'ultimo carattere e' uno _spazio_ allora lo inserisci nel memo
 altrimenti cerchi l'ultimo _spazio_ nella stringa e la tronchi in
quel punto;
- aggiungi la stringa troncata nel memo e l'avanzo lo aggiungi alla
stringa originaria;
- ripeti fino alla fine della stringa;
Una cosa del genere (sistema tu il codice se necessario):
function TrovaUltimoCarattere(strTemp: String; chCarattere: char):
integer;
var
 intUltimoCar: integer;
 intCont: integer;
begin
 intUltimoCar := 0;
 intCont:= 1;
 while intcont < Length(strTemp) do
  begin
   if strTemp[intCont] = chCarattere then intUltimoCar := intCont;
   inc(intCont);
  end;
  Result := intUltimoCar;
end;
function TroncaStringa(var strTemp: string; intPos:integer): string;
var
 strAvanzo: string;
begin
 strAvanzo := strTemp;
 SetLength(strTemp, intPos);
 Delete(strAvanzo, 1, Length(strTemp));
 Result := strAvanzo;
end;
procedure FormattaStringa(slDaFormattare: TStringList; intLungh:
integer; strDaFormattare: string);
var
 strTempDaInserire, strTempAvanzo: string;
begin
 while Length(strDaFormattare) > intLungh do
 begin
  strTempDaInserire := Copy(strDaFormattare, 1, intLungh);
  Delete(strDaFormattare, 1, intLungh);
  if strTempDaInserire[intLungh] = ' ' // ultimo carattere e' uno
spazio
   then slDaFormattare.Add(strTempDaInserire)
   else
    begin
     strTempAvanzo := TroncaStringa(strTempDaInserire,
TrovaUltimoCarattere(strTempDaInserire, ' '));
     slDaFormattare.Add(strTempDaInserire);
     strDaFormattare := strTempAvanzo + strDaFormattare;
    end // else
 end; // while
 slDaformattare.Add(strDaFormattare);
end; // formattaStringa
procedure TForm1.FormCreate(Sender: TObject);
begin
 Label1.Caption := 'stringa molto molto lunga';
 FormattaStringa(TStringList(memo1.Lines), 70, label1.caption);
end;
Ciao
-- 
ACSH
[D4]
Chi fa da se', fatica il doppio 

Avevo già risolto... questo è il codice... il problema è ke c'erano 
piccoli errori che facevano in modo di sminxxxxx tutta la procedura:
procedure TMainForm.FilterExecute(Sender: TObject);
var
  Child: TMDIChild;
  point: tpoint;
  i, j, SpacePos : integer;
  Testo, Linea : String;
begin
  Child:=TMDIChild(MainForm.ActiveMDIChild);
  LockControl(Child,TRUE);
  Point:=Child.Memo1.CaretPos;
  Testo :=AnsiReplaceText(child.Memo1.Text,#9,'   ');
  Testo :=AnsiReplaceText(Testo,'Š','_');
  Testo :=AnsiReplaceText(Testo,'à','à');
  Testo :=AnsiReplaceText(Testo,'ì','ì');
  Testo :=AnsiReplaceText(Testo,'é','é');
  Testo :=AnsiReplaceText(Testo,'ò','ò');
  Testo :=AnsiReplaceText(Testo,'…',' ');
  Child.Memo1.Clear;
  SpacePos := 0;
  j:=1;
  // Mi faccio una parseggiata su tutto il testo!!!
  while (j <= length(testo)) do  // Parseggio tutto il testo
  begin
    i := j;
    // Parseggio i prossimi 70 caratteri e verifico che all'interno non 
ci sia
    // un CR. In piu' salvo l'ultimo spazio trovato all'interno di 
quaesti 70
    // caratteri.
    while(i <= length(Testo)) and (i<j + LUNGHEZZA) and ((testo[i]
<>#13)) do
    begin
      if (testo[i]=' ') then  // Salvo la posizione dello spazio. Alla 
fine in
        SpacePos := i;        // SpasePos rimane la posizione 
dell'ultimo spazio.
      i := i+1;
    end;
    if(i<length(testo))then  // ok... non sono alla fine del testo
    begin
      if(testo[i]=#13) then  // C'e' un CR???
      begin
        linea := copy(testo, j, i-j);  // allora la linea sara' fino al 
CR. Potrebbe essere anche una riga vuota (solo il CR)
        j := i+1; // Salvo in j la posizione fin dove sono arrivato
      end
      else if(i >= j + LUNGHEZZA)then  // acc... ho superato i 70 
caratteri???
      begin
        if (spacePos<j) then // ci sno spazi???
        begin
          linea := copy(testo, j, LUNGHEZZA);  // NOOO!! Che sfiga!! 
allora devo troncare il testo a 70 caratteri
          j := j+LUNGHEZZA-1; // Salvo in j la posizione fin dove sono 
arrivato
        end
        else
        begin
          linea := copy(testo, j, SpacePos-j+1); // Che culo ce n'e' 
almeno uno... allora la linea sara' fino all'ultimo spazio trovato.
          j := SpacePos; // Salvo in j la posizione fin dove sono 
arrivato
        end;
      end;
    end
    else
    begin  // Caxxx... sono alla fine del testo e SICURAMENTE i 
caratteri letti sono meno di 70 (vedi il While e capisci'a'mme')
      Linea := copy(testo, j, length(testo)-j+1); // bene.. allora la 
linea e' fino alla fine del testo.
      j := i+1;
    end;
    if trim(linea) = '' then // Ue' Bello... l'AS400 non capisce un 
cazzo di righe vuote...
      linea :='.';  // .. e allora ci metto un punto...
    Child.Memo1.Lines.Add(linea); // finalmente salvo la linea...
    SpacePos:=j; // salvo la posizione dove sono arrivato per 
ricalcolare dopo la posizione degli spazi..
    j := j+1; // and now... go tu de nexte uan!!!!!!!
  end;
 // point.X := length(Child.Memo1.Lines[Child.Memo1.Lines.Count - 1]);
 // point.Y := Child.Memo1.Lines.Count - 1;
  Child.Memo1.CaretPos := point;
  LockControl(Child,FALSE);
end;
--- posted by geoForum on 
http://www.delphiedintorni.it