unit utmyword;
(*
by 闫磊 编写 2004.09.06 email:landgis@126.com yanleigis@21cn.com
*)
interface
uses word2000, activex, variants, dialogs, sysutils;
type
tmyword = class(tobject)
private
fword: twordapplication; //word对象
fdoc: tworddocument; //文档对象
procedure connectword();
public
//换行
procedure addreturn();
//设置字体
procedure setfont(fontname: string; fontsize: integer;
fontbold: boolean = false; fontunderline: boolean = false);
//插入表格
function addtable(
//设置背景色
procedure settableback(backcolor: toleenum);
//鼠标下移
procedure movedown(num: integer = 1);
//选择下移
procedure selectdown(num: integer = 1);
//鼠标上移
procedure moveup();
//鼠标右移
procedure moveright(num: integer = 1);
//选择右移
procedure selectright(num: integer = 1);
//写字
procedure writetext(text: string);
//按样式插入一行记录
//如addline "备注","正文"
//addline 'kk',"标题 1"
procedure addline(s: string; pstyle: olevariant);
procedure alignline(align: toleenum);
//插入分页符
procedure insertpage();
//插入插入页码
procedure insertpagenum();
//插入日期
procedure insertdate();
//设置表格一列宽度
procedure settable(ptable: table; columnidx: integer; width: integer);
//设置表格一列高度
procedure settableheight(ptable: table; rowidx: integer; height:
integer);
//插入目录
procedure insertcontents();
//创立书签
procedure createbookmark(bookmarkname: string);
//移动到标签
procedure gotobookmark(bookmarkname: string);
//粘贴
procedure paste();
//替换
procedure replace(source, target: string);
//保存
procedure save(filename: string);
//插入图片
procedure addpicture(filename: string);
//移到最后
procedure moveend();
//合并
procedure cellsmerge();
constructor create;
destructor destroy; override;
end;
//function myword: tmyword;
implementation
//var
// fmyword: tmyword;
{function myword: tmyword;
begin
if fmyword = nil then
begin
fmyword := tmyword.create;
end;
result := fmyword;
end;
}
constructor tmyword.create();
begin
inherited create;
connectword();
//
end;
procedure tmyword.connectword();
var
b: boolean;
begin
b := false;
if (fword = nil) then
b := true
else
begin
try
fdoc.activate;
except
b := true;
end;
end;
if not b then exit;
fword := twordapplication.create(nil); //word对象
fdoc := tworddocument.create(nil); //文档对象
fword.connect;
fdoc.activate;
fword.visible := true;
end;
destructor tmyword.destroy;
begin
//
//fdoc.saveas('c:\1.doc');
fdoc.free;
fword.disconnect;
//退出一定退出word,by yl 2005.2.2
//fword.quit;
//fword.free;
inherited destroy;
end;
procedure tmyword.addreturn();
begin
try
fword.selection.typeparagraph;
except
addreturn();
end;
end;
procedure tmyword.setfont(fontname: string; fontsize: integer; fontbold:
boolean
= false; fontunderline: boolean = false);
begin
try
//connectword();
fword.selection.font.name := fontname;
fword.selection.font.size := fontsize;
if fontbold then
fword.selection.font.bold := wdtoggle;
if fontunderline then
fword.selection.font.underline := wdunderlinesingle;
except
setfont(fontname, fontsize, fontbold, fontunderline);
end;
end;
//插入表格
function tmyword.addtable(
var
defaulttable: olevariant;
begin
try
//connectword();
defaulttable := 1;
result := fdoc.tables.add(fword.selection.range, row,
emptyparam);
except
showmessage(format('列%d,行%d', [col, row]));
addtable(
end;
end;
//设置背景色
procedure tmyword.settableback(backcolor: toleenum);
begin
try
//connectword();
fword.selection.cells.shading.backgroundpatterncolor := backcolor;
except
settableback(backcolor);
end;
end;
//选择下移
procedure tmyword.selectdown(num: integer = 1);
var
unit_: olevariant;
count: olevariant;
extend: olevariant;
begin
try
//connectword();
count := num;
unit_ := wdline;
extend := wdextend;
fword.selection.movedown(unit_, count, extend);
except
movedown();
end;
end;
//鼠标下移
procedure tmyword.movedown(num: integer = 1);
var
unit_: olevariant;
count: olevariant;
extend: olevariant;
begin
try
//connectword();
count := num;
unit_ := wdline;
fword.selection.movedown(unit_, count, extend);
except
movedown();
end;
end;
//鼠标上移
procedure tmyword.moveup();
var
unit_: olevariant;
count: olevariant;
extend: olevariant;
begin
unit_ := wdline;
count := 1;
fword.selection.moveup(unit_, count, extend);
end;
//选择右移
procedure tmyword.selectright(num: integer = 1);
var
unit_: olevariant;
count: olevariant;
extend: olevariant;
begin
try
//connectword();
unit_ := wdcharacter;
count := num;
extend := wdextend;
fword.selection.moveright(unit_, count, extend);
except
moveright();
end;
end;
//鼠标右移
procedure tmyword.moveright(num: integer = 1);
var
unit_: olevariant;
count: olevariant;
extend: olevariant;
begin
try
//connectword();
unit_ := wdcell;
count := num;
fword.selection.moveright(unit_, count, extend);
except
moveright();
end;
end;
//写字
procedure tmyword.writetext(text: string);
begin
try
//connectword();
fword.selection.typetext(text);
except //防止呼叫失败
writetext(text);
end;
end;
//按样式插入一行记录
//如addline "备注","正文"
//addline 'kk',"标题 1"
procedure tmyword.addline(s: string; pstyle: olevariant);
procedure setstyle(pstyle: olevariant);
var
outstyle: style;
v: olevariant;
begin
outstyle := fword.activedocument.styles.item(pstyle);
v := outstyle;
fword.selection.set_style(v);
end;
begin
writetext(s); //加入一行
try
setstyle(pstyle);
except
setstyle(pstyle);
end;
end;
procedure tmyword.alignline(align: toleenum);
begin
fword.selection.paragraphformat.alignment := align;
end;
//插入分页符
procedure tmyword.insertpage();
var
_type: olevariant;
begin
_type := 7;
fword.selection.insertbreak(_type);
end;
//插入日期
procedure tmyword.insertdate();
var
datetimeformat: olevariant;
insertasfield: olevariant;
insertasfullwidth: olevariant;
datelanguage: olevariant;
calendartype: olevariant;
begin
try
insertasfield := false;
insertasfullwidth := false;
datetimeformat := 'yyyy''年''m''月''d''日''';
datelanguage := wdsimplifiedchinese;
calendartype := wdcalendarwestern;
fword.selection.insertdatetime(datetimeformat, insertasfield,
insertasfullwidth, datelanguage, calendartype);
except
insertdate();
end;
end;
//插入页码
procedure tmyword.insertpagenum();
var
psection: section;
pagenumberalignment: olevariant;
firstpage: olevariant;
begin
psection := fword.selection.sections.item(1);
pagenumberalignment := 1; //中间
firstpage := true;
psection.footers.item(wdheaderfooterprimary).pagenumbers.add(pagenumberalignment, firstpage);
end;
//设置表格一列高度
procedure tmyword.settableheight(ptable: table; rowidx: integer; height:
integer);
var
prow: row;
begin
prow := ptable.rows.item(rowidx);
prow.setheight(height, wdadjustnone);
end;
//设置表格一列宽度
procedure tmyword.settable(ptable: table; columnidx: integer; width:
integer);
begin
ptable.columns.item(columnidx).setwidth(width, wdadjustnone);
end;
//插入目录
procedure tmyword.insertcontents();
var
prange: range;
useheadingstyles: olevariant;
upperheadinglevel: olevariant;
lowerheadinglevel: olevariant;
usefields: olevariant;
tableid: olevariant;
rightalignpagenumbers: olevariant;
includepagenumbers: olevariant;
addedstyles: olevariant; usehyperlinks: olevariant;
hidepagenumbersinweb: olevariant;
begin
with fword.activedocument do
begin
prange := fword.selection.range;
rightalignpagenumbers := true;
useheadingstyles := true;
upperheadinglevel := 1;
lowerheadinglevel := 3;
includepagenumbers := true;
usehyperlinks := true;
hidepagenumbersinweb := true;
tablesofcontents.add(prange, useheadingstyles,
upperheadinglevel,
lowerheadinglevel,
usefields,
tableid,
rightalignpagenumbers,
includepagenumbers,
addedstyles, usehyperlinks,
hidepagenumbersinweb);
tablesofcontents.item(1).tableader := wdtableaderdots;
tablesofcontents.format := wdindexindent;
end;
end;
//创立书签
procedure tmyword.createbookmark(bookmarkname: string);
var
prange: olevariant;
begin
prange := fword.selection.range;
with fword.activedocument.bookmarks do
begin
add(bookmarkname, prange);
defaultsorting := wdsortbyname;
showhidden := false;
end;
end;
//移动到标签
procedure tmyword.gotobookmark(bookmarkname: string);
var
what: olevariant;
which: olevariant;
count: olevariant;
name: olevariant;
begin
what := wdgotobookmark;
name := 'begin';
fword.selection.goto_(what,
which,
count,
name)
end;
//粘贴
procedure tmyword.paste();
begin
fword.selection.paste;
end;
//替换
procedure tmyword.replace(source, target: string);
var
findtext: olevariant;
pwrap: olevariant;
replacewith: olevariant;
replace: olevariant;
begin
fword.selection.find.clearformatting;
fword.selection.find.replacement.clearformatting;
findtext := source;
pwrap := wdfindcontinue;
replacewith := target;
replace := wdreplaceall;
with fword.selection.find do
begin
{text := source;
replacement.text := target;
forward := true;
wrap := wdfindcontinue;
format := false;
matchcase := false;
matchwholeword := false;
matchbyte := true;
matchwildcards := false;
matchsoundslike := false;
matchallwordforms := false;
}
execute(findtext, emptyparam, emptyparam, emptyparam, emptyparam,
emptyparam,
emptyparam, pwrap, emptyparam, replacewith, replace, emptyparam,
emptyparam, emptyparam, emptyparam);
end;
end;
//保存
procedure tmyword.save(filename: string);
var
ofilename: olevariant;
begin
ofilename := filename;
fdoc.saveas(ofilename);
end;
//插入图片
procedure tmyword.addpicture(filename: string);
var
linktofile, savewithdocument, range: olevariant;
//index: olevariant;
begin
//index := 0;
//range := fdoc.bookmarks.item(index).range;
//range:=fdoc.goto_;
range := self.fword.selection.range;
linktofile := false;
savewithdocument := true;
fword.selection.inlineshapes.addpicture(filename, linktofile,
savewithdocument, range)
end;
//移到最后
procedure tmyword.moveend();
var
unit_: olevariant;
extend: olevariant;
begin
unit_ := wdstory;
extend := wdmove;
fword.selection.endkey(unit_, extend);
end;
//合并
procedure tmyword.cellsmerge();
begin
fword.selection.cells.merge;
end;
initialization
finalization
{ if fmyword <> nil then
fmyword.free;
}
end.
浙公网安备 33010602011771号