一个老问题:OLE 内嵌 WORD,两者有机结合 请有这方面经验的高手指点(20分)

  • 主题发起人 主题发起人 wjp888
  • 开始时间 开始时间
W

wjp888

Unregistered / Unconfirmed
GUEST, unregistred user!
前几天看到一位老前辈的作品,把 WORD很协调的嵌入DELPHI中,可以看出来是OLE技术,
里面有几个优点:
(1)程序启动时自动激活OLE,显示一个空的WORD文档
(2)WORD工具条不与主程序菜单和工具条混在一起
(3)利用tree选择打开WORD文档时第一次有些慢,后来都非常快
(4)很方便的编辑打开的WORD文档,程序中很方便的存盘
给人感觉就象把WORD缩小放到DELPHI指定的位置中,当然也有不足的地方
WORD的”NEW“,”OPEN“,”SAVE“按钮都是没有激活的。
最近我碰巧遇到类似问题,需要在DELPHI中控制WORD,查了不少帖子
对OLE控制WORD的方面有了大体上的了解,但还是有很多地方不明白,
几天来一直被困扰着,请有这方面经验的高手指点:
(1)程序启动时自动激活OLE,显示一个空的WORD文档
(2)WORD工具条不与主程序菜单和工具条混在一起
(3)打开WORD文档时第一次有些慢,后来都非常快(OLE一直处在激活状态)
最好有源码,要是不方便的话,写关键语句或基本思路也可以,
搞定问题200分立即送上,不够可以再加的,解决其中一个问题给100分,决不食言哦。
我的QQ 28653297 EMILE:lovezuere@163.com
 
OLE我懂的不多,期待问题能快解决, wjp888你的问题解决了后,大家一起再交流一下。
 
大家帮帮忙啊。。。。。。。。。。。。。。。。。。。。。。
 
。。。。。。。。。。。。。。。。。。。。
 
好好看我的程序,已经全部解决了你的所有困难
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Buttons, OleServer, WordXP,comobj,printers,ActiveX;

type
TForm1 = class(TForm)
ListView1: TListView;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
SaveDialog1: TSaveDialog;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure scanlistview;
procedure Button1Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure mytxtsave(myfilename:string);

private
{ Private declarations }
public
{ Public declarations }
end;

type
TmyThread=class(TThread)
private
protected
procedure execute;override;
end;

type
TtxtThread=class(TThread)
private
myfilename:string;
protected
procedure execute;override;
public
constructor create(s:string);
end;


var
Form1: TForm1;
txtlength:array [0..255] of integer;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
lt:tlistitem;
lc:tlistcolumn;
i:integer;
begin
lc:=listview1.Columns.Add;
lc.Caption:='id';
lc:=listview1.Columns.Add;
lc.Caption:='a';
lc:=listview1.Columns.Add;
lc.Caption:='b';
lc:=listview1.Columns.Add;
lc.Caption:='C';

for i:=0 to 10 do
begin
lt:=listview1.Items.Add;
lt.Caption:=inttostr(i);
lt.SubItems.Add('a'+inttostr(i));
lt.SubItems.Add('b'+inttostr(i));

end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
savedialog1.Filter := '文本文件(*.txt)|*.txt';
if savedialog1.Execute then
TtxtThread.create(savedialog1.FileName);
end;

//scanlistview为扫描listview中最大的字符串长度,并将其存入数组txtlength之中;
procedure TForm1.scanlistview;
var
i,s,j:integer;
begin
for i:=0 to listview1.Columns.Count-1 do
begin
txtlength:=length(listview1.Columns.Caption);
end;
for j:=0 to listview1.Items.Count-1 do
begin
for i:=0 to listview1.Items.Item[j].SubItems.Count do
begin
if i=0 then
s:=length(listview1.Items.Item[j].Caption)
else
s:=length(listview1.Items.Item[j].SubItems[i-1]);
if txtlength<s then
txtlength:=s;
end;
end;
// for i:=0 to 10 do
// showmessage(inttostr(txtlength));
end;



procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
i:=listview1.Items.Item[1].SubItems.Count;
showmessage(inttostr(i));
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
newthread:TmyThread;
begin
newthread:=TmyThread.Create(false);
end;
{ TmyThread }

