RichEdit'te renklendirme.

[Caqatay]

merhaba arkadaşlar.IDTCP client ve IDTCPSocket ile ağ içerisinde sohbet edebilmek için bir proje başlattım.
Proje neredeyse bitti.Ayrıca bu benim okuldaki proje ödevim.Neyse soruma geçeyim.

Projemde bir Memo var göndereceğin mesajı yazıyorsun.Birde RichEdit var gelen mesaj oraya listeleniyor.Aynı msn gibi kendi gönderdiğin mesajda RichEdit'e giriyor gelen mesajda RichEdit'e giriyor.İlk olarak projeye başladığımda RichEdit yerine Memo bileşenini kullanmıştım.Daha sonra gelen ve gönderilen mesajların fontlarının aynı olacağından dolayı RichEdit'e çevirdim.Elimde Zeydin Pala'nın 34 KONUDA DELPHİ 7 kitabı var.Aradığım şeyi tam olarak bulamadım orada.
Projeyi ekte veriyorum.kendi bilgisayarında denemek isteyenler IDTCPCLIENT ' in hostuna 127.0.0.0 ile deneyebilir.Sorum tam olarak şu ; Gelen ve giden mesajların font renkleri vs farklı olsun istiyorum.Kullanıcı seçmesede olur.Gelen kırmızı giden siyah olsun mesala.Yardımlarınız için şimdiden çok teşekkürler.İyi günler dilerim.
Proje :

534 KB

http://rapidshare.com/files/232557634/c ... i.rar.html

http://www.dosya.tc/chatprojesi.rar.html

http://ul.to/vusarz

http://www.megaupload.com/?d=A0M4LM4R

[Lanista]

RenkliEkle diye bir procedure oluşturdum.

Kod: Tümünü seç

procedure RenkliEkle(ARichEdit: TRichEdit; AText: string; AColor: TColor);
begin
  with ARichEdit do
  begin
    SelStart := Length(Text);
    SelAttributes.Color := AColor;
    SelAttributes.Size := 8;
    SelAttributes.Name := 'MS Sans Serif';
    Lines.Add(AText);
  end;
end;

mesaj geldiginde.

Kod: Tümünü seç

  RenkliEkle(RichEdit1, 'Gelen Mesaj içeriği', clRed);

mesaj gönderdiginde.

Kod: Tümünü seç

  RenkliEkle(RichEdit1, 'Giden Mesaj içeriği', clBlack);

renkleri istedigin gibi degiştirirsin ve mesajlarıda içerik değişkenleriyle degiştirirsin. bu kadar.

[Caqatay]

deniyorum şimdi.
yardımın için çok teşekkürler

[sr1111]

benimde buna benzer bir problemim var.
asagidaki linkte yazdimdi. richeditte istedigim fonttaki yaziyi bulacak ve istedigimle degisiterecek bir procedure lazim.
yardimci olursan sevinirim.

viewtopic.php?f=2&t=25511

[Lanista]

şöyle bir procedure buldum. size göre biraz düzelttim sanırım işinizi görür. veya kendinize göre düzeltebilirsiniz.

Kod: Tümünü seç

procedure RearchAndReplace
           (InSearch, InReplace, FontNameS: string) ;
var X, ToEnd : integer;
    oldCursor : TCursor;
begin
   oldCursor := Screen.Cursor;
   Screen.Cursor := crHourglass;
   with form1.RichEdit1 do
   begin
     X := 0;
     ToEnd := length(Text) ;
     X := FindText(inSearch, X, ToEnd, []) ;
     while X <> -1 do
     begin
       SetFocus;
       SelStart := X;
       SelLength := length(inSearch) ;
       if SelAttributes.Name = FontNameS then
         SelText := InReplace;
       X := FindText(inSearch,
                     X + length(InReplace),
                     ToEnd, []) ;
     end;
   end;
   Screen.Cursor := oldCursor;
end;

Örnek Kullanım:

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
var
   SearchText, ReplaceText: string;
begin
   SearchText := 'Pascal';
   ReplaceText := 'Delphi';
   RearchAndReplace(SearchText, ReplaceText, 'Arial') ;
end;

[sr1111]

İstedigim gibi calisti,
Sana nasıl teşekkür edecegim bilmem YÜZLERCE mi Milyonlarca mi,
TESEKKUR EDERİM.

[Lanista]

Bu sözleriniz teşekkür için yeterli. Kendinizi bakın.

[sr1111]

Bir sorunum daha cikti. Richedit icierisindeki sadece Arial yazilan tüm yazıları times new roman cevirmek istiyorum. diger fontlarda olanlar cevrilmesin.