[ 394_OLE コンテナにビットマップ画像を表示 ]

Delphi Programming / Object Pascal

[掲載 2018年10月26日] [更新 2018年10月28日]　Delphi サンプルプログラム集

394_OLE コンテナにビットマップ画像を表示
動作確認等	Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32

394_Bitmap_OleContainer.zip　[1,733 KB]　2018年10月28日版 (EXE 同梱)

OLE オブジェクトとしてのビットマップ画像
01_TOleContainer にビットマップ画像を読み込んで保存
02_フォーマット識別子を利用する OLE オブジェクトの保存
03_ワード文書にビットマップ画像を OLE オブジェクトとして挿入
04_TRichEdit にビットマップ画像を OLE オブジェクトとして挿入

OLE オブジェクトとしてのビットマップ画像

OLE オブジェクトとしてビットマップ画像を TOleContainer コントロールまたはワードの文書に埋め込むサンプルです．
OLE オブジェクトのビットマップ画像は，ペイントブラシのオブジェクトとして扱われます．

参考リンク
[390_OLE コンテナにエクセルを表示]

01_TOleContainer にビットマップ画像を読み込んで保存

実行時に TOleContainer コントロール (OLE コントロール) にビットマップ画像を表示し，そのビットマップ画像を保存するサンプルです．
設計時の操作については AFsoft さんのサイトに解説記事があります．

図1
設計時の画面

[挿入] ボタンをクリックすると，添付のビットマップ画像を読み込んで TOleContainer に挿入して表示します．ビットマップ以外の画像は表示できません．アイコン表示となります．

図2
[挿入]

添付のビットマップ画像を表示

[保存] ボタンをクリックすると，表示中のビットマップ画像を保存します．
TOleContainer にビットマップ画像を表示すると，それはペイントブラシ (通称 Paint あるいはペイント) の OLE オブジェクトとなります．このペイントブラシは COM アプリですが，COM インターフェイスとしてのメソッドやプロパティ等は実装されていません．
そこで，IViewObject2 インターフェイスを使用してビットマップデータを取得します．このビットマップの取得のコードは，以下の最初のリンクの記事に掲載されているコードを利用しています．

図3
[保存] した結果

dest.bmp という名前で保存

[編集] ボタンをクリックするとペイントブラシが起動します．ペイントブラシを閉じると，ペイントブラシで編集した内容が反映されます．

	図4 [編集] ボタンをクリックペイントブラシが起動する
	図5 ペイントブラシを閉じると編集結果が反映される

[情報] ボタンをクリックすると，COM アプリケーションとしての名前や GUID 値，あるいは ProgID の値等を取得して表示します．

図6
[情報] ボタンをクリック

[備考]
ペイントブラシのオブジェクトのインスタンスは，CreateOleObject や CreateComObject で生成できません．これらの関数でインスタンスが生成可能なのは VersionIndependentProgID の値が定義されているオブジェクトだけです．したがって，TOleContainer.OleObject でもインスタンスを取得することはできません．
つまり，ペイントブラシの画像には，COM オブジェクトとして，外部から操作可能なプロパティやメソッドは存在しません．

参考リンク
[400] [05_CreateOLEObject 関数で生成可能なオブジェクト]

リスト1
実行時に TOleContainer にビットマップ画像を読み込んで別名保存

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleServer, Vcl.OleCtnrs,
  Vcl.StdCtrls, Vcl.ExtCtrls, ActiveX;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    OleContainer1: TOleContainer;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  procedure DrawOleOnBmp(AOleObj: IOleObject; ABmp: TBitmap);

var
  Form1: TForm1;

implementation

uses
  System.Win.ComObj;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
  Panel2.Caption := '';

  OleContainer1.AutoVerbMenu := False;
end;

//=============================================================================
//  [挿入]
//  ビットマップ画像を読み込んでTOleContainerに表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath : string;
begin
  OleContainer1.SizeMode := smClip;
  LFilePath := ExpandFileName('.\Images\HANDSHAK.BMP');
  OleContainer1.CreateObjectFromFile(LFilePath, False);
end;


//=============================================================================
//  [保存]
//  TOleContainerに表示中のビットマップ画像を保存
//  ペイントブラシにはSaveAs等のメソッドは実装されていない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFilePath : string;
  LBitmap   : TBitmap;
begin
  // OleContainer1.State = osEmpty でも検出可能
  if OleContainer1.State = osEmpty then exit;

  OleContainer1.UpdateObject;

  LFilePath := ExpandFileName('.\dest.bmp');
  LBitmap   := TBitmap.Create;
  try
    DrawOleOnBmp(OleContainer1.OleObjectInterface, LBitmap);
    LBitmap.SaveToFile(LFilePath);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  [編集]
//  ペイントブラシ(MSPaint.exe)を起動して編集
//  編集結果はTOleContainerに反映される
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if OleContainer1.State = osEmpty then exit;

  OleContainer1.DoVerb(ovOpen);
end;

//=============================================================================
//  [情報]
//  オブジェクトの各種情報を取得
//  usesにActiveX,ComObjが必要
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  IOleObjectからアプリ名等を取得
  //---------------------------------------------------------------------------
  function GetOleObjectAppName(const OleObject: IOleObject;
    AType: Integer): string;
  var
    LAppName: PWideChar;
  begin
    OleCheck(OleObject.GetUserType(AType, LAppName));
    try
      Result := LAppName;
    finally
      CoTaskMemFree(LAppName);
    end;
  end;
  //---------------------------------------------------------------------------

var
  LIOleObject : IOleObject;
  LStrList    : TStringList;
  LClassID    : TGUID;
begin
  if OleContainer1.State = osEmpty then exit;

  // IOleObjectのインターフェイスを取得
  LIOleObject := OleContainer1.OleObjectInterface;

  LStrList := TStringList.Create;
  try
     // アプリ名を取得
    LStrList.Add(GetOleObjectAppName(LIOleObject, USERCLASSTYPE_APPNAME));
    LStrList.Add(GetOleObjectAppName(LIOleObject, USERCLASSTYPE_FULL));
    LStrList.Add(GetOleObjectAppName(LIOleObject, USERCLASSTYPE_SHORT));

    // GUID値を取得してProgIDの値を取得
    LIOleObject.GetUserClassID(LClassID);

    LStrList.Add(GUIDToString(LClassID));
    LStrList.Add(ClassIDToProgID(LClassID));

    MessageBox(Handle, PChar(LStrList.Text), '情報', MB_ICONINFORMATION);
  finally
    FreeAndNil(LStrList);
  end;
end;

//-----------------------------------------------------------------------------
//  IOleObjectからTBitmap画像を取得する
//  AOleObj := TOleContainer.OleObjectInterface
//
//  usesにActiveXが必要
//-----------------------------------------------------------------------------
procedure DrawOleOnBmp(AOleObj: IOleObject; ABmp: TBitmap);
var
  LViewObject2 : IViewObject2;
  LViewSize    : TPoint;
  LAdjustSize  : TPoint;
  LHDC         : HDC;
  LDrawRect    : TRect;
begin
  // IViewObject2インターフェイス取得
  if Succeeded(AOleObj.QueryInterface(IViewObject2, LViewObject2)) then begin
    // OLE上での描画サイズを取得
    LViewObject2.GetExtent(DVASPECT_CONTENT, -1, nil, LViewSize);

    // 画像のサイズをピクセル単位に変換
    LHDC := GetDC(0);
    LAdjustSize.X := MulDiv(LViewSize.X, GetDeviceCaps(LHDC, LOGPIXELSX), 2540);
    LAdjustSize.Y := MulDiv(LViewSize.Y, GetDeviceCaps(LHDC, LOGPIXELSY), 2540);
    ReleaseDC(0, LHDC);

    // ビットマップのサイズ
    ABmp.SetSize(LAdjustSize.X, LAdjustSize.Y);
    // 描画の矩形領域設定
    SetRect(LDrawRect, 0, 0, ABmp.Width, ABmp.Height);

    // TBitmap.Canvasへの描画
    OleDraw(AOleObj, DVASPECT_CONTENT, ABmp.Canvas.Handle, LDrawRect);
  end
