Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2005.10.16;
Скачать: [xml.tar.bz2];

Вниз

А как в RxRichEdit Вставить рисунок например смайл?   Найти похожие ветки 

 
NikNet ©   (2005-09-21 19:27) [0]

Плиз покажите пример :)


 
Big Joe ©   (2005-09-22 08:00) [1]

Поместить изображение смайлика в TRxRichEdit
--------------------------------------------------------------------------

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;



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.10.16;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.039 c
3-1125669985
jeka_t
2005-09-02 18:06
2005.10.16
Как в запросе указать условие отбора по дате с временем...


6-1119600004
officeman
2005-06-24 12:00
2005.10.16
Вопрос про Сетевой-Доступ


3-1125513802
Knight
2005-08-31 22:43
2005.10.16
Как можно сохранить в базе текст с картинками?


2-1126099357
worldmen
2005-09-07 17:22
2005.10.16
Имена колонок TListView. Delphi 7.


14-1127555455
Goga
2005-09-24 13:50
2005.10.16
переведите на delphi Спасибо





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский