Array
(
)

Editor RFT que aceita Imagem.

Yallebr
   - 24 fev 2006

Olá pessoal,

Onde arrumo um Editor de RTF que aceita imagem e tabela?

Obrigado


Weber
   - 24 fev 2006

O RxRichEdit aceita imagem.


Sourcecode
   - 24 fev 2006


Citação:
O RxRichEdit aceita imagem.


Exemplo de como usar o RxRichEdit pra colocar emoticons:

[img:3eb17d5244]http://www.swissdelphicenter.ch/screenshots/Tip1147.png[/img:3eb17d5244]

#Código


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;


Exemplo retirado do site http://www.swissdelphicenter.ch/torry/showcode.php?id=1147

[url=http://www.swissdelphicenter.ch/torry/demodownload.php?id=1147]Download do Demo[/url]