Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年06月04日] [更新 2013年12月02日] ワード操作フォームEx
   
ワード操作フォームEx   参考コード類
オートシェイプの描画
動作確認等 Windows 7 U64(SP1) + Delphi XE2 + Word 2010







オートシェイプの描画例


Shape オブジェクトの AddShape メソッドを使用して作成します.後は Shape オブジェクトのメソッドやプロパティを使用して操作できます.


図1
オートシェイプの新規作成

リスト1
オートシェイプの新規作成例
uses に Office2000 が必要
procedure TplWordFormEx2.Button1Click(Sender: TObject);
var
  AShape  : Twdf2000Shape;
  pType   : Integer;        //作成オートシェイプの種類
  pLeft   : Single;         //アンカーポイントからの左端位置(ポイント数指定)
  pTop    : Single;         //アンカーポイントからの上端位置(ポイント数指定)
  pWidth  : Single;         //幅(ポイント数指定)
  pHeight : Single;         //高さ(ポイント数指定)
  pAnchor : OleVariant;     //アンカーポイント(省略した場合はページの左上隅)
begin
  pType   := msoShapeCube;
  pLeft   := wdfWordApp.Application.MillimetersToPoints(15);
  pTop    := wdfWordApp.Application.MillimetersToPoints(12);
  pWidth  := 150;
  pHeight := 100;
  pAnchor := EmptyParam;

  AShape := wdfWordDoc.Shapes.AddShape(pType,
                                       pLeft,
                                       pTop,
                                       pWidth,
                                       pHeight,
                                       pAnchor);

  AShape.Fill.ForeColor.RGB := RGB(255, 255, 153);
  AShape.Fill.Transparency  := 0.3;
end;




指定した番号のオートシェイプの図形を変更


文書中に描画しているオートシェイプの種類を変更する例です.
図形の番号で指定いる場合です.


図2
実行例
  • 左側が対象の図形

リスト2
指定した番号のオートシェイプの図形を変更
uses に Office2000 が必要
procedure TplWordFormEx2.Button2Click(Sender: TObject);
var
  AShape : Twdf2000Shape;
  pIndex : OleVariant;
begin
  pIndex := 1;
  try
    AShape := wdfWordDoc.Shapes.Item(pIndex);
    AShape.AutoShapeType      := msoShapeRightArrowCallout;
    AShape.Fill.ForeColor.RGB := RGB(100, 255, 153);
  except
    raise;
  end;
end;




選択中のオートシェイプの図形を変更


文書中に描画しているオートシェイプの種類を変更する例です.
選択中のオートシェイプの全てを同じ図形に変更します.


図3
実行例
  • 選択中の右側の図形を変更


リスト3
選択中のオートシェイプの図形を変更
uses に Office2000 が必要
procedure TplWordFormEx2.Button3Click(Sender: TObject);
var
  i      : Integer;
  iOle   : OleVariant;
  AShape : Twdf2000Shape;
begin
  //Shapeオブジェクトがなければ中止
  if wdfWordDoc.Shapes.Count < 1 then exit;

  try
    //選択中のShapeオブジェクトを検索して操作
    for i := 1 to wdfWordApp.Selection.ShapeRange.Count do begin
      iOle := i;
      AShape := wdfWordApp.Selection.ShapeRange.Item(iOle);
      AShape.AutoShapeType      := msoShapeRightArrowCallout;
      AShape.Fill.ForeColor.RGB := RGB(100, 255, 153);
    end;
  except
    raise;
  end;
end;




オートシェイプの図形の種類


オートシェイプにどんな図形があるかを調べるサンプルです.
リストは Office2000.pas で定義されているものです.図形の種類は MsoAutoShapeType 列挙型として定義されていますが,これは TOleEnum 型の列挙型です.TOleEnum 型は実際には定数です.そこで以下のようなコードにしています.
実行の前に,あらかじめオートシェイプを作成しておきます.このコードは,文書に配置した最初のオートシェイプの図形を順番に変更します.


リスト4
オートシェイプの連続変更
unit WordTestFomr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, plWordEx, StdCtrls, Buttons, ToolWin, ComCtrls, ExtCtrls;

