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

Вниз

Добавление тектса из одного 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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.033 c
14-1096746388
Guest
2004-10-02 23:46
2004.10.24
Как запускать ярлыки на музыкальные или видео файлы


1-1097584979
NewDelpher
2004-10-12 16:42
2004.10.24
свойство Items класса TList


1-1097513743
Shved
2004-10-11 20:55
2004.10.24
Путь к файлам


14-1097066132
Igorek
2004-10-06 16:35
2004.10.24
Отладка многопоточных приложений в Дельфи / Билдере


14-1096545021
1008
2004-09-30 15:50
2004.10.24
Существует ли возможность изменить цвет заголовка у TabSheet?





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский