|
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 型は実際には定数です．そこで以下のようなコードにしています．
実行の前に，あらかじめオートシェイプを作成しておきます．このコードは，文書に配置した最初のオートシェイプの図形を順番に変更します． |
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.
|