//=============================================================================
//  選択中の図形類を保存
//
//  選択中のものを
//  1. メタファイル
//  2. ビットマップ
//  3. JPEGファイル
//  の3つの形式で保存する
//  usesにJpeg,Clipbrdが必要
//=============================================================================
procedure TplWordFormEx2.Button1Click(Sender: TObject);
var
  FilePath1 : String;
  FilePath2 : String;
  FilePath3 : String;
  AMeta     : TMetaFile;
  ABmp      : TBitmap;
  AJpeg     : TJpegImage;
begin
  try
    //選択したオブジェクトをクリップボードにコピー
    wdfWordApp.Selection.Copy;

    //各画像のオブジェクトを生成
    AMeta := TMetaFile.Create;
    ABmp  := TBitmap.Create;
    AJpeg := TJpegImage.Create;

    try
      //保存先フォルダ
      SavePictureDialog1.InitialDir := ExtractFilePath(Application.ExeName);
      SavePictureDialog1.Filter     := 'ImageFiles|*.emf;*.bmp;*.jpg';

      if SavePictureDialog1.Execute then begin
        Update;

        //各々の画像の保存名(フルパス)
        FilePath1 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.emf';
        FilePath2 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.bmp';
        FilePath3 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.jpg';

        //メタファイルを保存
        AMeta.Assign(Clipboard);
        AMeta.SaveToFile(FilePath1);

        //メタファイルをビットマップに変換して保存
        ABmp.Width  := AMeta.Width;
        ABmp.Height := AMeta.Height;
        ABmp.Canvas.Draw(0, 0, AMeta);
        ABmp.SaveToFile(FilePath2);

        //ビットマップをJPEGに変換して保存
        AJpeg.Assign(ABmp);
        AJpeg.SaveToFile(FilePath3);
      end;
    finally
      FreeAndNil(AMeta);
      FreeAndNil(ABmp);
      FreeAndNil(AJpeg);
    end;
  except
  end;
end;

//=============================================================================
//  図形の名前または番号を指定して保存
//
//  指定した図形を
//  1. メタファイル
//  2. ビットマップ
//  3. JPEGファイル
//  の3つの形式で保存する
//  usesにJpeg,Clipbrdが必要
//=============================================================================
procedure TplWordFormEx2.Button2Click(Sender: TObject);
var
  ItemStr   : OleVariant;
  FilePath1 : String;
  FilePath2 : String;
  FilePath3 : String;
  AMeta     : TMetaFile;
  ABmp      : TBitmap;
  AJpeg     : TJpegImage;
begin
  try
    //図形を指定してクリップボードに
    ItemStr := 'Picture 2';
    wdfWordDoc.Shapes.Item(ItemStr).Select(EmptyParam);
    //クリップボードに送る
    wdfWordApp.Selection.Copy;
    //選択解除
    wdfWordApp.Selection.Collapse(EmptyParam);

    //各画像のオブジェクトを生成
    AMeta := TMetaFile.Create;
    ABmp  := TBitmap.Create;
    AJpeg := TJpegImage.Create;

    try
      //保存先フォルダ
      SavePictureDialog1.InitialDir := ExtractFilePath(Application.ExeName);
      SavePictureDialog1.Filter     := 'ImageFiles|*.emf;*.bmp;*.jpg';

      if SavePictureDialog1.Execute then begin
        Update;

        //各々の画像の保存名(フルパス)
        FilePath1 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.emf';
        FilePath2 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.bmp';
        FilePath3 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.jpg';

        //メタファイルを保存
        AMeta.Assign(Clipboard);
        AMeta.SaveToFile(FilePath1);

        //メタファイルをビットマップに変換して保存
        ABmp.Width  := AMeta.Width;
        ABmp.Height := AMeta.Height;
        ABmp.Canvas.Draw(0, 0, AMeta);
        ABmp.SaveToFile(FilePath2);
        //ビットマップをJPEGに変換して保存
        AJpeg.Assign(ABmp);
        AJpeg.SaveToFile(FilePath3);
      end;
    finally
      FreeAndNil(AMeta);
      FreeAndNil(ABmp);
      FreeAndNil(AJpeg);
    end;
  except
    //図形の選択に失敗した場合
  end;
end;

//=============================================================================
//  Art::GVML Clipformat形式のクリップボードデータの検出と保存
//  docx形式の文書でないと動作不可
//
//  [挿入][図]はInllineでもInlineでなくとても保存可能
//  [挿入][図形](オートシェイプ)はInllineでは保存不可
//
//  usesにClipbrd, System.Zip, StrUtilsが必要
//=============================================================================
procedure TplWordFormEx2.Button3Click(Sender: TObject);
const
  CustomDataStr: String = 'Art::GVML Clipformat';
var
  zipStream   : TMemoryStream;
  hBuffer     : THandle;
  pBuffer     : Pointer;
  DataFormat  : UINT;
  ZipClass    : TZipFile;
  DestFileDir : String;
  FileListArr : TArray<string>;
  strText     : String;
begin
  //選択したオブジェクトをクリップボードにコピー
  wdfWordApp.Selection.Copy;

  //クリップボードのデータフォーマット形式の値を取得
  DataFormat := RegisterClipboardFormat(PChar(CustomDataStr));

  if Clipboard.HasFormat(DataFormat) then begin
    //その形式だったらクリップボードからZipStreamにデータを取得
    zipStream := TMemoryStream.Create;
    try
      ClipBoard.Open;

      hBuffer := Clipboard.GetAsHandle(DataFormat);
      pBuffer := GlobalLock(hBuffer);

      zipStream.WriteBuffer(pBuffer^, GlobalSize(hBuffer));
      GlobalUnlock(hBuffer);
      Clipboard.Close;

      //データ(図・画像)の保存先のフォルダを作成
      DestFileDir := ExtractFilePath(Application.ExeName) + 'AAA';
      ForceDirectories(DestFileDir);

      //Art::GVML Clipformat形式はZip形式なのでZipからデータを取出して保存
      ZipClass := TZipFile.Create;
      try
        zipStream.Position := 0;
        ZipClass.Open(zipStream, zmRead);
        FileListArr := ZipClass.FileNames;
        for strText in FileListArr do begin
          if ContainsText(StrText, 'clipboard/media/image') then begin
            ZipClass.Extract(strText, DestFileDir, False);
          end;
        end;
      finally
        ZipClass.Close;
        FreeAndNil(ZipClass);
      end;
    finally
      FreeAndNil(zipStream);
    end;
  end;
end;

  DataFormat := 0;
  for i := 0 to Clipboard.FormatCount -1 do begin
    DataFormat := ClipBoard.Formats[i];
    GetClipBoardFormatName(DataFormat, FmtName, SizeOf(FmtName));
    strText := FmtName;
    if UpperCase(strText) = UpperCase(CustomDataStr) then begin
      break;
    end;
  end;