u_msword.pas

delphi操作word的源码

unit U_MsWord;

interface

uses
  Windows, Classes ,SysUtils,Graphics, Forms ,ComObj ,Variants,
  StrUtils,DB,ADODB;
Const
    MSG_NOT_CONNECT='WORD程序没有响应，请稍后再试!';
    CAPTION_SYSTEM ='志文工作室软件系统';
Const
    IndentUnitePoint=10;    //每单位缩进的点数
    TitleFontSize   =12;    //标题行的字体大小
    ContentFontSize =9;    //内容行的字体大小
    TryLimited     =3;
    WordTableTitleFontSize=12;
    WordTableFontSize=9;   //word表的字体大小
{**********************************************************************
      类名:     TWordObject
      开发时间: 2003-08-29
      开发人:  李志文
      功能描述：实现对WORD的OLE控制
      =======
      Create   创建并启动Word
      属性:
         Active 启动WORD

*************************************************************************}
type
     TMS_WORD_Align=(mwaAlignLeft,mwaAlignCenter,mwaAlignRight);
     TMs_WordView=(mwvNormail,mwvPageview,mwvMasterView);
type
  TWordObject = class(TObject)
  private
    FWordApp          : OLEVariant;                 //word服务程序
    FCurrentDoc       : OLEVariant;                 //当前正打开的WORD文件
    FCurrentDocName   : String;                     //当前的WORD文件名
    FbConnect         : Boolean;                    //表示word是否启动
    FFont             : TFont;
   // FFileCount        : integer;                    {打开的文件数量}
    FHaveFileOpen     : Boolean;
    FViewStyle: TMs_WordView;
    Procedure set_Connect;                          {连接WORD服务器}
    Procedure Set_DisConnect;                       {关闭WORD服力器}
    function  GetCaption : String;
    procedure SetCaption(Value : String);
    function  GetVisible : Boolean;
    {设置WORD服务程序的可见性}
    procedure SetVisible(Value : Boolean);
    Function  Get_ActiveDocument:OleVariant;
    procedure Set_ActiveDocument(const Value: OleVariant);
    {设置与WORD服务的联接活动状态}
    procedure Set_Active(const Value: Boolean);

    procedure Set_Font(Value: TFont);
    {新加一张表格}
    Procedure AddNewTable(Const AMS_Document: OLEVariant;
                             var AMS_Table: OLEVariant; const ACols,
                                    ARows: integer);
    {设置WORD视图显示的样式}
    procedure Set_ViewStyle(const Value: TMs_WordView);
  public
    constructor Create; overload;        //启动WORD程序
    Constructor Create(Const AConnect :Boolean); overload;
    destructor Destroy; override;
    Property  CurrentDoc    :OleVariant Read FCurrentDoc;
    Property  ActiveDocument:OleVariant Read Get_ActiveDocument Write Set_ActiveDocument;

    Function  NewDoc:OleVariant;
    {增加一页，word}
    Procedure NewPage;overload;
    {根据分面符号增加一页分页符}
    Procedure NewPage(Const PageBreakIDen:String);overload;
    {复杂所有文档}
    Procedure CopyAll;
    {粘贴所有文档}
    Procedure PastAll;
    {打开文档}
    Function  OpenDoc(Const FullFileName:String):Boolean;
    {检查指定的文件名称的文档有没有初WORD打开}
    Class Function  CheckDocOpen(Const FullFileName:String):Boolean;
    {关闭当前WORD文档   不保存}
    procedure CloseDoc;
    {关闭指定的文档}
    Class Function  CloseDocument(Const FullName:String):Boolean;
    {打印当前的文档}
    procedure Print;
    {将当前的文档保存}
    Procedure Save;
    {将当前的文档保存为指定的文件名称}
    Procedure DocumentSaveAs(Const FileName:String);

    {文档定位}
    {返回指定名称的worddocument变量}
    Function  Get_WordDoCument(Const FileName:string;Var MS_Document:OleVariant):Boolean; overload;

    Function  Get_WordDocument(Const FullFileName:String):Boolean;overload;

    {*******以下功能主要实功数据的传入*******************************************}  
    {输出文本到WORD文件}
    procedure InsertText(Const Text : String);
    {在当前WORD文档上输出一个回车换行符}
    Procedure TypeParagraph;
    //向前回退的次数
    Procedure  set_ListOutDent(OutDentCount:Integer);
    //向后缩进的次数
    Procedure  Set_ListIndent(IndentCount:Integer);
    {按指定字符数向后缩进}
    Procedure  LeftIndent(Const IndentCount:Integer);
    Procedure  RowNumber(NumberStyle:integer;StartNumber:integer=1);
    {光标定位到文件头部}
    procedure  MoveToHome;
    {光标向上移一行}
    Procedure  MoveUp;
    {光标定位到文件尾部}
    Procedure  MoveToEnd;
    {光标向下移一行}
    procedure  MoveDown;


    {查找文字}
    Function  Find(FindString:String):Boolean;
    {替换WORD中的所有文字}
    Procedure Replace(FindString,ReplaceWithString:String);
    {特定功能}

    {**********以下是输出表格数据的相关函数**************************************************}
    
    {获取当前表的行号列号}
    Procedure  Get_CurrColAndRow(Var ACol,ARow:integer);
    {返回当前的行数列数}
    Function   Get_CurrColsAndRows(Var ACols,ARows:integer) : Boolean;
    {返回表格的行数}
    Function   Get_CurrRows : integer;
    {返回当前在表格的行号}
    Function   Get_CurrRow : integer;
    {判断光标所在的位置是否为表}
    Function  IsCell(ASelection :OLEVariant):Boolean;
    {检查是否在表格内}
    Function   isInTables:Boolean;
  published
   // property Application : Vi read FWordApp;
   //激活WORD
    Property Active  : Boolean Read FbConnect Write Set_Active;
   //WORD显示的标题
    property Caption : String read  GetCaption write SetCaption;
   //word是否可见
    property Visible : Boolean read GetVisible write SetVisible;
    //当前表名
    Property CurrentDocName  :String Read FCurrentDocName;
    //Word字体设置
    Property Font    :TFont Read FFont Write Set_Font;
    Property ViewStyle : TMs_WordView Read FViewStyle write Set_ViewStyle;
  end;
