好好看我的程序,已经全部解决了你的所有困难
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.