Delphi Programming / Object Pascal
[掲載 2009年05月12日] [更新 2009年05月12日] ワード操作フォームEx |
ワード操作フォームEx
テストプログラム DBTest |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Word 2010 |
Delphi 付属の DBDEMOS のデータを読込みながら表を作成していくプログラムです.
時間がかかるので,プログレスバーで進行状況を表示するようにしています.描画はすべてのデータの読込み後に行うようになっています.
データベースの接続には ADO を使用しています.mdb ファイルは,Delphi をデフォルトでインストールしたフォルダに存在すると仮定しています. |
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 DBTestUnit;
{$R *.DFM}
//=============================================================================
// ワード操作フォームEx(の継承フォーム)をモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
//起動時に表示する文書名
plWordFormEx2.wdfFileFullPath := 'DBTest文書.doc';
plWordFormEx2.ShowModal;
end;
end.
リスト2
ワード操作フォームEx の (継承フォームの) コード |
unit DBTestUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, plWordEx, StdCtrls, Buttons, ToolWin, ComCtrls, ExtCtrls, DB,
DBTables, ADODB;
type
TplWordFormEx2 = class(TplWordFormEx)
Button1: TButton;
ADOQuery1: TADOQuery;
ADOConnection1: TADOConnection;
procedure Button1Click(Sender: TObject);
procedure btnFileSaveClick(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
plWordFormEx2: TplWordFormEx2;
implementation
uses ProgBarFornUnit;
{$R *.dfm}
//=============================================================================
// データ読込み
// Delphi付属のDBDEMOSのデータを各行に読込んでいく
// 表は予め,タイトル行とデータ行を一つだけ作成しておき,1行づつ増加しながら
// 読込んでいく
//=============================================================================
procedure TplWordFormEx2.Button1Click(Sender: TObject);
var
DBPath : String;
ConnectStr : String;
TblNo : Integer;
RowCnt : Integer;
iRow : Integer;
RecCnt : Integer;
CustNo : Integer;
CompanyName : String;
Zip : String;
Address : String;
Phone : String;
CustNoStr : String;
begin
if wdfWordApp.Documents.Count=0 then exit;
Button1.Enabled := False;
TblNo := 1;
//1番目の表をthisTblとする
RowCnt := wdfWordDoc.Tables.Item(TblNo).Rows.Count;
//表の行数が2を越えていたら既に読込みでいる
//単票の場合は修正の意味で何回実行してもいいがこの場合は不要
if RowCnt>2 then begin
Application.MessageBox('データは既に読込まれています. ',
'実行済み',
MB_OK + MB_ICONINFORMATION);
end else begin
//ADO関係の設定
//まずデータベースファイルの場所をDBPathに代入
DBPath := GetEnvironmentVariable('CommonProgramFiles');
{$IF CompilerVersion > 18.49}
DBPath := DBPath + '\CodeGear Shared\Data\dbdemos.mdb';
{$ELSE}
DBPath := DBPath + '\Borland Shared\Data\dbdemos.mdb';
{$IFEND}
ADOConnection1.Connected := False;
//接続文字列の作成(パスワードなしの場合)
ConnectStr := 'Provider=Microsoft.Jet.OLEDB.4.0';
ConnectStr := ConnectStr + ';Data Source=' + DBPath;
ADOConnection1.ConnectionString := ConnectStr;
ADOConnection1.Mode := cmReadWrite;
ADOQuery1.Connection := ADOConnection1;
try
with ADOQuery1 do begin
SQL.Clear;
SQL.Add('select Count(CustNo) as RecCnt from customer ');
Open;
RecCnt := ADOQuery1.FieldByName('RecCnt').AsInteger;
Close;
SQL.Clear;
SQL.Add('select CustNo, Company, Zip, Addr1, Phone from customer');
Open;
end;
except
exit;
end;
ProgBarForm := TProgBarForm.Create(Self);
ProgBarForm.Show;
//Gaugeの最小値と最大値をセット
ProgbarForm.Gauge1.Progress := 0;
ProgBarForm.Gauge1.MaxValue := RecCnt;
//画面更新の停止
wdfWordApp.ScreenUpdating := False;
//対象の表の開始行は2
iRow:=2;
while True do begin
//データベースからデータを取得
CustNo := ADOQuery1.FieldByName('CustNo').AsInteger;
CustNoStr := IntToStr(CustNo);
CompanyName := ADOQuery1.FieldByName('Company').AsString;
Zip := ADOQuery1.FieldByName('Zip').AsString;
Address := ADOQuery1.FieldByName('Addr1').AsString;
Phone := ADOQuery1.FieldByName('Phone').AsString;
//それらのデータを該当するセルに挿入
wdfPutCellText (TblNo, iRow, 1, CustNoStr);
wdfPutCellText (TblNo, iRow, 2, CompanyName);
wdfPutCellText (TblNo, iRow, 3, Zip);
wdfPutCellText (TblNo, iRow, 4, Address);
wdfPutCellText (TblNo, iRow, 5, Phone);
//次のデータへ
ADOQuery1.Next;
//データが無ければ終了
if ADOQuery1.Eof then break;
Application.ProcessMessages;
//行を追加
wdfAddRow(TblNo);
iRow := iRow+1;
//進行程度をゲージに反映
ProgBarForm.Gauge1.Progress := iRow;
ProgBarForm.Update;
end;
ProgBarForm.Close;
//画面更新の再開
wdfWordApp.ScreenUpdating := True;
ADOQuery1.Close;
end;
wdfWordDoc.Saved := True;
Button1.Enabled := True;
FreeAndNil(ProgBarForm);
end;
//=============================================================================
// 保存時は文書名自動生成
//=============================================================================
procedure TplWordFormEx2.btnFileSaveClick(Sender: TObject);
var
S : String;
begin
S := FormatDateTime('yyyy"年"mm"月"dd"日_"', Now);
SaveDialog1.FileName := S + 'DBTest.doc';
//継承元のボタンクリックを実行
inherited;
end;
end.
unit ProgBarFornUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, Gauges;
type
TProgBarForm = class(TForm)
Panel2: TPanel;
Gauge1: TGauge;
Panel1: TPanel;
Image1: TImage;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WMKillFocus(var Msg:TWMSetFocus); message WM_KILLFOCUS;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
ProgBarForm: TProgBarForm;
implementation
uses DBTestUnit;
{$R *.DFM}
{ TProgBarForm }
//=============================================================================
// このFormをplWordForm1より前面に表示
//=============================================================================
procedure TProgBarForm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WndParent := plWordFormEx2.Handle;
end;
//=============================================================================
// このFormを表示している間はFocus移動禁止
//=============================================================================
procedure TProgBarForm.WMKillFocus(var Msg: TWMSetFocus);
begin
inherited;
Self.BringToFront;
end;
end.
|