procedure TmyThread.execute;
var
msword,odoc,vtable:variant;
filename:string;
row,col,i,j:integer;
begin
CoInitialize(nil);
i:=0;
j:=0;
with form1 do
begin
col:=listview1.Columns.Count;
row:=listview1.Items.Count;
savedialog1.Filter:='word文档(*.Doc)|*.doc';
if savedialog1.Execute then
try
filename:=savedialog1.FileName;
MSWord:=CreateOLEObject('Word.Application');//连接Word
msword.documents.add;
msword.visible:=true;
msword.ActiveDocument.PageSetup.TopMargin:=2/0.035;
msword.ActiveDocument.PageSetup.BottomMargin := 2/0.035;
msword.ActiveDocument.PageSetup.LeftMargin := 2/0.035;
msword.ActiveDocument.PageSetup.RightMargin := 2/0.035;
msword.activedocument.range(start:=0,end:=0);
msword.Selection.Font.Bold:=wdToggle;
msword.Selection.TypeText(Text:='yubing');
msword.Selection.Font.Bold:=wdToggle;
msword.Selection.Font.Bold:=wdToggle;
msword.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
msword.ActiveDocument.Range.InsertAfter(Text:='Titleffffffffffffff');
msword.Selection.TypeParagraph;
msword.Selection.ParagraphFormat.Alignment:=wdAlignParagraphJustify;
//插入页眉
If msword.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
msword.ActiveWindow.Panes(2).Close;
//If msword.ActiveWindow.ActivePane.View.Type=wdNormalView Or msword.ActiveWindow.ActivePane.View.Type=wdOutlineView Then
msword.ActiveWindow.ActivePane.View.Type:=wdPrintView;
msword.ActiveWindow.ActivePane.View.SeekView:=wdSeekCurrentPageHeader;
msword.Selection.TypeText(Text:='hjgkj');
msword.ActiveWindow.ActivePane.View.SeekView:=wdSeekMainDocument;
//插入页脚
msword.ActiveWindow.ActivePane.View.SeekView:=wdSeekCurrentPageHeader;
If msword.Selection.HeaderFooter.IsHeader = True Then
msword.ActiveWindow.ActivePane.View.SeekView:=wdSeekCurrentPageFooter
else
msword.ActiveWindow.ActivePane.View.SeekView:=wdSeekCurrentPageHeader;
msword.Selection.TypeText(Text:='safsdfas');
msword.ActiveWindow.ActivePane.View.SeekView:=wdSeekMainDocument;

//MSWord.ActiveDocument.Range.InsertAfter(Text:='Titleffffffffffffff');
odoc:=msword.activedocument;
if (row<>0) and (col<>0) then
begin
odoc.tables.add(Range:=msword.Selection.Range, NumRows:=row+1,NumColumns:=col);
//odoc.tables.add(Range:=oDoc.Range(Start:=0, End:=0), NumRows:=row+1,NumColumns:=col);
vTable:=MSWord.ActiveDocument.Tables.Item(1);
vTable.PreferredWidthType := wdPreferredWidthPercent;
vTable.PreferredWidth := 80;
vTable.Rows.Alignment :=wdAlignRowCenter;
for j:=1 to row+1 do
for i:=1 to col do
begin
if j=1 then
vTable.Cell(j, i).Range.Text :=listview1.Columns[i-1].Caption
else
if i<=listview1.Items.Item[j-2].SubItems.Count+1 then
if i=1 then
vTable.Cell(j, i).Range.Text :=listview1.Items.Item[j-2].Caption
else
vTable.Cell(j, i).Range.Text :=listview1.Items.Item[j-2].SubItems[i-2];
end;
end;
//MSWord.Selection.Tables(1).Select;
//MSWord.Selection.Tables.PreferredWidthType := wdPreferredWidthPercent;
//MSWord.Selection.Tables.PreferredWidth := 80;
//MSWord.Selection.Columns.PreferredWidth:=CentimetersToPoints(3.2);

//msword.Selection.MoveDown(Unit:=wdLine, Count:=row+1);
msword.Selection.GoTo(What:=wdGoToLine, Which:=wdGoToFirst, Count:=row+3, Name:='');
msword.Selection.TypeText(Text:='yubing');
MSWord.Selection.ParagraphFormat.Alignment:=wdAlignParagraphRight;


MSWord.ActiveDocument.Range.InsertAfter(Text:='ssdd');

