Работа с *.rtf документами в Delphi

[KISLOTnick]

Здраствуйте уважаемые программисты, я столкнулся с проблемой, хочу попросить помощи. Проблема заключается в следуещем: при создании програмы для просмотра и сохранения *.rtf документов, которые включают в себя рисунки, я пользовался richedit-ом, а он не отображает, рисуеки, только текст. С помощю какого компонента я смогу отобразить и редактировать текст, и видеть, вставлять и удалять из него рисунки? Заранее спасибо!(вариант с Webbrowserom не катит, он использует приложения офиса, а есле офис не установлен, то и документ соответственно не отображается!)

 

[Barmutik]

Можно попробовать использовать расширенный компонент аля TRichEdit .. например TRichView... он позволяет просматривать рисунки.. я думаю что его Вы сможете найти на просторах интернета .. или аналогичные ему...

 

[KISLOTnick]

А не подскажеш где можна скачать бесплатно этот компонент?

 

[Barmutik]

100% не скажу .. но можно на delphipages or torry поискать ..

Если уже совсем не найдёте то сообщите я поищу в своих архивах .. были проекты его использующие...

 

[KISLOTnick]

Спасибо, действительно нашел такой компонент на сайте, только вот еще проблемкаобразоваласт, он не хочет открывать файлы через "lines.LoadFromFile", при попытке выдает сообщение о том что доступ файла проетка к одному из адресов памяти вызвал ошибку. Не знаете в чем дело?

 

[Barmutik]

Мммм... точно не скажу так сходу .. но вроде ж у него там было просто загрузить .. т.е. просто Load а не Lines.LoadFromFile...

 

[KISLOTnick]

Это тоже глючит. и еще скачал RichView 0.5, бесплатная версия, а он только может отображать, а редактировать не дает. Есле можеш, пожалуйста поищи у себя, БАКАЛ горит. Заранее благадарен!

 

[zubr]

Вот так можно вставить картинку в формате Bitmap в позицию курсора в TRichEdit:

re_bmp.pas
unit re_bmp;

interface

uses Windows;

procedure InsertBitmapToRE(Wnd:HWND; Bmp:HBITMAP);

implementation

uses Activex, RichEdit;

const
IID_IDataObject: TGUID = (
D1:$0000010E;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IOleObject: TGUID = (
D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));

REO_CP_SELECTION	= ULONG(-1);
REO_IOB_SELECTION  = ULONG(-1);
REO_GETOBJ_POLEOBJ = $00000001;

type
TReobject = record
cbStruct: DWORD;
cp: ULONG;
clsid: TCLSID;
poleobj: IOleObject;
pstg: IStorage;
polesite: IOleClientSite;
sizel: TSize;
dvAspect: Longint;
dwFlags: DWORD;
dwUser: DWORD;
end;

type
IRichEditOle = interface(IUnknown)
['{00020d00-0000-0000-c000-000000000046}']
function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
function GetObjectCount: HResult; stdcall;
function GetLinkCount: HResult; stdcall;
function GetObject(iob: Longint; out reobject: TReObject;
dwFlags: DWORD): HResult; stdcall;
function InsertObject(var reobject: TReObject): HResult; stdcall;
function ConvertObject(iob: Longint; rclsidNew: TIID;
lpstrUserTypeNew: LPCSTR): HResult; stdcall;
function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
function SetHostNames(lpstrContainerApp: LPCSTR;
lpstrContainerObj: LPCSTR): HResult; stdcall;
function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall;
function HandsOffStorage(iob: Longint): HResult; stdcall;
function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
function InPlaceDeactivate: HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
function GetClipboardData(var chrg: TCharRange; reco: DWORD;
out dataobj: IDataObject): HResult; stdcall;
function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
hMetaPict: HGLOBAL): HResult; stdcall;
end;

TImageDataObject=class(TInterfacedObject,IDataObject)
private
FBmp:HBITMAP;
FMedium:TStgMedium;
FFormatEtc: TFormatEtc;
procedure SetBitmap(bmp:HBITMAP);
function GetOleObject(OleClientSite:IOleClientSite; Storage:IStorage):IOleObject;
destructor Destroy;override;

// IDataObject
function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
HResult; stdcall;
function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
HResult; stdcall;
function QueryGetData(const formatetc: TFormatEtc): HResult;
stdcall;
function GetCanonicalFormatEtc(const formatetc: TFormatEtc;
out formatetcOut: TFormatEtc): HResult; stdcall;
function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
fRelease: BOOL): HResult; stdcall;
function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
IEnumFormatEtc): HResult; stdcall;
function DAdvise(const formatetc: TFormatEtc; advf: Longint;
const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
function DUnadvise(dwConnection: Longint): HResult; stdcall;
function EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
stdcall;
public
procedure InsertBitmap(wnd:HWND; Bitmap:HBITMAP);
end;


{ TImageDataObject }

function TImageDataObject.DAdvise(const formatetc: TFormatEtc; advf: Integer;
const advSink: IAdviseSink; out dwConnection: Integer): HResult;
begin
Result:=E_NOTIMPL;
end;

function TImageDataObject.DUnadvise(dwConnection: Integer): HResult;
begin
Result:=E_NOTIMPL;
end;

function TImageDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
begin
Result:=E_NOTIMPL;
end;

function TImageDataObject.EnumFormatEtc(dwDirection: Integer;
out enumFormatEtc: IEnumFormatEtc): HResult;
begin
Result:=E_NOTIMPL;
end;

function TImageDataObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc;
out formatetcOut: TFormatEtc): HResult;
begin
Result:=E_NOTIMPL;
end;

