Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.10.24;
Скачать: CL | DM;

Вниз

Добавление тектса из одного RichEdit d другой   Найти похожие ветки 

 
GrISeR ©   (2004-10-09 22:20) [0]

Необходимо добавить текст из одного RichEdit в другой с сохранением стиля (fsBold, ...). Нашел пока единственный способ - скопировать в буфер, потом вставить.=))) Хочеться как-нить получше это сделать, без использования буфера.


 
Defunct ©   (2004-10-09 22:31) [1]

SaveToStream
LoadFromStream


 
GrISeR ©   (2004-10-09 22:38) [2]

Мне нужно добавить текст, а не просто скопировать.


 
Defunct ©   (2004-10-09 22:42) [3]

тогда вы привели

> пока единственный способ

можно, конечно, руцями в Stream добавлять, но ваш способ проще.


 
Семен Сорокин ©   (2004-10-09 22:50) [4]

вот в закромах валялось :)

type TEditStreamCallBack = function (dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): DWORD; stdcall;

TEditStream = record
 dwCookie: Longint;
 dwError: Longint;
 pfnCallback: TEditStreamCallBack;
end;

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;  {assume everything is ok}
     if dataAvail <= cb then
     begin
       pcb := Read(pbBuff^, dataAvail);
       if pcb <> dataAvail then  {couldn"t read req. amount of bytes}
         result := E_FAIL;
     end
     else
     begin
       pcb := Read(pbBuff^, cb);
       if pcb <> cb then
         result := E_FAIL;
     end;
   end;
end;

function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb:
Longint; var pcb: Longint): DWORD; stdcall;
var
 theStream: TStream;
begin
 theStream := TStream(dwCookie);
 with theStream do
 begin
   if cb > 0 then
     pcb := Write(pbBuff^, cb);
   Result := 0;
 end;
end;

procedure GetRTFSelection( aRichEdit: TRichEdit; intoStream: TStream );
var
 editstream: TEditStream;
begin
 with editstream do
 begin
   dwCookie := Longint(intoStream);
   dwError := 0;
   pfnCallback := EditStreamOutCallBack;
 end;
 aRichedit.Perform( EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@editstream));
end;

procedure PutRTFSelection( aRichEdit: TRichEdit; sourceStream: TStream);
var
 editstream: TEditStream;
begin
 with editstream do
 begin
   dwCookie := Longint(sourceStream);
   dwError := 0;
   pfnCallback := EditStreamInCallBack;
 end;
 aRichedit.Perform( EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@editstream));
end;

procedure InsertRTF(aRichEdit: TRichEdit; s: String);
var
 aMemStream: TMemoryStream;
begin
 if Length(s) > 0 then
 begin
   aMemStream := TMemoryStream.Create;
   try
     aMemStream.Write(s[1], length(s));
     aMemStream.Position := 0;
     PutRTFSelection( aRichEdit, aMemStream );
   finally
     aMemStream.Free;
   end;
 end;
end;

procedure CopyRTF(aSource, aDest: TRichEdit);
var
 aMemStream: TMemoryStream;
begin
 aMemStream := TMemoryStream.Create;
 try
   GetRTFSelection(aSource, aMemStream );
   aMemStream.Position := 0;
   PutRTFSelection(aDest, aMemStream );
 finally
   aMemStream.Free;
 end;
end;


 
Defunct ©   (2004-10-09 23:08) [5]

Семен Сорокин ©   (09.10.04 22:50) [4]
> вот в закромах валялось :)

Где-то я это уже видел, закрома родины хоть и бездонные, но исходники наудивление одинаковые ;>
Это часом не из примера раскраски текста по синтаксису (RichSyntax (C) Serhiy Perevoznyk) разных языков программирования?


 
GrISeR ©   (2004-10-09 23:38) [6]

Огромное спасибо, все работает...
Правда я хотел проще, а получилось еще сложнее...ну не важно - все равно спасибо. Не откажусь от комментариев по коду =)) понять хочется, как это работает... =))



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

Текущий архив: 2004.10.24;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.048 c
14-1096660435
Ломброзо
2004-10-01 23:53
2004.10.24
Потоки?


14-1096872023
WondeRu
2004-10-04 10:40
2004.10.24
Администрирование NT: Скрытые расшаренные диски


6-1092786204
Лев Ландау
2004-08-18 03:43
2004.10.24
Как достать название страницы из WebBrowsera ?


3-1096293073
AlexanderSK
2004-09-27 17:51
2004.10.24
Отключение от сервера БД


1-1097061914
Russel
2004-10-06 15:25
2004.10.24
Установка старого компонента