Richedit'e biçim atmaktan sıkıldım ve

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
Lost Soul
Üye
Mesajlar: 1064
Kayıt: 01 Nis 2007 02:55
Konum: mekan ANKARA toprak ELAZIĞ
İletişim:

Richedit'e biçim atmaktan sıkıldım ve

Mesaj gönderen Lost Soul »

aşağıdaki metodu yazdım

Kod: Tümünü seç



{ RichEdit}
// ComCtrls,Graphics
function ConvNum(HCStr:String):Integer;
const
     HCDigits = ['0', '1', '2', '3', '4', '5','6', '7', '8', '9'];
var
   HCDon: Integer;
begin
     HCDon:=1;
     While not(HCDon>Length(HCStr)) do
     begin
       if not(HCStr[HCDon] in HCDigits) then
          Delete(HCStr,HCDon,1)
          else Inc(HCDon);
     end;
     Result:=StrToInt(HCStr);
end;

function RemoveTags (aStr : string; bTag,eTag : string;aTrim: Boolean = True):String;
var
  b,e:Integer;
Begin
  Result :='';
  b :=Length(bTag)+1;
  e := Pos(eTag,aStr);
  if e>0 then e := e-b
  else
    e:= Length(aStr)-b;

  Result := Copy(aStr,b,e);
  if Atrim then Result := trim(Result);

end;


Procedure AddRich(Editor : TRichEdit; PStr : AnsiString; lStr : AnsiString = #13#10;DefAttr : TFont=nil);

var
mStr : String;
i:Integer;
xStr : AnsiString;
b : Boolean;
k : Boolean;
Begin
  xStr := pStr;
  b:= false;
  k := DefAttr = nil;
  if k then DefAttr := TFont.Create;
  With Editor do
  Begin
    SelStart := GetTextLen;
    SelAttributes.Assign(DefAttr);
    while Length(xStr)>0 do
    Begin
      i :=NextPos('[',xStr,0);
      if i>1 then
      while xStr[i-1]='\' do
      Begin
        i := NextPos('[',xStr,i);
        if i<=0 then Break;
      End;

      if i>1 then
      Begin
        mStr := Copy(xStr,1,i-1);
        SelText := mStr;
        Delete(xStr,1,i-1);
        b := false;
      End
      else if i=1 then
      Begin
        i :=NextPos(']',xStr,i);
        mStr :=Copy(xStr,1,i);
        if mStr <>'' then
        Begin
          if not b then SelAttributes.Assign(DefAttr)
          else
          if (mStr='[]') then SelAttributes.Assign(DefAttr);

          if mStr= '[b]' then SelAttributes.Style := SelAttributes.Style + [fsBold];
          if mStr= '[i]' then SelAttributes.Style := SelAttributes.Style + [fsItalic];
          if mStr= '[u]' then SelAttributes.Style := SelAttributes.Style + [fsUnderline];
          if mStr= '[s]' then SelAttributes.Style := SelAttributes.Style + [fsStrikeOut];
          if Pos('[fc=%',mStr)>0 then
          Begin
             SelAttributes.Color := StrToIntDef(RemoveTags(mStr,'[fc=%',']'),SelAttributes.Color)
          End;
          if Pos('[fc=cl',mStr)>0 then
          Begin
             SelAttributes.Color := StringToColor(RemoveTags(mStr,'[fc=',']'));
          End;

          //StringToColor
        End;
        Delete(xStr,1,i);
        b := True;
      End
      else if i<=0 then
      Begin
        SelText := xStr;
        xStr :='';
        b := False;
      End;
     End;
     if lstr<>'' then SelText :=lstr ;

    End;

    if k then FreeAndNil(DefAttr);



  End;

örnek kullanım

Kod: Tümünü seç

AddRich(RichEdit1,'[fc=clRed]Deneme[][b]Kelle[i]Paça[u]Leblebi[]Deneme[s][fc=%1234332]Strike[] [b][i][u][s]Leblebi');
sonuç
Resim

phpbb kodlarından biraz kopya çektim.:)
daha da geliştireceğim ancak şu anda bu haliyle bana yetiyor :)
Cevapla