delphi4arab منتديات دلفي للعرب

كيف وضع صورة صغيره كابتسامه بجانب نص في الـــ RichEdit

بارك الله فيكم

السلام عليكم
مثال يستخدم ملف ريسورس:

PHP كود :
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; 

المصدر:

كود :
http://www.swissdelphicenter.ch/en/showcode.php?id=1147

بالتوفيق.

خيار أخر استخدام اي مكون html بدلا من RichEdit وتعرض الابتسامات بدمح روابط الصور على شكل وسم الصور img

B.M.AbdelAziZ كتب :استخدام اي مكون html بدلا من RichEdit وتعرض الابتسامات بدمح روابط الصور ...

انا ابحث عن هذه الحل. لو تزودنا اخي بمثال. وما هي المكونات المناسبه (html)

يمكنك استخدام TWebBrowser انظر:

كود :
http://delphi.about.com/od/twebbrowser/TWebBrowser_Delphi_Usage_Examples_Tips_and_Tricks.htm

بالتوفيق.

kachwahed كتب :يمكنك استخدام twebbrowser انظر:

كود :
http://delphi.about.com/od/twebbrowser/twebbrowser_delphi_usage_examples_tips_and_tricks.htm
بالتوفيق.

بارك الله فيك اخي الكريم علي مجهودك ..

palunix

kachwahed

محمد عبد العزيز

palunix

kachwahed

palunix