HTML to RichText..

[FriFra]

Ich habe mir zwei Funktionen gebastelt, eine um Richtext in HTML und eine um HTML in Richtext umzuwandeln.

Mit der Funktion zur Umwandlung von HTML in Richtext habe ich nun ein kleines Problem... Es läuft unter 2000/XP und 2003 Fehlerfrei, aber unter 9x,NT gibt es merkwürdige Zeilenfreher und verschobene Formatierungen...

Ich mache auch keine komplette Umsetzung, sondern nur , , <u>, </u>, , ,
sowie deutsche Umlaute.

Ich muss noch dazu sagen, dass einen Array of Richfür die Textversion und einen für die Richtexte global deklariert habe

Delphi-Quellcode:

const
  UML_HTML: array[0..6] of string = ('ä', 'ö', 'ü', 'Ä',
    'Ö', 'Ü', 'ß');
  UML_RICH: array[0..6] of string = ('ä', 'ö', 'ü', 'Ä', 'Ö', 'Ü', 'ß');

var
  AT: array[0..9] of TRichEdit;

...

procedure TMain.TextToRich(index: integer; Source: string);
var
  n, m, p, q: integer;
  TmpFont: TFont;
  Tmp: string;
  MyLines: TStringList;
  IsBold, IsItalic, IsUnderlined: boolean;
begin
  IsBold := False;
  IsItalic := False;
  IsUnderlined := False;

  TmpFont := TFont.Create;
  MyLines := TStringList.Create;
  p := -1;
  AT[index].Lines.Clear;
  AT[index].SelAttributes.Style := [];

  MyLines.Add('');
  m := 0;
  p := 0;
  for n := 1 to Length(Source) do
  begin
    if p = 0 then
    begin
      if LowerCase(copy(Source, n, 4)) <> '
' then
        MyLines[m] := MyLines[m] + copy(Source, n, 1)
      else
      begin
        p := 3;
        MyLines.Add('');
        m := m + 1;
        Next;
      end;
    end
    else
      p := p - 1;
  end;

  q := -2;

  for n := 0 to MyLines.Count - 1 do
  begin
    Tmp := MyLines[n];
    while pos('[b]', Tmp) > 0 do
      Tmp := copy(Tmp, 1, pos('[b]', Tmp) - 1) + copy(Tmp, pos('[b]', Tmp) + 3,
        Length(Tmp));
    while pos('<u>', Tmp) > 0 do
      Tmp := copy(Tmp, 1, pos('<u>', Tmp) - 1) + copy(Tmp, pos('<u>', Tmp) + 3,
        Length(Tmp));
    while pos('[i]', Tmp) > 0 do
      Tmp := copy(Tmp, 1, pos('[i]', Tmp) - 1) + copy(Tmp, pos('[i]', Tmp) + 3,
        Length(Tmp));
    while pos('[/i][/i][/i][/b][i][i][i]', Tmp) > 0 do
      Tmp := copy(Tmp, 1, pos('[/i][/i][/i][/b][i][i][i]', Tmp) - 1) + copy(Tmp, pos('[/i][/i][/i][/b][i][i][i]', Tmp) +
        4, Length(Tmp));
    while pos('</u>', Tmp) > 0 do
      Tmp := copy(Tmp, 1, pos('</u>', Tmp) - 1) + copy(Tmp, pos('</u>', Tmp) +
        4, Length(Tmp));
    while pos('[/i]', Tmp) > 0 do
      Tmp := copy(Tmp, 1, pos('[/i]', Tmp) - 1) + copy(Tmp, pos('[/i]', Tmp) +
        4, Length(Tmp));
    AT[index].Lines.Add(Tmp);
    q := q + 2;
    AT[index].SelStart := q;
    AT[index].SelLength := 1;
    TmpFont.Style := [];
    Tmp := MyLines[n];
    for m := 1 to Length(Tmp) do
    begin
      if p = 0 then
      begin
        if copy(Tmp, m, 3) = '[b]' then
        begin
          IsBold := True;
          p := 2;
        end
        else if copy(Tmp, m, 4) = '[/b]' then
        begin
          if IsBold = True then
            IsBold := False;
          p := 3;
        end
        else if copy(Tmp, m, 3) = '[i]' then
        begin
          IsItalic := True;
          p := 2;
        end
        else if copy(Tmp, m, 4) = '[/i]' then
        begin
          if IsItalic = True then
            IsItalic := False;
          p := 3;
        end
        else if copy(Tmp, m, 3) = '<u>' then
        begin
          IsUnderlined := True;
          p := 2;
        end
        else if copy(Tmp, m, 4) = '</u>' then
        begin
          if IsUnderlined = True then
            IsUnderlined := False;
          p := 3;
        end
        else
        begin
          if IsBold = True then
            TmpFont.Style := TmpFont.Style + [fsBold]
          else
            TmpFont.Style := TmpFont.Style - [fsBold];
          if IsItalic = True then
            TmpFont.Style := TmpFont.Style + [fsItalic]
          else
            TmpFont.Style := TmpFont.Style - [fsItalic];
          if IsUnderlined = True then
            TmpFont.Style := TmpFont.Style + [fsUnderline]
          else
            TmpFont.Style := TmpFont.Style - [fsUnderline];

          AT[index].SelStart := q;
          AT[index].SelLength := 1;
          AT[index].SelAttributes.Style := TmpFont.Style;
          q := q + 1;
        end;
      end
      else
        p := p - 1;
    end;
  end;

  for n := 0 to 6 do
  begin
    p := AT[index].FindText(UML_HTML[n], 0, Length(AT[index].Text),
      [stMatchCase]);
    while p > -1 do
    begin
      AT[index].SelStart := p;
      AT[index].SelLength := Length(UML_HTML[n]);
      AT[index].SelText := UML_RICH[n];
      p := AT[index].FindText(UML_HTML[n], 0, Length(AT[index].Text),
        [stMatchCase]);
    end;
  end;

  if AT[index].Lines[AT[index].Lines.Count - 1] = '' then
    AT[index].Lines.Delete(AT[index].Lines.Count - 1);
  TmpFont.Free;
  MyLines.Free;
end;

[edit=Admin]Tags korrigiert ? Testing. Mfg, Daniel[/edit]
[edit=Admin]Sieht gut aus. Danke für den Hinweis. Mfg, Daniel[/edit]
[edit=Admin]Edit die Dritte, jetzt paßt es. Mfg, Daniel[/edit]