u_d_word.pas
来自「人事管理程序源码」· PAS 代码 · 共 236 行
PAS
236 行
unit U_d_word;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Word2000, OleServer,QComCtrls,StdCtrls, Buttons,ADODB, ComCtrls;
type
TForm_d_word = class(TForm)
WordDocument1: TWordDocument;
WordApplication1: TWordApplication;
procedure open_doc;
procedure replace_str(Mak_text,rep_str:string);
procedure close_doc;
procedure copyFile(S_file,D_file:string);
procedure insert_grid(Dbset:TadoDataset);
procedure locate(Mak_text:string);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_d_word: TForm_d_word;
implementation
{$R *.dfm}
procedure TForm_d_word.replace_str(Mak_text,rep_str:string);
var
doc_file,exepath:string;
i,index:integer;
findtext, matchcase, matchwholeword, matchwildcards, matchsoundslike,
matchallwordforms, forward, wrap, format, replacewith, replace,matchkashida,matchdiacritics,matchalefhamza,matchcontrol: olevariant;
begin
findtext := '<#'+mak_text+'>';
matchcase := false;
matchwholeword := true;
matchwildcards := false;
matchsoundslike := false;
matchallwordforms := false;
forward := true;
wrap := wdfindcontinue;
format := false;
replacewith := rep_str;
replace := true;
worddocument1.range.find.execute( findtext, matchcase, matchwholeword,matchwildcards, matchsoundslike, matchallwordforms, forward,wrap, format, replacewith, replace,matchkashida,matchdiacritics,matchalefhamza,matchcontrol);
end;
procedure TForm_d_word.open_doc;
var
sf,df,doc_file,exepath:string;
i,index:integer;
itemindex :olevariant;
filename, confirmconversions, readonly, addtorecentfiles,
passworddocument, passwordtemplate, revert,writepassworddocument, writepasswordtemplate, format,Encoding,Visible: olevariant;
begin
exepath:=application.ExeName;
for index:=1 to length(exepath) do
if exepath[index]='\' then
i:=index;
exepath:=copy(exepath,1,i);
doc_file:=exepath+'zgdaxxk.dak';//以标题字段“mc”命名Word文件
sf:=doc_file;
df:=exepath+'zgxxk.doc';
try
Wordapplication1.connect;
except
messagedlg('没有安装Word',mterror,[mbok],0);
abort;
end;
if wordapplication1.Visible then close_doc;
{open document}
copyFile(Sf,Df);
filename :=df;
confirmconversions := false;
readonly := false;
addtorecentfiles := false;
passworddocument := '';
passwordtemplate := '';
revert := true;
writepassworddocument := '';
writepasswordtemplate := '';
format := wdopenformatdocument;
encoding:='';
Visible:=true;
wordapplication1.documents.open( filename, confirmconversions,readonly, addtorecentfiles, passworddocument, passwordtemplate,revert, writepassworddocument, writepasswordtemplate, format,Encoding,Visible);
{assign worddocument component}
itemindex := 1;
worddocument1.connectto(wordapplication1.documents.item(itemindex));
{turn spell checking of because it takes a long time if enabled and slows down winword}
wordapplication1.options.checkspellingasyoutype := false;
wordapplication1.options.checkgrammarasyoutype := false;
wordapplication1.WindowState:=wdWindowStateMinimize;
wordapplication1.Visible:=true;
worddocument1.Activate;
end;
procedure TForm_d_word.close_doc;
var
savechanges, originalformat, routedocument: olevariant;
begin
if wordapplication1.Visible then
begin
savechanges := wddonotsavechanges;
originalformat := unassigned;
routedocument := unassigned;
try
worddocument1.Close;
wordapplication1.quit(savechanges, originalformat, routedocument);
wordapplication1.disconnect;
except
on e:exception do begin
showmessage(e.message);
wordapplication1.disconnect;
end;
end;
end;
end;
procedure TForm_d_word.copyFile(S_file,D_file:string);
var
s,d:string;
SrcFile,DestFile:File;
BytesRead,BytesWritten,ToTalRead:Integer;
Buffer:Array[1..500] of byte;
Fsize:integer;
begin
s:=S_file;
d:=D_file;
AssignFile(SrcFile,S);
AssignFile(DestFile,D);
ReSet(SrcFile,1);
try
Rewrite(destFile,1);
try
try
TotalRead:=0;
Fsize:=filesize(SrcFile);
repeat
BlockRead(SrcFile,Buffer,Sizeof(Buffer),BytesRead);
if BytesRead>0 then
begin
BlockWrite(DEStFile,Buffer,BytesRead,BytesWritten);
if BytesRead<>BytesWritten then
Raise Exception.Create('文件拷贝出错!!')
else
begin
ToTalRead:=ToTalRead+BytesRead;
end;
end ;
until bytesRead=0;
except
Erase(DestFile);
Raise;
end;
finally
CloseFile(DestFile);
end;
Finally
CloseFile(SrcFile);
end;
end;
//==
procedure TForm_d_word.insert_grid(Dbset:TadoDataset);
var
t,doc:olevariant;
counts:integer;
begin
Wordapplication1.Selection.Font.Size :=10;
doc:=Wordapplication1.activedocument;
counts:=dbset.RecordCount; //记录数决定表格的行数
t:=doc.tables.Add(Wordapplication1.selection.range,counts+1,5);//5列
t.cell(1,1).range.text:= '单位';
t.Cell(1,1).Width:=120;
t.cell(1,1).range.Paragraphs.Alignment:= wdAlignParagraphCenter;
t.cell(1,2).range.text:= '姓名';
t.cell(1,2).range.text:= '单位';
t.Cell(1,2).Width:=120;
t.cell(1,2).range.Paragraphs.Alignment:= wdAlignParagraphCenter;
{
... ...
//依次写入其他字段的表头
for i:=2 to counts+1 do
begin
t.cell(i,1).range.text:=adoquery2.field
byname('dw').asstring;
t.Cell(i,1).Width:=120;
t.cell(i,1).range.Paragraphs.Alignment:=
wdAlignParagraphCenter;
t.cell(i,2).range.text:=adoquery2.field
byname('xm').asstring;
... ...
Adoquery2.next;
End; }
end;
//==
procedure TForm_d_word.locate(Mak_text:string);
var
doc_file,exepath:string;
i,index:integer;
findtext, matchcase, matchwholeword, matchwildcards, matchsoundslike,
matchallwordforms, forward, wrap, format, replacewith, replace,matchkashida,matchdiacritics,matchalefhamza,matchcontrol: olevariant;
begin
findtext := '<#'+mak_text+'>';
matchcase := false;
matchwholeword := true;
matchwildcards := false;
matchsoundslike := false;
matchallwordforms := false;
forward := true;
wrap := wdFindStop;
format := false;
replacewith :='';
replace := false;
worddocument1.range.find.execute( findtext, matchcase, matchwholeword,matchwildcards, matchsoundslike, matchallwordforms, forward,wrap, format, replacewith, replace,matchkashida,matchdiacritics,matchalefhamza,matchcontrol);
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?