function TImageDataObject.GetDataHere(const formatetc: TFormatEtc;
out medium: TStgMedium): HResult;
begin
Result:=E_NOTIMPL;
end;

function TImageDataObject.QueryGetData(const formatetc: TFormatEtc): HResult;
begin
Result:=E_NOTIMPL;
end;

destructor TImageDataObject.Destroy;
begin
ReleaseStgMedium(FMedium);
end;

function TImageDataObject.GetData(const formatetcIn: TFormatEtc;
out medium: TStgMedium): HResult;
begin
medium.tymed := TYMED_GDI;
medium.hBitmap := FMedium.hBitmap;
medium.unkForRelease := nil;
Result:=S_OK;
end;

function TImageDataObject.SetData(const formatetc: TFormatEtc;
var medium: TStgMedium; fRelease: BOOL): HResult;
begin
FFormatEtc := formatetc;
FMedium := medium;
Result:= S_OK;
end;

procedure TImageDataObject.SetBitmap(bmp: HBITMAP);
var
stgm: TStgMedium;
fm:TFormatEtc;
begin
stgm.tymed := TYMED_GDI;
stgm.hBitmap := bmp;
stgm.UnkForRelease := nil;

fm.cfFormat := CF_BITMAP;
fm.ptd := nil;
fm.dwAspect := DVASPECT_CONTENT;
fm.lindex := -1;
fm.tymed := TYMED_GDI;
SetData(fm, stgm, FALSE);
end;

function TImageDataObject.GetOleObject(OleClientSite: IOleClientSite;
Storage: IStorage):IOleObject;
begin
if (Fmedium.hBitmap=0) then Result:=nil else
OleCreateStaticFromData(self, IID_IOleObject, OLERENDER_FORMAT,
@FFormatEtc, OleClientSite, Storage, Result);
end;

procedure TImageDataObject.InsertBitmap(wnd:HWND; Bitmap: HBITMAP);
var
OleClientSite:IOleClientSite;
RichEditOLE:IRichEditOLE;
Storage:IStorage;
LockBytes:ILockBytes;
OleObject:IOleObject;
reobject:TReobject;
clsid:TGUID;
begin
if (SendMessage(wnd, EM_GETOLEINTERFACE, 0, cardinal(@RichEditOle))=0) then
exit;

FBmp:=CopyImage(Bitmap,IMAGE_BITMAP,0,0,0);
if FBmp=0 then exit;
try
SetBitmap(Fbmp);
RichEditOle.GetClientSite(OleClientSite);
if (OleClientSite=nil) then exit;
CreateILockBytesOnHGlobal(0, TRUE,LockBytes);
if (LockBytes = nil) then exit;
if (StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE
or STGM_READWRITE, 0,Storage)<> S_OK) then
begin
LockBytes._Release;
exit
end;

if (Storage = nil) then exit;
OleObject:=GetOleObject(OleClientSite, Storage);
if (OleObject = nil) then exit;
OleSetContainedObject(OleObject, TRUE);

ZeroMemory(@reobject, sizeof(TReobject));
reobject.cbStruct := sizeof(TReobject);
OleObject.GetUserClassID(clsid);
reobject.clsid := clsid;
reobject.cp := REO_CP_SELECTION;
reobject.dvaspect := DVASPECT_CONTENT;
reobject.poleobj := OleObject;
reobject.polesite := OleClientSite;
reobject.pstg := Storage;

RichEditOle.InsertObject(reobject);
finally
DeleteObject(FBmp)
end
end;


procedure InsertBitmapToRE(Wnd:HWND; bmp:HBITMAP);
begin
with TImageDataObject.Create do
try
InsertBitmap(Wnd,Bmp);
finally
Free
end
end;


end.

Примеры исспользования:
uses re_bmp;

procedure TForm1.Button1Click(Sender: TObject);
begin
InsertBitmapToRE(RichEdit1.Handle,Image1.Picture.Bitmap.Handle);
end;

...

procedure TForm1.Button2Click(Sender: TObject);
var
bmp:TBitmap;
begin
if (not OpenPictureDialog1.Execute) then exit;
bmp:=TBitmap.Create;
try
bmp.LoadFromFile(OpenPictureDialog1.Filename);
InsertBitmapToRE(RichEdit1.Handle,bmp.Handle);
finally
bmp.Free
end
end;

Таким же образом можно вставлять картинки не только в TRichEdit, а и в RxRichEdit, стандартный виндовый RichEdit, etc.

Пример взят с форума source.ru