end;

end.

02_フォーマット識別子を利用する OLE オブジェクトの保存

ファイルの先頭部分に，いわゆるマジックナンバーと呼ばれる，そのファイル特有の識別子が記録されていることがあります．これを利用して TOleContainer に挿入して表示しているオブジェクトを保存することができることがあります．

TOleContainer.SaveToStream でオブジェクトをメモリストリームに格納します．その中からフォーマット識別子の値を検索します．そのフォーマット識別子以降のデータだけをファイルに保存するという方法です．以下はそのための関数のコードです．
エクセルの xls ファイル，ビットマップ画像と PDF 文書についてだけ動作を確認しています．

リスト2
フォーマット識別子を利用して OLE オブジェクトを保存するためのコード例

//-----------------------------------------------------------------------------
//  フォーマット識別子を利用してTOleContainerのオブジェクトを保存する関数
//
//  AOleContainer : 対象のオブジェクトを挿入表示しているTOleContainer
//  AProgID       : そのオブジェクトのProgIDの値
//  ASaveFilePath : 保存ファイルのフルパス名
//
//  戻り値は保存したバイト数．失敗すると-1を返す
//-----------------------------------------------------------------------------
function SaveOleContainerObject(AOleContainer: TOleContainer;
  AProgID: string; ASaveFilePath: string): Int64;

  //---------------------------------------------------------------------------
  //  関数内の関数
  //  ストリーム内に指定したバイトれ値の値が存在するかを確認する関数
  //  存在すればその位置を返す．失敗すると-1を返す
  //---------------------------------------------------------------------------
  function FindBytesPos(AStream: TBytesStream; AFindArray: TBytes): Int64;
  var
    LDataBytes : TBytes;
    LIndex     : Integer;
    LIndexByte : Integer;
    LRetFlag   : Boolean;
  begin
    Result := 0;

    SetLength(LDataBytes, Length(AFindArray));

    for LIndex := 0 to AStream.Size - SizeOf(LDataBytes) - 1 do begin
      AStream.Position := Result;
      AStream.Read(LDataBytes, Length(LDataBytes));

      LRetFlag := True;
      for LIndexByte := 0 to Length(LDataBytes) - 1 do begin
        if LDataBytes[LIndexByte] <> AFindArray[LIndexByte] then begin
          LRetFlag := False;
          Break;
        end;
      end;
      if LRetFlag then Exit;
      inc(Result);
    end;
    Result := -1;
  end;
  //---------------------------------------------------------------------------

var
  LFileStream  : TFileStream;
  LDataStream  : TBytesStream;
  LSigIpos     : Integer;
  LSearchBytes : TBytes;
  LCopySize    : Int64;
  LiPos        : Integer;
  LExceVer     : Double;
