RichEdit - zachodzenie na siebie stylow

0

Ogólnie to pracuje nad formatowaniem tekstu w RichEdit zgodnie ze znacznikami z irc'u...

Mam taki kod:
======================= cut =======================

procedure TFormMain.formatowanie(s:string);
var
  sb, si, su, sc : string;
  i, dlugosc : integer;
  PozB, PozI, PozU : array of byte;
begin
  RichEdiTest.SelStart := RichEdiTest.GetTextLen;
  RichEdiTest.SelLength := 0;
  RichEdiTest.SelAttributes.Color := clBlack;
  RichEdiTest.SelAttributes.Style := [];

  sb := ClearFormating(s,false,true,true,true);
  si := ClearFormating(s,true,false,true,true);
  su := ClearFormating(s,true,true,false,true);

  SetLength(PozB,0);
  SetLength(PozI,0);
  SetLength(PozU,0);

  while Pos(#2,sb) <> 0 do
    begin
      SetLength(PozB,Length(PozB)+1);
      PozB[Length(PozB)-1] := Pos(#2,sb);
      Delete(sb,Pos(#2,sb),1);
    end;

  while Pos(#22,si) <> 0 do
    begin
      SetLength(PozI,Length(PozI)+1);
      PozI[Length(PozI)-1] := Pos(#22,si);
      Delete(si,Pos(#22,si),1);
    end;

  while Pos(#31,su) <> 0 do
    begin
      SetLength(PozU,Length(PozU)+1);
      PozU[Length(PozU)-1] := Pos(#31,su);
      Delete(su,Pos(#31,su),1);
    end;

  dlugosc := RichEdiTest.GetTextLen;
  RichEdiTest.Lines.Add(ClearFormating(s,true,true,true,true));

  i := 0;
  while Length(PozB) > 0 do
    begin
      if Length(PozB) > 1 then
        begin
          RichEditest.SelStart := dlugosc+PozB[i]-1;
          RichEdiTest.SelLength := PozB[i+1]-PozB[i];
          SetLength(PozB,Length(PozB)-2);
        end
      else
        begin
          RichEditest.SelStart := dlugosc+PozB[i]-1;
          RichEdiTest.SelLength := Length(s)-PozB[i]+1;
          SetLength(PozB,Length(PozB)-1);
        end;
      RichEdiTest.SelAttributes.Style := [fsBold];
      Inc(i,2);
    end;

  i := 0;
  while Length(PozI) > 0 do
    begin
      if Length(PozI) > 1 then
        begin
          RichEditest.SelStart := dlugosc+PozI[i]-1;
          RichEdiTest.SelLength := PozI[i+1]-PozI[i];
          SetLength(PozI,Length(PozI)-2);
        end
      else
        begin
          RichEditest.SelStart := dlugosc+PozI[i]-1;
          RichEdiTest.SelLength := Length(s)-PozI[i]+1;
          SetLength(PozI,Length(PozI)-1);
        end;
        RichEdiTest.SelAttributes.Style := [fsItalic];
        Inc(i,2);
      end;

  i := 0;
  while Length(PozU) > 0 do
    begin
      if Length(PozU) > 1 then
        begin
          RichEditest.SelStart := dlugosc+PozU[i]-1;
          RichEdiTest.SelLength := PozU[i+1]-PozU[i];
          SetLength(PozU,Length(PozU)-2);
        end
      else
        begin
          RichEditest.SelStart := dlugosc+PozU[i]-1;
          RichEdiTest.SelLength := Length(s)-PozU[i]+1;
          SetLength(PozU,Length(PozU)-1);
        end;
        RichEdiTest.SelAttributes.Style := [fsUnderline];
        Inc(i,2);
      end;

    richeditest.SelStart := 0;
    richeditest.SelLength := 0;
end;

======================= /cut =======================

Ale dam taki kod, żeby łatwiej było wam zrozumieć na czym polega mój problem:

======================= cut =======================

begin
  richedit.text := 'testtesttest';
  richedit.SelStart := 2;
  richedit.SelLength := 4;
  richedit.Selattributes.Style := [fsBold];
  richedit.SelStart := 4;
  richedit.SelLength := 4;
  richedit.Selattributes.Style := [fsUnderline];
end;

======================= /cut =======================

Problem jest taki że otrzymuje taki wynik:
testtesttest
A chciałbym żeby style ładnie na siebie zachodziły czyli tak:
testtesttest

Czy jest jakaś prostsza metoda niż mozolnie pisać procki które będą sprawdzały czy style na siebie nachodzą ?
Z góry thx

0

możesz sobie ułatwić i każdą literę traktować z osobna w ten sposób właśnie czyli pętelka for dla tego co ma mieć być zmieniony styl i dodawać do obecnego czyli coś takiego:

procedure AppendStyle(RichEdit:TRichEdit;SelStart,SelLength:integer;Color:TColor;
    Style:TFontStyles;zmienKolor:boolean=true);
var i:integer;
begin
  for i:=SelStart to SelStart+SelLength-1 do begin
    RichEdit.SelStart:=i;
    RichEdit.SelLength:=1;
    if zmienKolor then RichEdit.SelAttributes.Color:=Color;
    RichEdit.SelAttributes.Style:=RichEdit.SelAttributes.Style+Style;
    RichEdit.SelLength:=0;
  end;
end;

begin
  richedit.text := 'testtesttest';
  AppendStyle(RichEdit,2,4,clBlack,[fsBold],false);
  AppendStyle(RichEdit,4,4,clBlack,[fsUnderline],false);
end;
0

Chyba tak będę musiał zrobić po literce formatowanie... swoja droga istnieje możliwość dodawania do richedit po jednej literce, nie usuwając poprzedniego formatowania tekstu ?? Bo jak daje:

RichEdit.Text := RichEdit.Text + 'a';

albo


RichEdit.Lines.Strings[RichEdit.Lines.Capacity] := RichEdit.Lines.Strings[RichEdit.Lines.Capacity] 'a';

to mi się rozwala cale formatowanie tekstu przed tymi literkami co dodaje...

0
  richedit.text := 'testtesttest';
  richedit.SelStart := 2;
  richedit.SelLength := 4;
  richedit.Selattributes.Style := richedit.Selattributes.Style+[fsBold];
  richedit.SelStart := 4;
  richedit.SelLength := 4;
  richedit.Selattributes.Style := richedit.Selattributes.Style+[fsUnderline];

nie testowalem, ale z tego co pamietam tak to mniej wiecej w demku dziala, zreszta zajrzyj do demek - ricjedit, tam jest wszystko ladnie pieknie

1 użytkowników online, w tym zalogowanych: 0, gości: 1