MSword.ActiveDocument.saveas(FileName:=filename,FileFormat:=wdFormatDocument,
LockComments:=False, Password:='', AddToRecentFiles:=True, WritePassword:='',
ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False,
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False);
MSword.ActiveDocument.close;
msword.quit;
except
showmessage('没有安装word,请安装word,否则将无法使用该功能');
end;
end;
CoUninitialize;
{ TtxtThread }
end;


constructor TtxtThread.create(s: string);
begin
myfilename:=s;
inherited create(false);
end;

procedure TtxtThread.execute;
begin
with form1 do
mytxtsave(myfilename);
end;



procedure TForm1.mytxtsave(myfilename: string);
var
lt,rt,ld,rd,cb,c,hb,cc,ct,cd,h,lc,rc:string; //lt,tr代表左上角和右上角,ld,rd代表左下角和右下角
myfile:textfile;
i,j,temp,k:integer;
begin
lt:='┏';
rt:='┓';
ld:='┗';
rd:='┛';
cb:='━';
c:='─';
ct:='┯';
cd:='┷';
cc:='┼';
hb:='┃';
h:='│';
lc:='┠';
rc:='┨';
//savedialog1.Filter := '文本文件(*.Txt)|*.txt';
// if savedialog1.Execute then
// begin
// myfilename:=savedialog1.FileName;
assignfile(myfile,myfilename);
rewrite(myfile);
try
scanlistview;
//表格的头部
//showmessage(listview1.Columns[0].Caption);
for i:=0 to listview1.Columns.Count do
write(myfile,' ');
writeln(myfile,'kljd');
write(myfile,lt);
for i:=0 to listview1.Columns.Count-1 do
begin
for j:=0 to txtlength+1 do
write(myfile,cb);
if i<listview1.Columns.Count-1 then
write(myfile,ct);
end;
writeln(myfile,rt);
//表格的内容
write(myfile,hb);
for i:=0 to listview1.Columns.Count-1 do
begin
write(myfile,listview1.Columns.Caption);
temp:=(txtlength+1)*2-length(listview1.Columns.Caption);
for j:=0 to temp+1 do
write(myfile,' ');
if i<listview1.Columns.Count-1 then
write(myfile,h);
end;
writeln(myfile,hb);
for k:=0 to listview1.Items.Count-1 do
begin
write(myfile,lc);
for i:=0 to listview1.Columns.Count-1 do
begin
for j:=0 to txtlength+1 do
write(myfile,c);
if i<listview1.Columns.Count-1 then
write(myfile,cc);
end;
writeln(myfile,rc);
write(myfile,hb);
for i:=0 to listview1.Columns.Count-1 do
begin
if i<listview1.Items.Item[k].SubItems.Count+1 then
begin
if i=0 then
begin
write(myfile,listview1.Items.Item[k].Caption);
temp:=(txtlength+1)*2-length(listview1.Items.Item[k].Caption);
end
else
begin
write(myfile,listview1.Items.Item[k].SubItems[i-1]);
temp:=(txtlength+1)*2-length(listview1.Items.Item[k].SubItems[i-1]);
end;
end
else
begin
temp:=(txtlength+1)*2;
//showmessage(inttostr(temp));
end;
for j:=0 to temp+1 do
write(myfile,' ');
if i<listview1.Columns.Count-1 then
write(myfile,h);
end;
writeln(myfile,hb);
end;

//表格尾部的内容
write(myfile,ld);
for i:=0 to listview1.Columns.Count-1 do
begin
for j:=0 to txtlength+1 do
write(myfile,cb);
if i<listview1.Columns.Count-1 then
write(myfile,cd);
end;
writeln(myfile,rd);
finally
closefile(myfile);
end;
// end;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
if Printer.Printers.Count=0 then
showmessage('请首先安装打印机')
else
print;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
var
filename:string;
ExcelApp: Variant;
row,col,i,j:integer;
begin
i:=0;
j:=0;
col:=listview1.Columns.Count;
row:=listview1.Items.Count;
savedialog1.Filter:='excel文档(*.xls)|*.xls';
if savedialog1.Execute then
try
filename:=savedialog1.FileName;
ExcelApp:=CreateOleObject('Excel.Application');
ExcelApp.WorkBooks.Add;
ExcelApp.Visible := false;
//ExcelApp.Caption := '应用程序调用 Microsoft Excel';
ExcelApp.ActiveSheet.Rows[1].Font.Name := '隶书';
ExcelApp.ActiveSheet.Rows[1].Font.Color := clBlue;
ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;

