Smiley

[ender_arslanturk]

Arkadaşlar network arası chat programında aynı forumdaki gibi smiley lerinde gözükmesini istiyorum. Bunu nasıl yaparım. Sanırım richedit te böyle birşey yok.

[vedatkaba]

Kod: Tümünü seç

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}
{$R Smiley.res}

uses
  RichEdit;

type
  TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
    cb: Longint; var pcb: Longint): DWORD;
  stdcall;

  TEditStream = record
    dwCookie: Longint;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end;

type
  TMyRichEdit = TRxRichEdit;

// EditStreamInCallback callback function

function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): DWORD; stdcall;
var
  theStream: TStream;
  dataAvail: LongInt;
begin
  theStream := TStream(dwCookie);
  with theStream do
  begin
    dataAvail := Size - Position;
    Result := 0;
    if dataAvail <= cb then
    begin
      pcb := read(pbBuff^, dataAvail);
      if pcb <> dataAvail then
        Result := UINT(E_FAIL);
    end
    else
    begin
      pcb := read(pbBuff^, cb);
      if pcb <> cb then
        Result := UINT(E_FAIL);
    end;
  end;
end;

// Insert Stream into RichEdit

procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);
var
  EditStream: TEditStream;
begin
  with EditStream do
  begin
    dwCookie := Longint(SourceStream);
    dwError := 0;
    pfnCallback := EditStreamInCallBack;
  end;
  RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
end;

// Load a smiley image from resource

function GetSmileyCode(ASimily: string): string;
var
  dHandle: THandle;
  pData, pTemp: PChar;
  Size: Longint;
begin
  pData := nil;
  dHandle := FindResource(hInstance, PChar(ASimily), RT_RCDATA);
  if dHandle <> 0 then
  begin
    Size := SizeofResource(hInstance, dHandle);
    dhandle := LoadResource(hInstance, dHandle);
    if dHandle <> 0 then
      try
        pData := LockResource(dHandle);
        if pData <> nil then
          try
            if pData[Size - 1] = #0 then
            begin
              Result := StrPas(pTemp);
            end
            else
            begin
              pTemp := StrAlloc(Size + 1);
              try
                StrMove(pTemp, pData, Size);
                pTemp[Size] := #0;
                Result := StrPas(pTemp);
              finally
                StrDispose(pTemp);
              end;
            end;
          finally
            UnlockResource(dHandle);
          end;
      finally
        FreeResource(dHandle);
      end;
  end;
end;

procedure InsertSmiley(ASmiley: string);
var
  ms: TMemoryStream;
  s: string;
begin
  ms := TMemoryStream.Create;
  try
    s := GetSmileyCode(ASmiley);
    if s <> '' then
    begin
      ms.Seek(0, soFromEnd);
      ms.Write(PChar(s)^, Length(s));
      ms.Position := 0;
      PutRTFSelection(frmMain.RXRichedit1, ms);
    end;
  finally
    ms.Free;
  end;
end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject);
begin
  InsertSmiley('Smiley1');
end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject);
begin
  InsertSmiley('Smiley2');
end;

// Replace a :-) or :-( with a corresponding smiley

procedure TfrmMain.RxRichEdit1KeyPress(Sender: TObject; var Key: Char);
var
 sCode, SmileyName: string;

  procedure RemoveText(RichEdit: TMyRichEdit);
  begin
    with RichEdit do
    begin
      SelStart := SelStart - 2;
      SelLength := 2;
      SelText :=  '';
    end;
  end;

begin
 If (Key = ')') or (Key = '(')  then
 begin
   sCode := Copy(RxRichEdit1.Text, RxRichEdit1.SelStart-1, 2) + Key;
   SmileyName := '';
   if sCode = ':-)'  then SmileyName := 'Smiley1';
   if sCode = ':-('  then SmileyName := 'Smiley2';
   if SmileyName <> '' then
   begin
     Key := #0;
     RemoveText(RxRichEdit1);
     InsertSmiley('Smiley1');
   end;
 end;
end;

Ender abi bunu bir dene bakalım tam senin dediğin gibi bir kod.Hayırlı olsun....Güle güle kullan.

[ender_arslanturk]

Vedatcığım teşekkür ederim. Eline sağlık.

[vedatkaba]

Vedatcığım teşekkür ederim. Eline sağlık.

Afiyet olsun.....

Msn ortamında nasıl çalışıyorsa buda böyle çalışıyor.

[ender_arslanturk]

Eyvallah kardeş, ya birde ricam olucak şu an başka yerdeyim. Örnek proje varsa bir mail atarmısın.

Tekrar eline sağlık. Sohbet bölümüne başlık açmıştım adına bir kontrol et.

[vedatkaba]

Eyvallah abicim...Hemen mail atarım exe li örneğide var.Ne başlığıymış o ya.

[ender_arslanturk]

Ok. Exe oluşu iyi sağolasın yine. Bak yüzüm gülüyor.

[ender_arslanturk]

Bu smil projesini torry den indirdim. Ama şöyle klasörde bulunan smilleri kullanamazmıyız. Analadığım kadarı ile rc'den res dosyası oluşturuluyor.
Kullanıcı istediği iconu nasıl kullanabilirki bu durumda. Aynı forum gibi klasörden smilleri kontrol ettirebilirsek iyi olur....

[vedatkaba]

benim maille attığım örnek projeyi gördünüz herhalde.ona istinaden mi söylüyorsunuz anlamadım.

[ender_arslanturk]

Yok Yok inceledim.
Senin gelmedi. Ben torryden çektim. Ya ben ne zaman birşey yapsam delphide hep ekstralar çıkıyor. En sonunda gidip dükkanı açıcam.

Vedat şimdi bu smilleri herhangi bir klasörden alacak kod veyahut komponent varmıdır. Ben biraz inceledim, sonuç ....

İnşallah anlatabilmişimdir.

[vedatkaba]

Benim örneği bir incele diyorum yine.......

[ender_arslanturk]

Hazır kodlarmı yoksa Mail Göndericen o mu ? Yukarıdaki kod ile torry deki aynı zaten.....

[vedatkaba]

Enderabi ben maili ilker_arslanturk adına attım.Gelmesi lazım...mynetten atmıştım mutlaka projeyi incele anlarsın zaten bir dosyaya önceden yüklemiş smilleri sonrada ordan alarak ricedite ekleme yapmış kolay gelsin.

[ender_arslanturk]

Evet aldım peki buna yeni smley nasıl eklicez. Yani smley txt te anladığım kadarı ile resim data formatı var.... Mesela bu smiley nasıl eklerimki sen nasıl yaptın. Ya bu ara kusura bakma telaşında var biliyorum.