Доброго всем времени суток!
Пишу это сообщение любуясь на смайлы форума, которые справа.
Я тоже хочу чтоб у меня были смайлы, но тока в чате написанном на дельфях, юзаю просторы нета 5 день. Посмотрел факью и нашел вот это:
Поместить изображение смайлика в TRxRichEdit
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;
сделал как тут, компилится без ошибок (ну понятно что все компоненты стоят
), но при нажатии на SpeedButton2 и SpeedButton1 ничего не происходит. Файл ресурсов слинкован правильно. Что делать не знаю помогите....
Большая просьба, тем кто может накидайте примерчик и киньте на мыло
dr.vampir@rambler.ru буду признателен.
или объясните или приведите пример, как вставить смайлы в RxRichEdit другими методами, можно даже просто без файлов ресурсов.
PS: ребят ну пожалуйста не посылайте дальше меня искать и тд. просто помогите по человечески.
01.10.2007, 15:58
проблема со смайлами
Линейный вид