ExcelApp.Cells[1,col DIV 2].Value:='FF';
for j:=1 to row+1 do
for i:=1 to col do
begin
if j=1 then
ExcelApp.Cells[j+1,i].Value:=listview1.Columns[i-1].Caption
else
if i<=listview1.Items.Item[j-2].SubItems.Count+1 then
if i=1 then
ExcelApp.Cells[j+1,i].Value:=listview1.Items.Item[j-2].Caption
else
ExcelApp.Cells[j+1,i].Value:=listview1.Items.Item[j-2].SubItems[i-2];
end;
try
ExcelApp.ActiveSheet.SaveAs(filename);
except
showmessage('保存失败');
end;
ExcelApp.WorkBooks.Close;
ExcelApp.Quit;
except
showmessage('没有安装excel,请安装excel,否则将无法使用该功能');
end;
end;

end.
 
to: yubing8
您好,感谢您的参与,您的回答是DELPHI 控制WORD里的一部分,很好一篇技术文章,
不过和我的问题好象不太贴切,也可能是我说的不够详细吧.在程序里我想实现这样的功能,
界面上一个ToolBar,ToolBar上有需要用的按钮,比如OPEN,SAVE,等
一个TreeView(),一个Splite(),一个OleContainer().
(1)在程序启动的时候Ole是被激活的,同时打开了一个空WORD文档
(2)打开的WORD显示的工具栏不另占一行,TOP与左边的TreeView的TOP平行
(3)通过左边的TreeView选择数据库中的文档名,Ole中显示相对应的文档
这几个问题用常用方法能得到解决,可是也存在很多问题,比如
(1)程序启动时打开的这个空文档,能否Create一个空的Word文档,而不是
打开指定的空文件.
(2)激活的Ole显示的WORD工具栏在ToolBar下独占了一行,怎样才能与Word正文
象一体,即Word工具栏不要独占一行,而是与TreeView的Top相等.
(3)每次打开新的Word文档的时候,文件打的时候比较慢,而且还有很
不美气的地方就是那个Word工具栏老是先消失再显示,怎样才能不让那个
Word工具栏闪来闪去的,让它一直显示着.怎样提高打开数据库中Word文档的
速度,以前有人说先建一个Word的应用服务器(记不大清楚了)可以解决,请问怎么建
这个服务器
以上我碰到的问题,在我看到的那个老前辈的作品中都解决的很好,
DelPhi与Word自然协调的融合在了一起,可惜现在一直联系不到他老人家了
我这几天一直研究这个问题,试了很多方法也没解决,请大家帮忙,
我另开号给分.谢谢大家,希望能得到您的帮助.
 
(1)程序启动时打开的这个空文档,能否Create一个空的Word文档,而不是
打开指定的空文件.
我的程序就是Create一个空的Word文档,你再好好看看
(2)激活的Ole显示的WORD工具栏在ToolBar下独占了一行,怎样才能与Word正文
象一体,即Word工具栏不要独占一行,而是与TreeView的Top相等.
这是什么意思??没看懂
(3)每次打开新的Word文档的时候,文件打的时候比较慢,而且还有很
不美气的地方就是那个Word工具栏老是先消失再显示,怎样才能不让那个
Word工具栏闪来闪去的,让它一直显示着.怎样提高打开数据库中Word文档的
速度,以前有人说先建一个Word的应用服务器(记不大清楚了)可以解决,请问怎么建
这个服务器
Word的应用服务器这个不知道怎么解决
以上我碰到的问题,在我看到的那个老前辈的作品中都解决的很好,
DelPhi与Word自然协调的融合在了一起,可惜现在一直联系不到他老人家了
我这几天一直研究这个问题,试了很多方法也没解决,请大家帮忙,
把这个程序发给我看看
 
1)程序启动时打开的这个空文档,能否Create一个空的Word文档,
OleContainer.CreateObject('Word.Document', False);
(2)激活的Ole显示的WORD工具栏在ToolBar下独占了一行
OleContainer 放在一个Form或Frame中 ,
(3)启动word实例后以后都会很快的!
 
我的号上没分了,问题转到我朋友的号tysea上问了,请有经验的朋友帮忙 :)
正在探索中的朋友一起探讨。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2132123
 

Similar threads

D
回复
0
查看
743
DelphiTeacher的专栏
D
D
回复
0
查看
746
DelphiTeacher的专栏
D
D
回复
0
查看
761
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部