Ниже приведено решение, которое я использую.Отправной точкой для этого послужили поля Ole Ms Access на сайте about.com .
Несколько замечаний:
- Кажется, что Access сохраняет объект, используя стандарт OLE1, а не OLE2.Я не смог найти никакого подтверждения этому нигде, кроме поста, упомянутого выше.
- Access добавляет свой собственный заголовок перед полем OLE1.Снова я не нашел никакой документации, кроме поста.
- Я не мог найти способ использовать объект OLE1 напрямую, мне нужно было преобразовать его в объект OLE2.Для этого мне понадобился поток OLE1, который, похоже, нигде не реализован в VCL или Win API.Реализация взята непосредственно из поста, я не могу сказать, что понимаю все, что он делает.
После того, как у вас есть объект IOLEObject, вы можете использовать функцию OleDraw для рисования на собственном холсте.В этот момент у вас есть изображение и вы работаете.Если вы просто хотите отобразить объект, вы можете использовать компонент TOLEContainer и позволить ему иметь дело с чертежом.
Вот код, который использует единицу измерения.У меня есть таблица ADO с объектом поля типа TBlobField с именем AdoTable1Photo.
procedure TForm2.ADOTable1AfterScroll(DataSet: TDataSet);
var
Bmp: TBitmap;
Jpg: TJpegImage;
OleObject: IOleObject;
DataObject: IDataObject;
CreateInfo: TCreateInfo;
begin
if AdoTable1Photo.BlobSize = 0 then
exit;
OleObject := OleFieldToObject(AdoTable1Photo);
// If you want to save out an image file draw let the ole object draw to
// a bitmap canvas and then save the results. Could be used for converting
// a field to a true image blob instead of a OLE Object type.
Bmp := TBitmap.Create();
Jpg := TJpegImage.Create();
try
DrawOleOnBmp(OleObject, Bmp);
Jpg.Assign(Bmp);
Jpg.SaveToFile('C:\temp\test.jpg');
finally
Bmp.Free;
Jpg.Free;
end;
// If just trying to display the results without converting you can attach
// the OleObject to a OleContainer component that will handle the drawing.
// I could not find an easy way to do this directly. I needed to use the
// IDataObject interace with the CreateInfo record.
if Succeeded(OleObject.QueryInterface(IDataObject, DataObject)) then
begin
// Load the OLE Container control by using the IDataObject
CreateInfo.CreateType := ctFromData;
CreateInfo.ShowAsIcon := false;
CreateInfo.DataObject := DataObject;
OleContainer.CreateObjectFromInfo(CreateInfo);
end;
OleObject := nil;
end;
А вот модуль, который преобразует поле в IOleObject.Сложная часть - извлечь поток, разделив заголовок и преобразовав его в объект OLE2.Как только это будет сделано, я использую только две функции: OLELoad и OLEDraw.
unit MSAccessOleObject;
interface
uses ActiveX, Windows, Classes, ComObj, DB, Graphics;
// This file is a modified version of the source code posted here:
// http://forums.about.com/ab-delphi/messages?lgnF=y&msg=1865.1
//-----------------------------------------------------------------------------
// Converted from Ole.h
//
// Used inside from OleConvertOLESTREAMToIStorage OLE Function
// As far I know the Access Converts the OLE2 objects in OLE1 Objects
//
// So for read this Kind of field we must covert the OLE1 format
// to OLE2 format so we need the OleConvertOLESTREAMToIStorage
// and to write an OLE object to Field we need the
// OleConvertIStorageToOLESTREAM OLE function.
// The code here is only for reading "Ole Object" fields, but it coudld adapted
// to write them as well.
//
// OLE.h define a OLE stream that uses a vtable and callback functions. I
// could not find a class in the VCL that implemented the OLE v1 Stream.
type
POleStreamVtbl = ^TOleStreamVtbl;
TOleStreamVtbl = record
Get: Pointer;
Put: Pointer;
end;
POle1Stream = ^TOle1Stream;
TOle1Stream = record
pvt: POleStreamVtbl;
lpData: Pointer; // Link to Data in .MDB file
dwSize: Integer; // OLE Stream length (relative to position)
end;
POleStream = ^TPOleStream;
TPOleStream = record
lpstbl: POleStreamVtbl;
end;
//-----------------------------------------------------------------------------
// Microsoft Access Field Header
//
// Access adds header information in front of the actual OLE stream.
// We need to read it to get the size in order to find the start of
// the actual OLE stream.
type
TKind=record
case Integer of
0: (oot: DWord); // OLE Object type code (OT_LINK, OT_EMBEDDED, OT_STATIC)
1: (lobjTyp: LongInt); // in our case: OT_EMBEDDED
end;
PAccessOleObjectHeader=^TAccessOleObjectHeader;
TAccessOleObjectHeader = record
typ: WORD; // Type signature (0x1C15)
cbHdr: WORD; // sizeof(struct OLEOBJECTHEADER) + cchName +cchClass
lobjType: TKind; // OLE Object Type Code (OT_STATIC, OT_LINKED,OT_EMBEDDED)
cchName: WORD; // Count of characters in object Name (CchSz(szName) + 1))
cchClass: WORD; // Count of characters in class Name (CchSz(szClss) + 1))
ibName: WORD; // Offset of object name in structure (sizeof(OLEOBJECTHEADER)
ibClass: WORD; // Offset of class name in structure (ibName +cchName)
ptSize: TSmallPoint; // Original size of Object (MM_HIMETRIC)
end;
function CreateOle1Stream(pStm: IStream; dwSize: Integer): POle1Stream;
procedure DeleteOle1Stream(var Ole1Stream: POle1Stream);
// Callback Functions for OLE1 Stream
function Get(OleStream: POLESTREAM; Pb:Pointer; cb:Integer): Integer; stdcall;
function Put(OleStream: POLESTREAM; const Pb:Pointer; cb:Integer): Integer; stdcall;
function OleFieldToObject(AdoField: TBlobField): IOleObject;
procedure DrawOleOnBmp(Ole: IOleObject; Bmp: TBitmap);
implementation
uses Sysutils;
{
CreateOle1Stream
---------------------------------------------------------------------------
}
function CreateOle1Stream(pStm:IStream; dwSize:Integer): POLE1Stream;
var
cb: Int64;
begin
Result := new(POle1Stream);
Result.pvt := new(POleStreamVtbl);
Result.pvt.Get := @Get;
Result.pvt.Put := @Put;
Result.dwSize := dwSize;
Result.lpData := Pointer(pStm);
// Seek to the start of the stream
IStream(Result.lpData).Seek(0,STREAM_SEEK_SET,cb);
end;
{
DeleteOle1Stream
---------------------------------------------------------------------------
}
procedure DeleteOle1Stream(var Ole1Stream: POle1Stream); // Dispose then OLE1 Stream
begin
if Ole1Stream = Nil then
exit;
Dispose(Ole1Stream^.pvt);
Dispose(Ole1Stream);
end;
{
Put
---------------------------------------------------------------------------
Callback function for Ole1Stream
}
function Put(OleStream: POLESTREAM; const Pb:Pointer; cb:Integer): Integer; stdcall;
Var
pStream: POle1Stream;
ulBytesWritten: longInt;
begin
pStream:=POle1Stream(OleStream);
if (pStream = Nil) or (pStream^.lpData=Nil) or (pb=Nil) then
begin
Result:=0;
exit;
end;
ulBytesWritten:=0;
if IStream(pStream^.lpData).Write(Pb,cb,@ulBytesWritten) <> S_OK then
begin
Result:=0;
exit;
end;
pStream^.dwSize:=pStream^.dwSize+ulBytesWritten;
Result:=cb;
end;
{
Get
---------------------------------------------------------------------------
Callback function for Ole1Stream
}
function Get(OleStream: POLESTREAM; Pb: Pointer; cb: Integer): Integer; stdcall;
Var
pStream: POle1Stream;
ulBytesRead: LongInt;
begin
pStream := POle1Stream(OleStream);
if (pStream=Nil) or (pStream^.lpData=Nil) or (pStream^.dwSize < cb)
then
begin
Result := 0;
exit;
end;
ulBytesRead := 0;
if IStream(pStream^.lpData).Read(pb, cb, @ulBytesRead) <> S_OK then
begin
Result := 0;
exit;
end;
pStream^.dwSize := pStream^.dwSize-ulBytesRead;
Result := cb;
end;
{
OleFieldToObject
---------------------------------------------------------------------------
Pass in the ADO field of the "OLE Object" type and get the IOleObject
interface back. You can then attached that object to a OleContanier and
let it draw itself or use the DrawOleOnBmp function to get your own bitmap
that can be used by itself.
}
function OleFieldToObject(AdoField: TBlobField): IOleObject;
var
AccessHeader: TAccessOleObjectHeader;
FullAdoStream: TMemoryStream;
ObjectStream: TMemoryStream;
StreamAdapter: TStreamAdapter;
StreamInterface: IStream;
Ole1Stream: POle1Stream;
OleBytes: ILockBytes;
OleStorage: IStorage;
OleObject: IOleObject;
begin
FullAdoStream := nil;
ObjectStream := nil;
StreamAdapter := nil;
StreamInterface := nil;
Ole1Stream := nil;
try
// We need a IStorage Interface that will be used to load the OLEObject
OleCheck( CreateILockBytesOnHGlobal(0, true, OleBytes) );
OleCheck( StgCreateDocfileOnILockBytes(OleBytes,
STGM_Create or STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_DIRECT, 0, OleStorage) );
// We need to get the data out of the field. Microsoft Access stores a OLE1 field
// and not the current OLE2 format. It also adds it's own header on the object.
// We need to - extract the stream, remove the header, wrap the stream in an
// IStreamInterface, wrap that inside and OLE1Stream object.
FullAdoStream := TMemoryStream.Create();
AdoField.SaveToStream(FullAdoStream);
FullAdoStream.Seek(0, soBeginning);
FullAdoStream.ReadBuffer(AccessHeader, sizeof(TAccessOleObjectHeader));
// We could check if AccessHeader.typ = $1C15 but if the format is not
// right something will go wrong later.
// Seek past the header and then copy the rest of the stream to a new stream.
FullAdoStream.Seek(AccessHeader.cbHdr, soBeginning);
ObjectStream := TMemoryStream.Create();
ObjectStream.CopyFrom(FullAdoStream, FullAdoStream.Size - FullAdoStream.Position);
StreamAdapter := TStreamAdapter.Create(ObjectStream, soReference);
StreamInterface := StreamAdapter as IStream;
Ole1Stream := CreateOle1Stream(StreamInterface, ObjectStream.Size);
// Now convert the OLE1 stream to OLE2 (IStorage) and load the IOleObject
// This function seems to be slow, but I can't find anything to change
// or any other function to use.
OleCheck( OleConvertOLESTREAMToIStorage(Ole1Stream, OleStorage, Nil) );
OleCheck( OleLoad(OleStorage, IOleObject, nil, OleObject) );
finally
DeleteOle1Stream(Ole1Stream);
StreamInterface := nil;
StreamAdapter := nil;
ObjectStream.Free;
FullAdoStream.Free;
end;
result := OleObject;
end;
{
DrawOleOnBmp
---------------------------------------------------------------------------
Take a OleObject and draw it to a bitmap canvas. The bitmap will be sized
to match the normal size of the OLE Object.
}
procedure DrawOleOnBmp(Ole: IOleObject; Bmp: TBitmap);
var
ViewObject2: IViewObject2;
ViewSize: TPoint;
AdjustedSize: TPoint;
DC: HDC;
R: TRect;
begin
if Succeeded(Ole.QueryInterface(IViewObject2, ViewObject2)) then
begin
ViewObject2.GetExtent(DVASPECT_CONTENT, -1, nil, ViewSize);
DC := GetDC(0);
AdjustedSize.X := MulDiv(ViewSize.X, GetDeviceCaps(DC, LOGPIXELSX), 2540);
AdjustedSize.Y := MulDiv(ViewSize.Y, GetDeviceCaps(DC, LOGPIXELSY), 2540);
ReleaseDC(0, DC);
Bmp.Height := AdjustedSize.Y;
Bmp.Width := AdjustedSize.X;
SetRect(R, 0, 0, Bmp.Width, Bmp.Height);
OleDraw(Ole, DVASPECT_CONTENT, Bmp.Canvas.Handle, R);
end
else
begin
raise Exception.Create('Could not get the IViewObject2 interfact on the OleObject');
end;
end;
end.