word_use.pas

对金智能试卷软件的功能补充

//************************************************************************//
//                 一些关于WORD操作的函数                                 //
//                                                                        //
//                   作者：耿卫国                                         //
//                                                                        //
//                    2005-8-16                                           //
//                                                                        //
//************************************************************************//
{////
        worddoc.sentences  代表一行，不包括空行。
        worddoc.paragraphs 也代表一行，包括空行。
        range              表示一个范围
        selection          表示选定的内容

//// }
unit word_use;
interface

uses comobj, Word2000,Dialogs,OleCtnrs,Windows,SysUtils;

{建立WORD对象，SH决定是否显示}
function openwordapp(): OleVariant;

function WordReplace(var wordapp: OleVariant;docText, newText: string; bSimpleReplace: boolean = false): boolean;

procedure WordSave(var worddoc: OleVariant);

procedure WordEnd(var worddoc,wordApp: OleVariant);
{新建WORD文档}
function NewWordDoc(var Wordapp : OleVariant):OleVariant;
{打开WORD文档}
function OpenWordDoc(var Wordapp :OleVariant;filename :string):OleVariant;




implementation


function OpenWordApp(): OleVariant;
var
   Wordapp : OleVariant;
   Hword   : Thandle;
begin

   HWord:=FindWindow(NIL,'Microsoft Word');
   if (hWord = 0)  THEN
      begin
         try
            Wordapp := CreateOleObject('Word.Application');
         except
            ShowMessage('启动 Microsoft word 失败'+#13+ '请检查word是否正确安装');
            Exit;
         end;
      end
   else
      Wordapp := GetActiveOleObject('Word.Application');
   result:= Wordapp;
end;


function NewWordDoc(var Wordapp : OleVariant):OleVariant;
VAR
    worddoc: OleVariant;
begin
    try
     wordDoc := WordApp.Documents.Add;
    except
       ShowMessage('建立 word文档失败');
       worddoc.Close;
    end;
      result := worddoc;
end;

function OpenWordDoc(var Wordapp :OleVariant;filename :string):OleVariant;
VAR
    worddoc: OleVariant;
begin
    try
      wordDoc := WordApp.Documents.open(filename);

    except
       ShowMessage('打开 word文档失败');
       worddoc.Close;
    end;
      result := worddoc;
end;


function WordReplace(var wordapp: OleVariant;docText, newText: string; bSimpleReplace: boolean = false): boolean;
var
  i : Integer;
  reword: OleVariant;
begin
  if bSimpleReplace then
  begin
    //简单处理，直接执行替换操作
    try
      wordapp.Selection.Find.ClearFormatting;
      wordapp.Selection.Find.Replacement.ClearFormatting;
      wordapp.Selection.Find.Text := docText;
      wordapp.Selection.Find.Replacement.Text := newText;
      wordapp.Selection.Find.Forward := True;
      wordapp.Selection.Find.Wrap := wdFindContinue;
      wordapp.Selection.Find.Format := False;
      wordapp.Selection.Find.MatchCase := False;
      wordapp.Selection.Find.MatchWholeWord := true;
      wordapp.Selection.Find.MatchByte := True;
      wordapp.Selection.Find.MatchWildcards := False;
      wordapp.Selection.Find.MatchSoundsLike := False;
      wordapp.Selection.Find.MatchAllWordForms := False;
      wordapp.Selection.Find.Execute(Replace := wdReplaceAll);
      result := true;
    except
      result := false;
    end;
    exit;
  end;
  //自动分行
  reword.Lines.Clear;
  reword.Lines.Add(newText);
  try
    //定位到要替换的位置的后面
    Wordapp.Selection.Find.ClearFormatting;
    Wordapp.Selection.Find.Text := docText;
    Wordapp.Selection.Find.Replacement.Text := '';
    Wordapp.Selection.Find.Forward := True;
    Wordapp.Selection.Find.Wrap := wdFindContinue;
    Wordapp.Selection.Find.Format := False;
    Wordapp.Selection.Find.MatchCase := False;
    Wordapp.Selection.Find.MatchWholeWord := False;
    Wordapp.Selection.Find.MatchByte := True;
    Wordapp.Selection.Find.MatchWildcards := False;
    Wordapp.Selection.Find.MatchSoundsLike := False;
    Wordapp.Selection.Find.MatchAllWordForms := False;
    Wordapp.Selection.Find.Execute;
    Wordapp.Selection.MoveRight(wdCharacter, 1);
    //开始逐行插入

    for i := 0 to reword.Lines.Count - 1 do
    begin
      //插入当前行
      Wordapp.Selection.InsertAfter(reword.Lines[i]);
      //除最后一行外，自动加入新行
      if i < reword.Lines.Count - 1 then
        Wordapp.Selection.InsertAfter(#13);
    end;
    //删除替换位标
    Wordapp.Selection.Find.ClearFormatting;
    Wordapp.Selection.Find.Replacement.ClearFormatting;
    Wordapp.Selection.Find.Text := docText;
    Wordapp.Selection.Find.Replacement.Text := '';
    Wordapp.Selection.Find.Forward := True;
    Wordapp.Selection.Find.Wrap := wdFindContinue;
    Wordapp.Selection.Find.Format := False;
    Wordapp.Selection.Find.MatchCase := False;
    Wordapp.Selection.Find.MatchWholeWord := true;
    Wordapp.Selection.Find.MatchByte := True;
    Wordapp.Selection.Find.MatchWildcards := False;
    Wordapp.Selection.Find.MatchSoundsLike := False;
    Wordapp.Selection.Find.MatchAllWordForms := False;
    Wordapp.Selection.Find.Execute(Replace := wdReplaceAll);
    result := true;
  except
    result := false;

  end;

end;



function PrnWordInsert(var worddoc: OleVariant;lineText: string; bNewLine: boolean =
  true): boolean;
var
  i : Integer;
  reword: OleVariant;
begin
  try
    if bNewLine then
      worddoc.Range.InsertAfter(#13);
    //自动分行
    reword.Lines.Clear;
    reword.Lines.Add(lineText);
    //开始逐行插入
    for i := 0 to reword.Lines.Count - 1 do
    begin
      //插入当前行
      worddoc.Range.InsertAfter(reWord.Lines[i]);
      //除最后一行外，自动加入新行
      if i < reWord.Lines.Count - 1 then
        worddoc.Range.InsertAfter(#13);
    end;
    result := true;
  except
    result := false;
  end;
end;



{
功能：保存Word文件
}
procedure WordSave(var worddoc: OleVariant);
begin
  try
    worddoc.Save;
  except
  end;
end;
{
功能：关闭Word文件
}
procedure WordEnd(var worddoc,wordApp: OleVariant);
begin
  try
    worddoc.Close;
    wordApp.Quit;
  except
  end;

end;





end.




{**************************  一些参考例程 *******************************

***************************************************************************
         WordDoc.Sentences.Last.Paste;
         WordApp.Selection.InsertFile('c:\sd.doc', '', False, false, false);
         wordApp.Selection.TypeText(#13);
         worddoc.Range.InsertAFTER('Range');
         WordDoc.Paragraphs.Last.Range.InsertBreak(Break);
         wordApp.Selection.TypeText('NO1');
         WordDoc.Paragraphs.Last.Range.InsertFile('c:\sd.doc',EmptyParam,
                                        EmptyParam,EmptyParam,EmptyParam);
         wordApp.selection.EndKey();

           WordApp.Selection.TypeParagraph;
           WordApp.Selection.Font.Bold :=0;
           WordApp.Selection.Font.Size :=10;
           WordApp.Selection.ParagraphFormat.Alignment := wdAlignParagraphright
           WordApp.ActiveDocument.sentences.Last.Text :='yyr';
           //画第一个矩形框
  worddoc.SHAPES.AddTextbox(Orientation:=1,  Left:=90, Top:=70, Width:=414, Height:=200);
  //画一条竖线
  worddoc.Shapes.AddLine(255, 70, 255,270);
  //画第一幅图
  worddoc.SHAPES.addpicture(ExtractFilePath(Application.ExeName)+'photo\108259.jpg',
  LinkToFile:=False, SaveWithDocument:=True, Left:=180, Top:=80, Width:=65, Height:=80);
  //画第二幅图
  worddoc.SHAPES.addpicture(ExtractFilePath(Application.ExeName)+'photo\108259.jpg',
  LinkToFile:=False, SaveWithDocument:=True, Left:=262, Top:=80, Width:=65, Height:=80);

  //画 姓名 框
  wordShape:=worddoc.Shapes.AddTextbox(Orientation:=1, Left:=108, Top:=198, Width:=126, Height:=18);
  wordShape.Line.Visible := false;
  wordShape.TextFrame.TextRange.Text := '姓名：新之助';
  //年龄  框
  wordShape:=worddoc.Shapes.AddTextbox(Orientation:=1, Left:=108, Top:=225, Width:=126, Height:=18);//.Select;
  wordShape.Line.Visible := false;
  wordShape.TextFrame.TextRange.Text := '年龄：12';
  //个人信息  框
  wordShape:=worddoc.Shapes.AddTextbox(Orientation:=1, Left:=351, Top:=90, Width:=126, Height:=99);//.Select;
  wordShape.Line.Visible := false;
  wordShape.TextFrame.TextRange.Text := '个人信息';
  //文本框中添加表格
  wordShape:=worddoc.Shapes.AddTextbox(Orientation:=1, Left:=288, Top:=198, Width:=189, Height:=63);//.Select;
  wordShape.Line.Visible := false;
  WordTable := worddoc.Tables.Add(Range:=wordShape.TextFrame.TextRange, NumRows:=3, NumColumns:=2,
         DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed);
  WordTable.Cell(1, 1).Range.Text := '体重';
  WordTable.Cell(1, 2).Range.Text := '40kg';
  WordTable.Cell(2, 1).Range.Text := '身高';
  WordTable.Cell(2, 2).Range.Text := '120cm';
  WordTable.Cell(3, 1).Range.Text := '坐高';
  WordTable.Cell(3, 2).Range.Text := '65cm';

  WordDoc.saveas(filename);
  application.MessageBox('  输出成功！  ','提示框',mb_ok);

  finally
  WordDoc.Saved:=true;
  WordDoc.Close;
  WordApp.Quit;
  end;

end;

   加虚线
uses ComObj;
procedure AddDashedToDoc(const DocName: string; const x1, y1, x2 ,y2: Integer);
const
  wdAlertsNone = $00000000;
  msoLineSolid = $00000001;//实线
  msoLineSquareDot ＝ $00000002;//方点线
  msoLineRoundDot = $00000003;//圆点线
  msoLineDash = $00000004;//虚线
  //类推
var
  DocApp, DocLine: OleVariant;
begin
  try
    try
      DocApp := CreateOleObject('Word.Application');
      DocApp.DisplayAlerts := wdAlertsNone;
      DocApp.Documents.Add;
      DocLine := DocApp.ActiveDocument.Shapes.AddLine(x1, y1, x2, y2);
      DocLine.Line.DashStyle := msoLineDash;
      DocApp.ActiveDocument.SaveAs(DocName);
    except
    end;
  finally
    if not VarIsEmpty(DocApp) then
      DocApp.Quit;
    DocApp := Unassigned;
  end;
end; 


有关表格
procedure AddDataToWordTable(const TestData: TTestData);
const
  wdAlertsNone = $00000000;
  wdAutoFitFixed = $00000000;
  wdAlignRowCenter = $00000001;
  wdAlignParagraphCenter = $00000001;
  wdCellAlignVerticalCenter = $00000001;
var
  WordApp, WordTbl: OleVariant;
  I: Integer;
begin
  try
    try
      WordApp := CreateOleObject('Word.Application');
      WordApp.DisplayAlerts := wdAlertsNone;
      WordApp.Documents.Add;
      WordApp.Selection.TypeText('单位名称：“要写入的数据”');
      WordApp.Selection.TypeParagraph;
      WordTbl := WordApp.ActiveDocument.Tables.Add(WordApp.Selection.Range, Length(TestData) + 1, 3);

      //设置表格格式
      WordTbl.AutoFitBehavior(wdAutoFitFixed);//固定列宽
      WordTbl.AllowPageBreaks := False;//不允许跨页断行
      WordTbl.Rows.Alignment := wdAlignRowCenter;//表格居中方式
      WordTbl.Borders.OutsideLineStyle := 1;
      WordTbl.Borders.OutsideLineWidth := 12;
      WordTbl.Borders.InsideLineStyle := 1;
      WordTbl.Borders.InsideLineWidth := 4;
      WordTbl.Range.Font.Name := '宋体';
      WordTbl.Range.Font.Size := 9;
      WordTbl.Select;
      WordApp.Selection.Paragraphs.Alignment := wdAlignParagraphCenter;//单元格水平居中方式
      WordTbl.Range.Cells.VerticalAlignment := wdCellAlignVerticalCenter;//单元格垂直居中方式
      WordTbl.Rows.Height := 16;//设置行高

      //填入数据
      WordTbl.Cell(1, 1).Range.Text := '序号';
      WordTbl.Cell(1, 2).Range.Text := '最大试验值';
      WordTbl.Cell(1, 3).Range.Text := '最小试验值';
      for I := 0 to Length(TestData) - 1 do
      begin
        WordTbl.Cell(I + 2, 1).Range.Text := IntToStr(I + 1);
        WordTbl.Cell(I + 2, 2).Range.Text := FloatToStr(TestData[I].MaxVal);
        WordTbl.Cell(I + 2, 3).Range.Text := FloatToStr(TestData[I].MinVal);
      end;

      WordApp.Visible := True;
    except
      if not VarIsEmpty(WordApp) then
        WordApp.Quit;
    end;
  finally
    WordApp := Unassigned;
  end;
end;

 请问如何选定word中第N行或第N段中的内容？ 
 

var MyWord,  What,    Which,    Count,    Name:OleVariant;
初始化MyWord后
  MyWord:=CreateOleObject('Word.Application');
去到第N页
begin
  What:=wdGoToPage;
  Which:=wdGoToNext;
//  Count:=
  Name:='10';               //第N页
  MyWord.Selection.GoTo(What,Which,Count,Name);
end;
去到第N行
begin
  What:=wdGoToLine;
  Which:=wdGoToFirst;
  Count:=25;
  Name:='';
  MyWord.Selection.GoTo(What,Which,Count,Name);
end;

WORD存为文本文件
 WordDoc:=WordApp.Documents.Item(itemindex);
  WordApp.Documents[1].saveas('aaa.txt');

************************************************************************
********************************************************************}