begin
  Result   := 0;
  LSigIpos := -1;

  LDataStream := TBytesStream.Create;
  try
    AOleContainer.SaveToStream(LDataStream);
    try
      // Excelの場合
      if ContainsText(AProgID, 'Excel.Sheet') then begin
        LiPos := Pos('excel.sheet', LowerCase(AProgID));
        if LiPos > 0 then begin
          LExceVer := StrToFloat(Copy(AProgID, LiPos + 12, Length(AProgID)));
          // Excel 2003以前(xlsファイル - OLE2形式)
          if Trunc(LExceVer) < 12 then begin
            SetLength(LSearchBytes, 8);
            LSearchBytes[0] := $D0;
            LSearchBytes[1] := $CF;
            LSearchBytes[2] := $11;
            LSearchBytes[3] := $E0;
            LSearchBytes[4] := $A1;
            LSearchBytes[5] := $B1;
            LSearchBytes[6] := $1A;
            LSearchBytes[7] := $E1;

            LSigIpos := FindBytesPos(LDataStream, LSearchBytes);
          end;
        end;
      end else
      // PDF文書
      if ContainsText(AProgID, 'Acro')
          and ContainsText(AProgID, 'Document') then begin
        SetLength(LSearchBytes, 5);
        LSearchBytes[0] := Byte('%');
        LSearchBytes[1] := Byte('P');
        LSearchBytes[2] := Byte('D');
        LSearchBytes[3] := Byte('F');
        LSearchBytes[4] := Byte('-');

        LSigIpos := FindBytesPos(LDataStream, LSearchBytes);
      end else
      // ペイントブラシの絵(ビットマップ)
      if ContainsText(AProgID, 'Paint.Picture') then begin
        SetLength(LSearchBytes, 2);
        LSearchBytes[0] := Byte('B');
        LSearchBytes[1] := Byte('M');

        LSigIpos := FindBytesPos(LDataStream, LSearchBytes);
      end;

      if LSigIpos > 0 then begin
        LFileStream := TFileStream.Create(ASaveFilePath, fmCreate);
        try
          LDataStream.Position := LSigIpos;
          LCopySize := LDataStream.Size - LDataStream.Position;
          Result    := LFileStream.CopyFrom(LDataStream, LCopySize);
        finally
          FreeAndNil(LFileStream);
        end;
      end else begin
        Result := -1;
      end;
    except
      // 失敗
    end;
  finally
    FreeAndNil(LDataStream);
  end;
end;

ProgID の値は，例えば以下のようなコードで取得できます．

参考リンク
[400] [08_CLSID と ProgID]

リスト3
ProgID の値を取得するコードの例

function GetProgIDStr(OleContainer: TOleContainer): string;
var
  LIOleObject : IOleObject;
  LClassID    : TGUID;
begin
  LIOleObject := OleContainer.OleObjectInterface;
  LIOleObject.GetUserClassID(LClassID);
  Result := ClassIDToProgID(LClassID);
end;

ネット上に IDataObject インターフェイスを使用したビットマップ取得のサンプルがありましたので掲載しておきます．筆者はビットマップ以外でのテストはしていません．

リスト4
IDataObject インターフェイスを使用した OLE ビットマップの取得

//-----------------------------------------------------------------------------
//  IDataObjectからTOleContainerに表示中のビットマップを取得
//  IDataObjectはDrag & Dropの実装に使用されている
//
//  ビットマップ以外はTFormatEtcレコードのメンバに適切な値を設定する必要がある
//  TFormatEtcのメンバの設定により，HGlobalあるいはIStreamから取得
//
//  usesにAxtiveXが必要
//-----------------------------------------------------------------------------
procedure GetBmpFromIDataObject(AOleCtrl: TOleContainer; ABmp: TBitmap);
var
  LDataObject : IDataObject;
  LFormatEtc  : TFormatEtc;
  LStgMedium  : TStgMedium;
begin
  AOleCtrl.OLEObjectInterface.QueryInterface(IDataObject, LDataObject);

  if LDataObject <> nil then begin

    LFormatEtc.cfFormat := CF_BITMAP;
    LFormatEtc.ptd      := nil;
    LFormatEtc.dwAspect := DVASPECT_CONTENT;
    LFormatEtc.lIndex   := -1;
    LFormatEtc.tymed    := TYMED_GDI;

    // 設定したフォーマットをサポートしているかを確認
    if LDataObject.QueryGetData(LFormatEtc) = S_OK then begin
      if LDataObject.GetData(LFormatEtc, LStgMedium) >= 0 then begin
        // データの取得
        // フォーマットの種類によって異なる
        ABmp.LoadFromClipboardFormat(CF_BITMAP, LStgMedium.hBitmap, 0);
      end;
    end;
  end;
end;

03_ワード文書にビットマップ画像を OLE オブジェクトとして挿入

