Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年05月12日] [更新 2013年11月28日] ワード操作フォームEx
ワード操作フォームEx
テストプログラム Shape
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Word 2010







図形とワードアートの挿入


図形 (Shape オブジェクト) とワードアートを文書中に挿入する例です.
Shape は wdfPutShape というメソッドが用意してありますが,ワードアートは参考としてコードで記述しています.


図1
実行結果
  • 大きなカエルを挿入した後,そのコピーを貼り付けてサイズを変更

リスト1
メインフォームのコード
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShapeUnit;

{$R *.DFM}

//=============================================================================
//  ワード操作フォームEx(の継承フォーム)をモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //起動時に表示する文書名
  plWordFormEx2.wdfFileFullPath := '白紙文書.doc';
  plWordFormEx2.ShowModal;
end;

end.


リスト2
ワード操作フォームExの (継承フォームの) コード
unit ShapeUnit;

interface

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

type
  TplWordFormEx2 = class(TplWordFormEx)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure btnFileSaveClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  plWordFormEx2: TplWordFormEx2;

implementation

uses Office2000;

{$R *.dfm}

//=============================================================================
//  図形をファイルから挿入    
//  wdfPutShapeメソッドを使用
//  wdfPutShapeの引数の数値は0.1mm単位
//=============================================================================
procedure TplWordFormEx2.Button1Click(Sender: TObject);
var
  pFileName : String;
begin
  //挿入する図形のバス名
  pFileName := ExtractFilePath(Application.ExeName) + 'E_frog.wmf';

  //画面更新の停止
  LockWindowUpdate(PanelLeft.Handle);
  //図形を挿入
  wdfPutShape(530, 500, 1000, 1000, pFileName);
  //画面更新の再開
  LockWindowUpdate(0);
  Application.ProcessMessages;

  //2秒後に複製を作成し複製を新オブジェクトとする
  Sleep(2000);
  wdfShape := wdfShape.Duplicate;
  //更に2秒後にサイズ変更
  Sleep(2000);
  wdfShape.Width  := 100;
  wdfShape.Height := 100;

  //保存済みとしてしまう
  wdfWordDoc.Saved := True;
end;

//=============================================================================
//  ワードアートの挿入
//  使用している定数値の使用にはusesにOffice2000が必要
//
//  wdfWordApp.ScreenRefresh;は画面を更新して,更新を停止する
//  wdfWordApp.ScreenUpdating := True;で更新を表示する
//=============================================================================
procedure TplWordFormEx2.Button2Click(Sender: TObject);
var
  pText     : String;
  pFontName : String;
  pFont     : OleVariant;
  pLeft     : OleVariant;
  pTop      : OleVariant;
  AShape    : Twdf2000Shape;
begin
  //画面更新の停止(ワードのScreenRefreshを使ってみる)
  wdfWordApp.ScreenRefresh;

  pText     := 'ワードアート';
  pFontName := 'MS Pゴシック';
  pFont     := 100;  //フォントサイズ
  pLeft     := 50;   //用紙左端からの位置.pt単位
  pTop      := 500;  //用紙上端からの位置.pt単位

  AShape := wdfWordDoc.Shapes.AddTextEffect(msoTextEffect1,
                                            pText,
                                            pFontName,
                                            pFont,
                                            msoFalse,
                                            msoFalse,
                                            pLeft,
                                            pTop,
                                            EmptyParam);

  //ワードアートオブジェクトのプロパティを変更
  with AShape do begin
    IncrementRotation(-10);               //反時計回りに10度回転
    Line.ForeColor.RGB := RGB(255 ,0, 0); //RGBで色を指定
    Line.Weight        := 2.0;            //文字の輪郭線の太さを指定
    Fill.Transparency  := 1.0;            //塗りつぶしの色はなし(透明)
  end;

  //画面更新の再開
  wdfWordApp.ScreenUpdating := True;
  //文書の変更はなしとする
  wdfWordDoc.Saved := True;
end;

//=============================================================================
//  [保存]ボタンクリックイベント
//
//  継承元のコード(inherited)は実行しないで,直線保存メソッドを使用して保存
//  関数wdfWordFileSaveは成功すると,wdfFileFullPathに保存フルパスを代入する
//  失敗すると,元のままで変化なし
//=============================================================================
procedure TplWordFormEx2.btnFileSaveClick(Sender: TObject);
var
    APath : String;
begin
  APath := ExtractFilePath(Application.ExeName) + 
                          'Shapeオブジェクトの挿入例.doc';
  wdfWordFileSave(APath);
end;

end.