implementation
uses U_WordConst;
{ TWordObject } 
//起动WORD服务器
{ **************************************************************************************
    过程中文名称：设置与WORD服务的联接状态为联接
    功能说明：    设置与WORD服务的联接状态为联接
    参数说明：
    返加值：                           
最初编写日期：2004-3-11
  最初编写人: 李志文
***************************************************************************************    }
procedure TWordObject.set_Connect;
begin
    try
         FWordApp:=GetActiveOleObject('word.Application');
         FbConnect:=True;
    Except
      try
         FWordApp:=CreateOleObject('word.Application');
         FbConnect:=True;
       Except
         On E: Exception do
         begin
            Application.MessageBox(pchar(e.Message),'错误',MB_OK+MB_ICONERROR);
            FbConnect:=False;
         end;
       end;
    end;
end;
{ **************************************************************************************
    过程中文名称：设置与WORD服务的联接状态为断开
    功能说明：    设置与WORD服务的联接状态为断开
    参数说明：
    返加值：
最初编写日期：2004-3-11
  最初编写人: 李志文
***************************************************************************************    }
procedure TWordObject.Set_DisConnect;
begin
    if VarType(FWordApp)<>varDispatch  then
    begin
     FbConnect:=False;
     exit;
    end;
    if  FbConnect then
    begin
      FWordApp.Quit(True);
      FWordApp:=Unassigned;
      FCurrentDoc:=Unassigned;
      FbConnect:=False;
    end;
end;
{ **************************************************************************************
    过程中文名称：初始化WORD对象  直接连接WORD
    功能说明：    初始化WORD对象
    参数说明：
    返加值：
最初编写日期：2004-3-11
  最初编写人: 李志文
***************************************************************************************    }
constructor TWordObject.Create;
begin
      FbConnect:=False;
      FHaveFileOpen:=False;
      set_Connect;
      if FbConnect then
      begin
        FWordApp.Caption:=CAPTION_SYSTEM;
        FFont:=TFont.Create;
      end;
end;
constructor TWordObject.Create(const AConnect: Boolean);
begin
    if AConnect then
    begin
      set_Connect;
      if FbConnect then
      begin
        FWordApp.Caption:=CAPTION_SYSTEM;
        FFont:=TFont.Create;
      end;
    end
    else
      Set_DisConnect;
end;

{ **************************************************************************************
    过程中文名称：设置与WORD服务的联接活动状态
    功能说明：    设置与WORD服务的联接活动状态
    参数说明：
    返加值：
最初编写日期：2004-3-11
  最初编写人: 李志文
***************************************************************************************    }
procedure TWordObject.Set_Active(const Value: Boolean);
begin
     if FbConnect <> Value then
     begin
       FbConnect := Value;
       if FbConnect then
       begin
          set_Connect;
       end
       else
       begin
         Set_DisConnect;
       end;
     end;
end;
{ **************************************************************************************
    过程中文名称：释放WORD控制对象
    功能说明：    释放WORD控制对象
    参数说明：
    返加值：
最初编写日期：2004-3-11
  最初编写人: 李志文
***************************************************************************************    }
destructor TWordObject.Destroy;
begin
   FFont.Free;
   FWordApp:=Unassigned;
   FCurrentDoc:=Unassigned;
  inherited Destroy;
end;
{ **************************************************************************************
    过程中文名称：关闭当前WORD文档   不保存
    功能说明：    关闭当前WORD文档
    参数说明：
    返加值：
最初编写日期：2004-3-11
  最初编写人: 李志文
***************************************************************************************    }
procedure TWordObject.CloseDoc;
begin
      if VarType(FCurrentDoc)<>varDispatch  then
         FCurrentDoc.close;
end;
{ **************************************************************************************
    过程中文名称：关闭指定的WORD文档
    功能说明：    关闭指定的WORD文档
    参数说明：
    返加值：
最初编写日期：2004-3-11
  最初编写人: 李志文
***************************************************************************************    }
Class function TWordObject.CloseDocument(Const FullName: String): Boolean;
var
   i                  : integer;
   Ms_Word            : Variant;     //打开的OLE对象
begin

          Result:=False;
          try
            try
               Ms_Word:=GetActiveOleObject('word.Application');
            Except
               Result:=true;
               exit;
            end;
            For i:=1 to Ms_Word.Documents.Count do
            begin
                if Ms_Word.Documents.Item(i).FullName=FullName then
                begin
                   Ms_Word.Documents.Item(i).Save;
                   Ms_Word.Documents.Item(i).Close;
                   Result:=true;
                end;
            end;
          finally
             Ms_Word:=Unassigned;
          end;
end;
{ **************************************************************************************
    过程中文名称：取得WORD服务器的名称
    功能说明：    取得WORD服务器的名称
    参数说明：
    返加值：
最初编写日期：2004-3-11
  最初编写人: 李志文
***************************************************************************************    }
function TWordObject.GetCaption: String;
begin
    Result:='';
    if VarType(FWordApp)<>varDispatch  then exit;
     Result:=FWordApp.Caption;
end;
{ **************************************************************************************
    过程中文名称：设置WORD服务器的名称
    功能说明：    设置WORD服务器的名称
    参数说明：
    返加值：