type
  TplWordFormEx2 = class(TplWordFormEx)
    Button1: TButton;
    Button2: TButton;
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    SL     : TStringList;
    AIndex : Integer;
  public
    { Public 宣言 }
  end;

var
  plWordFormEx2: TplWordFormEx2;

implementation

uses Word2000, Office2000;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TplWordFormEx2.FormShow(Sender: TObject);
begin
  AIndex := -1;
  SL := TStringList.Create;

  SL.Clear;
  with SL do begin
     AddObject( 'msoShape16pointStar ',
              TObject( msoShape16pointStar  ));
     AddObject( 'msoShape24pointStar',
              TObject( msoShape24pointStar ));
     AddObject( 'msoShape32pointStar',
              TObject( msoShape32pointStar ));
     AddObject( 'msoShape4pointStar',
              TObject( msoShape4pointStar ));
     AddObject( 'msoShape5pointStar',
              TObject( msoShape5pointStar ));
     AddObject( 'msoShape8pointStar',
              TObject( msoShape8pointStar ));
     AddObject( 'msoShapeActionButtonBackorPrevious',
              TObject( msoShapeActionButtonBackorPrevious ));
     AddObject( 'msoShapeActionButtonBeginning',
              TObject( msoShapeActionButtonBeginning ));
     AddObject( 'msoShapeActionButtonCustom',
              TObject( msoShapeActionButtonCustom ));
     AddObject( 'msoShapeActionButtonDocument',
              TObject( msoShapeActionButtonDocument ));
     AddObject( 'msoShapeActionButtonEnd',
              TObject( msoShapeActionButtonEnd ));
     AddObject( 'msoShapeActionButtonForwardorNext',
              TObject( msoShapeActionButtonForwardorNext ));
     AddObject( 'msoShapeActionButtonHelp',
              TObject( msoShapeActionButtonHelp ));
     AddObject( 'msoShapeActionButtonHome',
              TObject( msoShapeActionButtonHome ));
     AddObject( 'msoShapeActionButtonInformation',
              TObject( msoShapeActionButtonInformation ));
     AddObject( 'msoShapeActionButtonMovie',
              TObject( msoShapeActionButtonMovie ));
     AddObject( 'msoShapeActionButtonReturn',
              TObject( msoShapeActionButtonReturn ));
     AddObject( 'msoShapeActionButtonSound',
              TObject( msoShapeActionButtonSound ));
     AddObject( 'msoShapeArc',
              TObject( msoShapeArc ));
     AddObject( 'msoShapeBalloon',
              TObject( msoShapeBalloon ));
     AddObject( 'msoShapeBentArrow',
              TObject( msoShapeBentArrow ));
     AddObject( 'msoShapeBentUpArrow',
              TObject( msoShapeBentUpArrow ));
     AddObject( 'msoShapeBevel',
              TObject( msoShapeBevel ));
     AddObject( 'msoShapeBlockArc',
              TObject( msoShapeBlockArc ));
     AddObject( 'msoShapeCan',
              TObject( msoShapeCan ));
     AddObject( 'msoShapeChevron',
              TObject( msoShapeChevron ));
     AddObject( 'msoShapeCircularArrow',
              TObject( msoShapeCircularArrow ));
     AddObject( 'msoShapeCloudCallout',
              TObject( msoShapeCloudCallout ));
     AddObject( 'msoShapeCross',
              TObject( msoShapeCross ));
     AddObject( 'msoShapeCube',
              TObject( msoShapeCube ));
     AddObject( 'msoShapeCurvedDownArrow',
              TObject( msoShapeCurvedDownArrow ));
     AddObject( 'msoShapeCurvedDownRibbon',
              TObject( msoShapeCurvedDownRibbon ));
     AddObject( 'msoShapeCurvedLeftArrow',
              TObject( msoShapeCurvedLeftArrow ));
     AddObject( 'msoShapeCurvedRightArrow',
              TObject( msoShapeCurvedRightArrow ));
     AddObject( 'msoShapeCurvedUpArrow',
              TObject( msoShapeCurvedUpArrow ));
     AddObject( 'msoShapeCurvedUpRibbon',
              TObject( msoShapeCurvedUpRibbon ));
     AddObject( 'msoShapeDiamond',
              TObject( msoShapeDiamond ));
     AddObject( 'msoShapeDonut',
              TObject( msoShapeDonut ));
     AddObject( 'msoShapeDoubleBrace',
              TObject( msoShapeDoubleBrace ));
     AddObject( 'msoShapeDoubleBracket',
              TObject( msoShapeDoubleBracket ));
     AddObject( 'msoShapeDoubleWave',
              TObject( msoShapeDoubleWave ));
     AddObject( 'msoShapeDownArrow',
              TObject( msoShapeDownArrow ));
     AddObject( 'msoShapeDownArrowCallout',
              TObject( msoShapeDownArrowCallout ));
     AddObject( 'msoShapeDownRibbon',
              TObject( msoShapeDownRibbon ));
     AddObject( 'msoShapeExplosion1',
              TObject( msoShapeExplosion1 ));
     AddObject( 'msoShapeExplosion2',
              TObject( msoShapeExplosion2 ));
     AddObject( 'msoShapeFlowchartAlternateProcess',
              TObject( msoShapeFlowchartAlternateProcess ));
     AddObject( 'msoShapeFlowchartCard',
              TObject( msoShapeFlowchartCard ));
     AddObject( 'msoShapeFlowchartCollate',
              TObject( msoShapeFlowchartCollate ));
     AddObject( 'msoShapeFlowchartConnector',
              TObject( msoShapeFlowchartConnector ));
     AddObject( 'msoShapeFlowchartData',
              TObject( msoShapeFlowchartData ));
     AddObject( 'msoShapeFlowchartDecision',
              TObject( msoShapeFlowchartDecision ));
     AddObject( 'msoShapeFlowchartDelay',
              TObject( msoShapeFlowchartDelay ));
     AddObject( 'msoShapeFlowchartDirectAccessStorage',
              TObject( msoShapeFlowchartDirectAccessStorage ));
     AddObject( 'msoShapeFlowchartDisplay',
              TObject( msoShapeFlowchartDisplay ));
     AddObject( 'msoShapeFlowchartDocument',
              TObject( msoShapeFlowchartDocument ));
     AddObject( 'msoShapeFlowchartExtract',
              TObject( msoShapeFlowchartExtract ));
     AddObject( 'msoShapeFlowchartInternalStorage',
              TObject( msoShapeFlowchartInternalStorage ));
     AddObject( 'msoShapeFlowchartMagneticDisk',
              TObject( msoShapeFlowchartMagneticDisk ));
     AddObject( 'msoShapeFlowchartManualInput',
              TObject( msoShapeFlowchartManualInput ));
     AddObject( 'msoShapeFlowchartManualOperation',
              TObject( msoShapeFlowchartManualOperation ));
     AddObject( 'msoShapeFlowchartMerge',
              TObject( msoShapeFlowchartMerge ));
     AddObject( 'msoShapeFlowchartMultidocument',
              TObject( msoShapeFlowchartMultidocument ));
     AddObject( 'msoShapeFlowchartOffpageConnector',
              TObject( msoShapeFlowchartOffpageConnector ));
     AddObject( 'msoShapeFlowchartOr',
              TObject( msoShapeFlowchartOr ));
     AddObject( 'msoShapeFlowchartPredefinedProcess',
              TObject( msoShapeFlowchartPredefinedProcess ));
     AddObject( 'msoShapeFlowchartPreparation',
              TObject( msoShapeFlowchartPreparation ));
     AddObject( 'msoShapeFlowchartProcess',
              TObject( msoShapeFlowchartProcess ));
     AddObject( 'msoShapeFlowchartPunchedTape',
              TObject( msoShapeFlowchartPunchedTape ));
     AddObject( 'msoShapeFlowchartSequentialAccessStorage',
              TObject( msoShapeFlowchartSequentialAccessStorage ));
     AddObject( 'msoShapeFlowchartSort ',
              TObject( msoShapeFlowchartSort  ));
     AddObject( 'msoShapeFlowchartStoredData',
              TObject( msoShapeFlowchartStoredData ));
     AddObject( 'msoShapeFlowchartSummingJunction',
              TObject( msoShapeFlowchartSummingJunction ));
     AddObject( 'msoShapeFlowchartTerminator',
              TObject( msoShapeFlowchartTerminator ));
     AddObject( 'msoShapeFoldedCorner',
              TObject( msoShapeFoldedCorner ));
     AddObject( 'msoShapeHeart',
              TObject( msoShapeHeart ));
     AddObject( 'msoShapeHexagon',
              TObject( msoShapeHexagon ));
     AddObject( 'msoShapeHorizontalScroll',
              TObject( msoShapeHorizontalScroll ));
     AddObject( 'msoShapeIsoscelesTriangle',
              TObject( msoShapeIsoscelesTriangle ));
     AddObject( 'msoShapeLeftArrow',
              TObject( msoShapeLeftArrow ));
     AddObject( 'msoShapeLeftArrowCallout',
              TObject( msoShapeLeftArrowCallout ));
     AddObject( 'msoShapeLeftBrace',
              TObject( msoShapeLeftBrace ));
     AddObject( 'msoShapeLeftBracket',
              TObject( msoShapeLeftBracket ));
     AddObject( 'msoShapeLeftRightArrow',
              TObject( msoShapeLeftRightArrow ));
     AddObject( 'msoShapeLeftRightArrowCallout',
              TObject( msoShapeLeftRightArrowCallout ));
     AddObject( 'msoShapeLeftRightUpArrow',
              TObject( msoShapeLeftRightUpArrow ));
     AddObject( 'msoShapeLeftUpArrow',
              TObject( msoShapeLeftUpArrow ));
     AddObject( 'msoShapeLightningBolt',
              TObject( msoShapeLightningBolt ));
     AddObject( 'msoShapeLineCallout1',
              TObject( msoShapeLineCallout1 ));
     AddObject( 'msoShapeLineCallout1AccentBar',
              TObject( msoShapeLineCallout1AccentBar ));
     AddObject( 'msoShapeLineCallout1BorderandAccentBar',
              TObject( msoShapeLineCallout1BorderandAccentBar ));
     AddObject( 'msoShapeLineCallout1NoBorder',
              TObject( msoShapeLineCallout1NoBorder ));
     AddObject( 'msoShapeLineCallout2',
              TObject( msoShapeLineCallout2 ));
     AddObject( 'msoShapeLineCallout2AccentBar',
              TObject( msoShapeLineCallout2AccentBar ));
     AddObject( 'msoShapeLineCallout2BorderandAccentBar',
              TObject( msoShapeLineCallout2BorderandAccentBar ));
     AddObject( 'msoShapeLineCallout2NoBorder',
              TObject( msoShapeLineCallout2NoBorder ));
     AddObject( 'msoShapeLineCallout3',
              TObject( msoShapeLineCallout3 ));
     AddObject( 'msoShapeLineCallout3AccentBar',
              TObject( msoShapeLineCallout3AccentBar ));
     AddObject( 'msoShapeLineCallout3BorderandAccentBar',
              TObject( msoShapeLineCallout3BorderandAccentBar ));
     AddObject( 'msoShapeLineCallout3NoBorder',
              TObject( msoShapeLineCallout3NoBorder ));
     AddObject( 'msoShapeLineCallout4',
              TObject( msoShapeLineCallout4 ));
     AddObject( 'msoShapeLineCallout4AccentBar',
              TObject( msoShapeLineCallout4AccentBar ));
     AddObject( 'msoShapeLineCallout4BorderandAccentBar',
              TObject( msoShapeLineCallout4BorderandAccentBar ));
     AddObject( 'msoShapeLineCallout4NoBorder',
              TObject( msoShapeLineCallout4NoBorder ));
     AddObject( 'msoShapeMixed',
              TObject( msoShapeMixed ));
     AddObject( 'msoShapeMoon',
              TObject( msoShapeMoon ));
     AddObject( 'msoShapeNoSymbol',
              TObject( msoShapeNoSymbol ));
     AddObject( 'msoShapeNotchedRightArrow',
              TObject( msoShapeNotchedRightArrow ));
     AddObject( 'msoShapeNotPrimitive',
              TObject( msoShapeNotPrimitive ));
     AddObject( 'msoShapeOctagon',
              TObject( msoShapeOctagon ));
     AddObject( 'msoShapeOval',
              TObject( msoShapeOval ));
     AddObject( 'msoShapeOvalCallout',
              TObject( msoShapeOvalCallout ));
     AddObject( 'msoShapeParallelogram',
              TObject( msoShapeParallelogram ));
     AddObject( 'msoShapePentagon',
              TObject( msoShapePentagon ));
     AddObject( 'msoShapePlaque',
              TObject( msoShapePlaque ));
     AddObject( 'msoShapeQuadArrow',
              TObject( msoShapeQuadArrow ));
     AddObject( 'msoShapeQuadArrowCallout',
              TObject( msoShapeQuadArrowCallout ));
     AddObject( 'msoShapeRectangle',
              TObject( msoShapeRectangle ));
     AddObject( 'msoShapeRectangularCallout',
              TObject( msoShapeRectangularCallout ));
     AddObject( 'msoShapeRegularPentagon',
              TObject( msoShapeRegularPentagon ));
     AddObject( 'msoShapeRightArrow',
              TObject( msoShapeRightArrow ));
     AddObject( 'msoShapeRightArrowCallout',
              TObject( msoShapeRightArrowCallout ));
     AddObject( 'msoShapeRightBrace',
              TObject( msoShapeRightBrace ));
     AddObject( 'msoShapeRightBracket',
              TObject( msoShapeRightBracket ));
     AddObject( 'msoShapeRightTriangle',
              TObject( msoShapeRightTriangle ));
     AddObject( 'msoShapeRoundedRectangle',
              TObject( msoShapeRoundedRectangle ));
     AddObject( 'msoShapeRoundedRectangularCallout',
              TObject( msoShapeRoundedRectangularCallout ));
     AddObject( 'msoShapeSmileyFace',
              TObject( msoShapeSmileyFace ));
     AddObject( 'msoShapeStripedRightArrow',
              TObject( msoShapeStripedRightArrow ));
     AddObject( 'msoShapeSun',
              TObject( msoShapeSun ));
     AddObject( 'msoShapeTrapezoid',
              TObject( msoShapeTrapezoid ));
     AddObject( 'msoShapeUpArrow',
              TObject( msoShapeUpArrow ));
     AddObject( 'msoShapeUpArrowCallout',
              TObject( msoShapeUpArrowCallout ));
     AddObject( 'msoShapeUpDownArrow',
              TObject( msoShapeUpDownArrow ));
     AddObject( 'msoShapeUpDownArrowCallout',
              TObject( msoShapeUpDownArrowCallout ));
     AddObject( 'msoShapeUpRibbon',
              TObject( msoShapeUpRibbon ));
     AddObject( 'msoShapeUTurnArrow',
              TObject( msoShapeUTurnArrow ));
     AddObject( 'msoShapeVerticalScroll',
              TObject( msoShapeVerticalScroll ));
     AddObject( 'msoShapeWave',
              TObject( msoShapeWave ));
  end;

  //表示する文書の指定
  wdfFileFullPath := 'テスト文書.doc';

  //元のOnShowを実行
  inherited;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TplWordFormEx2.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
  //保存したことにしてしまう
  if wdfFileOpened then wdfWordDoc.Saved := True;

  //元の処理を実行
  inherited;
end;

//=============================================================================
//  オートシェイプ 図形の変更
//  図形名をインクリメント
//  あらかじめテスト文書にオートシェイプを配置しておく
//=============================================================================
procedure TplWordFormEx2.Button1Click(Sender: TObject);
var
  AShape : Twdf2000Shape;
  pIndex : OleVariant;
begin
  Inc(AIndex);
  if AIndex > SL.Count then AIndex := 0;

  pIndex := 1;
  try
    AShape := wdfWordDoc.Shapes.Item(pIndex);
    AShape.AutoShapeType := Integer(SL.Objects[AIndex]);
  except
  end;
end;

//=============================================================================
//  オートシェイプ 図形の変更
//  図形名をデクリメント
//=============================================================================
procedure TplWordFormEx2.Button2Click(Sender: TObject);
var
  AShape : Twdf2000Shape;
  pIndex : OleVariant;
begin
  Dec(AIndex);
  if AIndex < 0 then AIndex := SL.Count - 1;

  pIndex := 1;
  try
    AShape := wdfWordDoc.Shapes.Item(pIndex);
    AShape.AutoShapeType := Integer(SL.Objects[AIndex]);
  except
  end;
end;

end.