Delphi Programming / Object Pascal
[掲載 2009年05月12日] [更新 2013年11月28日] ワード操作フォームEx |
ワード操作フォームEx
テストプログラム DrawLineBox |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Word 2010 |
直線,円と楕円と矢印線のメソッドのテスト用のプログラムです. |
|
図1
設計時画面
|
|
図2
実行中の画面
|
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.
|