delphi4arab منتديات دلفي للعرب
صورة صغيره كابتسامه بجانب نص في الRichEdit - نسخة قابلة للطباعة

+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : صورة صغيره كابتسامه بجانب نص في الRichEdit (/showthread.php?tid=3079)



صورة صغيره كابتسامه بجانب نص في الRichEdit - palunix - 14-05-2011

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

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


صورة صغيره كابتسامه بجانب نص في الRichEdit - kachwahed - 14-05-2011

السلام عليكم
مثال يستخدم ملف ريسورس:
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
بالتوفيق.



صورة صغيره كابتسامه بجانب نص في الRichEdit - محمد عبد العزيز - 14-05-2011

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


صورة صغيره كابتسامه بجانب نص في الRichEdit - palunix - 15-05-2011

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


صورة صغيره كابتسامه بجانب نص في الRichEdit - kachwahed - 15-05-2011

يمكنك استخدام TWebBrowser انظر:
كود :
http://delphi.about.com/od/twebbrowser/TWebBrowser_Delphi_Usage_Examples_Tips_and_Tricks.htm
بالتوفيق.



صورة صغيره كابتسامه بجانب نص في الRichEdit - palunix - 16-05-2011

kachwahed كتب :يمكنك استخدام twebbrowser انظر:
كود :
http://delphi.about.com/od/twebbrowser/twebbrowser_delphi_usage_examples_tips_and_tricks.htm
بالتوفيق.

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