Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 26.01.2012, 11:44
nikitos10 nikitos10 вне форума
Прохожий
 
Регистрация: 16.01.2012
Сообщения: 11
Репутация: 10
По умолчанию Конвертирование BMP в RTF

Нашел такой код
Код:
function BitmapToRTF(pict: TBitmap): string;
var
  bi, bb, rtf: string;
  bis, bbs: Cardinal;
  achar: ShortString;
  hexpict: string;
  I: Integer;
begin
  GetDIBSizes(pict.Handle, bis, bbs);
  SetLength(bi, bis);
  SetLength(bb, bbs);
  GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
  rtf := '{\rtf1 {\pict\dibitmap0 ';
  SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
  I := 2;
  for bis := 1 to Length(bi) do
  begin
    achar := IntToHex(Integer(bi[bis]), 2);
    hexpict[I - 1] := achar[1];
    hexpict[i] := achar[2];
    Inc(I, 2);
  end;
  for bbs := 1 to Length(bb) do
  begin
    achar := IntToHex(Integer(bb[bbs]), 2);
    hexpict[I - 1] := achar[1];
    hexpict[i] := achar[2];
    Inc(I, 2);
  end;
  rtf := rtf + hexpict + ' }}';
  Result := rtf;
end;
Вылетает ошибка access violation 0044DB85 at address in module project1.exe Read of address 0000000
Ответить с цитированием
  #2  
Старый 26.01.2012, 12:44
Vocabulary Vocabulary вне форума
Новичок
 
Регистрация: 17.09.2009
Сообщения: 85
Репутация: 9
По умолчанию

Функция работает нормально. Протестировано.
Может быть объект-параметр не создается перед передачей его в функцию.
Ответить с цитированием
  #3  
Старый 26.01.2012, 12:49
nikitos10 nikitos10 вне форума
Прохожий
 
Регистрация: 16.01.2012
Сообщения: 11
Репутация: 10
По умолчанию

Ты прав
У значит проблема в следующем
у меня bmp изображения подключены через ресурсы
как мне теперь вставить их в эту функцию?!
Ответить с цитированием
  #4  
Старый 26.01.2012, 13:06
nikitos10 nikitos10 вне форума
Прохожий
 
Регистрация: 16.01.2012
Сообщения: 11
Репутация: 10
По умолчанию

Теперь здесь застривает
Код:
GetDIBSizes(pict.Handle, bis, bbs);
Я здесь что-то указать должен да?А что?
Ответить с цитированием
  #5  
Старый 26.01.2012, 21:54
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Содранная вами с DelphiWorld процедура несколько не полна.
Вот полный её код:
Код:
uses
   RichEdit;

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

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

// RichEdit Type 
type
   TMyRichEdit = TRxRichEdit;

// EditStreamInCallback callback function 
function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): DWORD; stdcall;
// by P. Below 
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);
   // by P. Below 
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;

// Convert Bitmap to RTF Code 
function BitmapToRTF(pict: TBitmap): string;
// by D3k 
var
   bi, bb, rtf: string;
   bis, bbs: Cardinal;
   achar: ShortString;
   hexpict: string;
   I: Integer;
begin
   GetDIBSizes(pict.Handle, bis, bbs);
   SetLength(bi, bis);
   SetLength(bb, bbs);
   GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
   rtf := '{\rtf1 {\pict\dibitmap ';
   SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
   I := 2;
   for bis := 1 to Length(bi) do
   begin
     achar := Format('%x', [Integer(bi[bis])]);
     if Length(achar) = 1 then
       achar := '0' + achar;
     hexpict[I - 1] := achar[1];
     hexpict[i] := achar[2];
     Inc(I, 2);
   end;
   for bbs := 1 to Length(bb) do
   begin
     achar := Format('%x', [Integer(bb[bbs])]);
     if Length(achar) = 1 then
       achar := '0' + achar;
     hexpict[I - 1] := achar[1];
     hexpict[i] := achar[2];
     Inc(I, 2);
   end;
   rtf := rtf + hexpict + ' }}';
   Result := rtf;
end;


// Example to insert image from Image1 into RxRichEdit1 
procedure TForm1.Button1Click(Sender: TObject);
var
   SS: TStringStream;
   BMP: TBitmap;
begin
   BMP := TBitmap.Create;
   BMP := Image1.Picture.Bitmap;
   SS  := TStringStream.Create(BitmapToRTF(BMP));
   try
     PutRTFSelection(RxRichEdit1, SS);
   finally
     SS.Free;
   end;
end;
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #6  
Старый 27.01.2012, 10:10
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

это для вставки картинок в RichEdit я понял? по секрету скажу: в IRichEditOle есть метод InsertObject.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Комбинированный вид Комбинированный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 02:13.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025