Чат

← →
Андре (2005-09-20 16:49) [0]

Подскажите компонет, чтобы можно было как вэб-чатах вставлять смайлики внутри текста и выделять гиперссылки?
Мож кто встречал такую помесь ричэдита?

← →
Big Joe © (2005-09-20 16:53) [1]

Поместить изображение смайлика в TRxRichEdit
-----------------------------------------------------------------------
Автор: http://www.swissdelphicenter.ch

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;

← →
Eraser © (2005-09-20 16:56) [2]

> Андре (20.09.05 16:49)

Так же глянь TJvRichEdit из JEDI VCL - там готовые ф-ии есть.

← →
Big Joe © (2005-09-20 16:59) [3]

Подсветить ссылки в TRichEdit
--------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
mask: Word;
begin
mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
RichEdit1.Text := "SwissDelphiCenter.com: "#13#10 +
" Site is located at www.SwissDelphiCenter.com";
end;

// 3. now we must detect mouse clicks in URL range. For this task we must
// override WndProc method of our form:
type
TForm1 = class(TForm)
protected
procedure WndProc(var Message: TMessage); override;
end;

// 4. the implementation looks like this:

procedure TForm1.WndProc(var Message: TMessage);
var
p: TENLink;
strURL: string;
begin
if (Message.Msg = WM_NOTIFY) then
begin
if (PNMHDR(Message.lParam).code = EN_LINK) then
begin
p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);
if (p.Msg = WM_LBUTTONDOWN) then
begin
SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
strURL := RichEdit1.SelText;
ShellExecute(Handle, "open", PChar(strURL), 0, 0, SW_SHOWNORMAL);
end
end
end;

inherited;
end;

← →
Андре (2005-09-20 17:05) [4]

[1], [3]
Огромное спасибо!

[2]
А линк не дадите на JEDI VCL?

← →
Андре (2005-09-20 17:08) [5]

Сори, туплю
http://delphi-jedi.org

> Андре (20.09.05 17:08) [5]

Не забудь перед JVCL сначала JCL установить, а то работать не будет!

Чат Найти похожие ветки