ビットマップ画像等，[オブジェクトの挿入] ダイアログの [オブジェクトの種類] のオブジェクトは，ワードやエクセルにも OLE オブジェクトとして埋め込んで表示することができます．
そのためにはそのオブジェクトの ProgID の値が必要となります．ProgID の値は，対象とするオブジェクトを TOleContainer に挿入して表示すれば，前項のサンプルの {情報] ボタンクリックのイベントコードを参考にして取得できます．

以下は拙作のワード操作フォームEx を使用したテストの結果です．

	図7 [Button1] クリックビットマップ画像を OLE オブジェクトとしてワード文書に埋め込む
	図8 ビットマップ画像をダブルクリックペイントブラシが起動する画像を編集
	ペイントブラシを閉じるペイントブラシでの編集結果が反映される

リスト5
ワード文書にビットマップ画像を OLE オブジェクトとして埋め込む
wdfWordApp は TWordApplication のインスタンス

procedure TplWordFormEx2.Button1Click(Sender: TObject);
var
  LFilePath  : OleVariant;
  LobjShapes : OleVariant;
  LClassType : OleVariant;
begin
  LFilePath  := ExpandFileName('.\Images\HANDSHAK.BMP');
  LClassType := 'Paint.Picture';

  // AddOLEObjectメソッドは引数が多いのでOleVariant型で扱うことにする
  LobjShapes := wdfWordApp.Selection.InlineShapes as IDispatch;
  LobjShapes.AddOLEObject(LClassType, LFilePath);
end;

04_TRichEdit にビットマップ画像を OLE オブジェクトとして挿入

TRichEdit コントロールには OLE オブジェクトを挿入して埋め込み表示するためのインタフェースが実装はされています．しかし，実際にそれらのインターフェイスを利用するにはかなりのコーディングが必要になります．
JEDI プロジェクトが提供している TJvRichEdit には，それらのインターフェイスを使用するためのプロパティやメソッドが実装されています．その TJvRiechEdit にビットマップ画像を OLE オブジェクトとして埋め込む例です．

図9
実行結果

リスト6
TJvRichEdit に OLE オブジェクトとしてビットマップ画像を埋め込む

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, JvExStdCtrls, JvRichEdit;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    JvRichEdit1: TJvRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LFilePath : string;
begin
  Panel1.Caption := '';

  LFilePath := ExpandFileName('.\Display.txt');
  JvRichEdit1.Lines.LoadFromFile(LFilePath);
end;

//=============================================================================
//  ビットマップ画像を読み込んでTJvRichEditにOLEオブジェクトとして挿入
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath : string;
begin
  JvRichEdit1.SelStart := Length(JvRichEdit1.Text);

  LFilePath := ExpandFileName('.\Images\HANDSHAK.BMP');
  JvRichEdit1.InsertObjectFromFile(LFilePath, False);
end;

//=============================================================================
//  表示中の文書を保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSavePath : string;
begin
  // リッチテキスト形式のファイルとして保存
  // リッチテキスト形式なので画像付きで保存される
  LSavePath := ExpandFileName('.\Dest_Rich.rtf');
  JvRichEdit1.Lines.SaveToFile(LSavePath);
end;

//=============================================================================
//  選択中の画像を保存
//  クリップボード利用
//
//  usesに  Clipbrdが必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LSavePath : string;
  LPicture  : TPicture;
  LBitmap   : TBitmap;
begin
  LSavePath := ExpandFileName('.\Dest_Obj.bmp');

  if JvRichEdit1.SelectionType = [stObject] then begin
    JvRichEdit1.CopyToClipboard;

    if Clipboard.HasFormat(CF_METAFILEPICT) then begin
      LPicture := TPicture.Create;
      LBitmap  := TBitmap.Create;
      try
        LPicture.Assign(Clipboard);
        LBitmap.SetSize(LPicture.Width, LPicture.Height);
        LBitmap.Canvas.Draw(0, 0, LPicture.Graphic);

        LBitmap.SaveToFile(LSavePath);
      finally
        FreeAndNil(LPicture);
        FreeAndNil(LBitmap);
      end;
    end;
  end;
end;

end.