was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

52 Visitors Online


 
...ein Smiley-Bild in ein TRxRichEdit einfügen?
Autor: Thomas Stutz
[ Tip ausdrucken ]  


Tip Bewertung (27):  
     




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;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners