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







直線や円の描画


直線,円と楕円と矢印線のメソッドのテスト用のプログラムです.


図1
設計時画面
  • TColorDialog を配置
図2
実行中の画面
  • カラーダイアログでの設定中

リスト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 DrawLineBoxUnit;

{$R *.DFM}

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

end.


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

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;
    ColorDialog1: TColorDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ColorDialog1Show(Sender: TObject);
    procedure btnFileSaveClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    LineColor: TColor;
  end;

var
  plWordFormEx2: TplWordFormEx2;

implementation

{$R *.dfm}

//=============================================================================
//  色の設定ボタン
//=============================================================================
procedure TplWordFormEx2.Button1Click(Sender: TObject);
begin
  if ColorDialog1.Execute then begin
    LineColor := ColorDialog1.Color;
  end;
end;

//=============================================================================
//  実行ボタン
//=============================================================================
procedure TplWordFormEx2.Button2Click(Sender: TObject);
begin
  if wdfWordApp.Documents.Count=0 then  exit;

  Screen.Cursor := crHourGlass;
  //画面更新の停止
  LockWindowUpdate(PanelLeft.Handle);
  //これを入れると少し描画が速くなる
  wdfWordApp.ScreenUpdating := False;

  //線.実線
  wdfPutLine(300, 1800, 500, 1700, 10, psSolid, LineColor);
  wdfPutLine(300, 1800, 1700, 500, 10, psSolid, LineColor);

  //四角形を俗に言う点線で描画
  wdfPutBox(300, 1800, 500, 1700, 10, psDot, LineColor);

  //楕円を緑で描画
  wdfPutCircle(300, 1800, 500, 1700, 10, psSolid, clGreen);

  //矢印を描画
  wdfPutArrow(300, 1800, 1100, 1100, 10, psSolid, LineColor, True, True);

  //画面更新の再開
  wdfWordApp.ScreenUpdating := True;
  LockWindowUpdate(0);
  Screen.Cursor := crDefault;

  //保存したことにしてしまう
  wdfWordDoc.Saved := True;
end;

//=============================================================================
//  色の設定ダイアログの表示位置をボタンの下に
//=============================================================================
procedure TplWordFormEx2.ColorDialog1Show(Sender: TObject);
var
  Dialogh : HWND;
  aRect   : TRect;
  PosX    : Integer;
  PosY    : Integer;
  CX      : Integer;
  CY      : Integer;
  Btn2Pos : TPoint;
begin
  Dialogh := ColorDialog1.Handle;

  //ダイアログの表示位置をボタンのすぐ下に
  GetWindowRect(Dialogh, aRect);
  CX      := aRect.Right - aRect.Left;
  CY      := aRect.Bottom - aRect.Top;
  Btn2Pos := Button2.ClientOrigin;
  PosX    := Btn2Pos.x + Button2.Width - CX;
  PosY    := Btn2Pos.y + Button2.Height;
  MoveWindow(Dialogh, Posx, PosY, CX, CY, True);
end;

//=============================================================================
//  文書保存時の処理
//  保存ダイアログ表示前に保存文書名を加工
//=============================================================================
procedure TplWordFormEx2.btnFileSaveClick(Sender: TObject);
var
  S : String;
begin
  S := FormatDateTime('yyyy"年"mm"月"dd"日_"', Now);
  SaveDialog1.FileName := S + '図形描画テスト文書';

  //継承元のボタンクリックを実行
  inherited;
end;

end.