Memo-Text für Zeichenfläche formatieren?

[Dani]

Hallo,

bin am verzweifeln. Seit Wochen versuche ich eine Funktion zu schreiben, die mir einen Text so formatiert, dass man diesen Text dann Zeile für Zeile auf ein Bitmap zeichnen kann. Aber es will nicht funktionieren

Entweder es wird ein Wort zu viel in die Zeile geschrieben oder es sind zu viele Zeilenumbrüche darin, ich blicke den eigenen Code nicht mehr durch... besonders elegant ist der auch nicht. Gibt's denn keine einfache Möglichkeit, den Text zu formatieren? Funktioniert EM_FORMATRANGE auch mit Memos?

Zum Lachen hier noch mein bisheriger Code:

Delphi-Quellcode:

function TMyMemo.CreateFormattedStrings(sInput: TStrings; OnCanvas: TCanvas): TStringlist;
var
 sWord, sNonWord, sTmp, sResult, sLine: String;
 LastChar, MaxChar: Integer;
 Clusters: TStringlist;
const
 WordSeperators = [' '];
begin
 Result := TStringlist.Create;
 Clusters := TStringlist.Create;

 sTmp := sInput.Text;
 sResult := '';
 LastChar := 1;
 MaxChar := Length(sTmp);
 sWord := '';
 sNonWord := '';
 sLine := '';
 Clusters.Clear;

 With OnCanvas do
 while LastChar < MaxChar do
 try
  //sLine bilden
  sLine := '';
  while (TextWidth(sLine) < FPxWidth)
    AND (LastChar < MaxChar) do
   begin
    //Wort finden
    sWord := '';
    sNonWord := '';
    Clusters.Clear;
    while (LastChar <= MaxChar) AND not (sTmp[LastChar] in WordSeperators) do
     begin
      sWord := sWord + sTmp[LastChar];
      Inc(LastChar);
     end;
   // ShowMessage('sWord:' + '"'+sWord+'"');
    //Leerzeichen finden
    while (LastChar <= MaxChar) AND (sTmp[LastChar] in WordSeperators) do
     begin
      sNonWord := sNonWord + sTmp[LastChar];
      Inc(LastChar);
     end;
     //Passt das Wort noch in sLine?
     If TextWidth(sLine + sWord) > FPxWidth then
      begin 
       Clusters.Add('');
       //Ist das Wort zu lang für 1 Zeile?
       If TextWidth(sWord) > FPxWidth then
        begin
         while (Length(sWord)>0) do
          begin
           If TextWidth(Clusters[Clusters.Count-1]) > PxWidth then Clusters.Add('');
           Clusters[Clusters.Count-1] := Clusters[Clusters.Count-1] + sWord[1];
           Delete(sWord, 1, 1);
           If TextWidth(sWord) <= PxWidth then break;
          end;
        end;
       while (Clusters.Count>0) AND (Clusters[Clusters.Count-1] = #13#10) do
        Clusters.Delete(Clusters.Count-1);
       //If Clusters.Text = #13#10 then Windows.Beep(400,100); 
       sLine := sLine + Clusters.Text + sWord;
      end
       //Das Wort passt noch in sLine
       else sLine := sLine + sWord;

   sLine := sLine + sNonWord;
   //ShowMessage('sLine:' + '"'+sLine+'"');
  end;
  //sLine hinzufügen
  sResult := sResult + sLine + #13#10;
 except
  exit;
 end;
 //ShowMessage('Final Result:' + #13#10 + '"' + sResult + '"');
 Result.Text := sResult;
 While (Result.Count > 0) AND (Result[Result.Count-1] = #13#10) do
  Result.Delete(Result.Count-1);
end;