この発言は
#00310　佐藤　充男　　　さんのACCESS97、OLE ビットマップ表示
に対するコメントです




 こんにちは。
 ちょうどこの辺で悩んでいまして、一応動くものができましたので改善案と
して書き込ませていただきます。
 ビットマップだけでなく、メタファイルの表示もします。結果、OLEオブジェ
クトとして、挿入されたEXCELやらWORDやらの内容も表示できると思います。

----------------------------------------------------------------------------
const
    OT_LINK     = 1;
    OT_EMBEDDED = 2;
    OT_STATIC   = 3;
type
    { この構造体の参考資料 ... VC++のSamples\mfc\daoctl\accspict\accsctl.h }
    TOLEOBJECTHEADER = packed record
        typ:      WORD;    { タイプシグニチャ($1C15)                          }
        cbHdr:    WORD;    {  sizeof(TOLEOBJECTHEADER) + cchName + cchClass   }
            lobjType: Longint; { OLEオブジェクト型
                             (OT_STATIC, OT_LINKED, OT_EMBEDDED)              }
            cchName:  WORD;{ オブジェクト名のキャラクタ数(CchSz(szName) + 1)) }
            cchClass: WORD;{ クラス名のキャラクタ数(CchSz(szClss) + 1))       }
            ibName:   WORD;{ オブジェクト名オフセット(sizeof(OLEOBJECTHEADER) }
            ibClass:  WORD;{ クラス名オフセット(ibName + cchName)             }
            ptSize: TPoint;{ オブジェクトのオリジナルサイズ(MM_HIMETRIC)      }
    end;

{ AccessのOLEフィールドの内容からTGraphicを取得します }
function GetGraphicFromAccessOLE(Stream: TStream): TGraphic;

    { Bitmapを取得します }
    procedure GetBitmap(DataSize: Longint);
    begin
        try
            Result := TBitmap.Create;
            Result.LoadFromStream(Stream);
            exit;
        except
            Result.Free;
            Result := nil;
        end;
    end;

    { Metafileを取得します }
    procedure GetMetafile(DataSize: Longint);
    type
        TUnknownHeader = packed record { よくわからないヘッダ }
            Key: WORD;
            X: WORD;
            Y: WORD;
            Unknown: WORD;
        end;
    var
        Header: TUnknownHeader;
        Bits: TMemoryStream;
        Handle: HEnhMetafile;
        MetafilePict: TMetafilePict;
    begin
        { よくわからない独自ヘッダ部を取得 }
        Stream.ReadBuffer(Header, sizeof(Header));
        Inc(DataSize, -sizeof(Header));

        { Keyは常に$0008らしい }
        if Header.Key <> $0008 then exit;

        { MetafilePict構造体を作成 }
        with MetafilePict do
        begin
            mm := MM_ANISOTROPIC;
            xExt := Header.X;
            yExt := Header.Y;
            hMF := 0;
        end;

        { メタファイルデータをメモリに取得 }
        Bits := TMemoryStream.Create;
        Bits.SetSize(DataSize);
        Bits.CopyFrom(Stream, DataSize);

        { メタファイルハンドルを作成 }
        Handle := SetWinMetafileBits(DataSize, Bits.Memory, 0, MetafilePict);
        Bits.Free;
        if Handle = 0 then exit;

        { TMetafileオブジェクトを作成 }
        Result := TMetafile.Create;
        TMetafile(Result).Handle := Handle;
    end;

    { 複数個入っているデータのうち適当なものからBitmapかMetafileを作成します }
    procedure ReadData;
    var
        Signature: DWORD; { 各データに同じシグニチャ($501)がある     }
        NameSize: DWORD;  { データ名称サイズ                         }
        NameBuffer: array[0..1023] of Char;
                          { データ名称バッファ(充分かどうか知らない) }
        DataSize: DWORD;  { データサイズ                             }
        SavePosition: Longint;
    begin
        try
            while True do
            begin
                { データのシグニチャを確認 }
                Stream.ReadBuffer(Signature, Sizeof(DWORD));
                if Signature <> $501 then exit;

                { 次の４バイトの意味わかりません、スキップ }
                Stream.Seek(4, soFromCurrent);

                { データの名称を取得 }
                Stream.ReadBuffer(NameSize, Sizeof(DWORD));
                Stream.ReadBuffer(NameBuffer, NameSize);
                { 名前をみたい人はこうしてください
                  NameBufferに入ってる文字列はヌルターミネイトされています
                ShowMessage('Data Name: ' + String(NameBuffer));
                }

                { 次の８バイトの意味わかりません、スキップ }
                Stream.Seek(8, soFromCurrent);

                { データサイズを取得 }
                Stream.ReadBuffer(DataSize, Sizeof(DataSize));

                { データを取得 }
                SavePosition := Stream.Position;
                if String(NameBuffer) = 'PBrush' then
                    GetBitmap(DataSize)
                else if String(NameBuffer) = 'METAFILEPICT' then
                    GetMetafile(DataSize);

                { 取得できたら終了 }
                if Result <> nil then exit;

                { 次の読み位置をセット }
                Stream.Position := SavePosition + DataSize;
            end;
        except
        end;
    end;

    { OLEヘッダを確認します }
    function ReadHeader: Boolean;
    var
        ObjHeader: TOLEObjectHeader;
        NameBuffer: array[0..1023] of Char; { これで充分かどうか知りません }
    begin
        Result := False;

        Stream.ReadBuffer(ObjHeader, Sizeof(ObjHeader));

        if ObjHeader.typ <> $1C15 then exit;

        { 名前を確認したい人はこれを使ってください
          NameBufferに入る文字列はヌルターミネイトされています
        Stream.Position := ObjHeader.ibName;
        Stream.ReadBuffer(NameBuffer, ObjHeader.cchName);
        ShowMessage('Object Name: ' + String(NameBuffer));

        Stream.Position := ObjHeader.ibClass;
        Stream.ReadBuffer(NameBuffer, ObjHeader.cchClass);
        ShowMessage('Object Class: ' + String(NameBuffer));
        }

        Stream.Position := ObjHeader.cbHdr;
        Result := True;
    end;
begin
    Result := nil;
    if not ReadHeader then exit;
    ReadData;
end;

-----------------------------------------------------------------------------

 使い方はこんな感じ。。。

procedure TForm1.Button1Click(Sender: TObject);
var
    Stream: TBlobStream;
    Graphic: TGraphic;
begin
    Stream := TBlobStream.Create(
                 Table1.FieldByName('写真') as TBlobField, bmRead);
    Graphic := GetGraphicFromAccessOLE(Stream);
    if Graphic <> nil then PaintBox1.Canvas.Draw(0, 0, Graphic);
    Graphic.Free;
    Stream.Free;
end;

                             98/01/11(日) ytm PAF03212@niftyserve.or.jp
                             http://www.geocities.com/SiliconValley/Peaks/8273/

Original document by ytm             氏 ID:(PAF03212)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。