wordreport.pas

Wordreport是使用word设置打印格式的一种报表打印控件

unit WordReport;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DsgnIntf;

type
  TWordReport = class;

  TReportEvent = procedure(Sender: TWordReport; var Word: OleVariant) of object;

  TAboutWordReport = class
  end;

  TWordReport = class(TComponent)
  private
    { Private declarations }
    word,doc,formfld:OleVariant;
    Fwordtable:integer;
    Fperpage,docopen,Fautoprint,Ftitleauto:boolean;
    FTemplateName:string;
    FMaster:TDataSet;
    FvarPrint:TReportEvent;
    FDetailPrint:TReportEvent;
    FPreview:boolean;
    FAboutWordReport:TAboutWordReport;
    procedure runprint;
    procedure printauto;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
    procedure Execute;
    procedure adddoc;
    procedure SHOWABOUT;
    function getformfields:tstringlist;     //返回窗口变量名称
    function getformfieldscount:integer;     //返回窗口变量 个数
    function gettablescount:integer;       //返回文档中表之个数
    function gettablecols(tbindex:integer):integer;  //返回文档中表列数
    function gettablerows(tbindex:integer):integer;  //返回文档中表行数
    procedure showword;              //显示word
    procedure deletedoc;              //删除模板
    procedure settablevalue(tbindex,row,col:integer;value:string);  //数据填入表中
    procedure setformfiledvalue(formfldname:OleVariant;value:string);  //数据填入变量
    procedure addtablerows(tbindex,rows:integer);  //表行数增加
    procedure addtablecols(tbindex,rows:integer);  //表列数增加
    procedure managedoc;      //基本情况
    procedure showopen;
    procedure openword;
    procedure closeword;
    procedure setcaption(cap:string);
    procedure print;
    procedure showwait;
    procedure totaljd(max,value:integer);
    procedure fieldjd(max,value:integer);
    function formfieldexists(formfld:OleVariant):boolean;
  published
    { Published declarations }
    property titleauto:boolean read Ftitleauto write Ftitleauto;
    property wordtable:integer read Fwordtable write Fwordtable default 1;
    property autoprint:boolean read Fautoprint write Fautoprint;
    property pageperrecord:boolean read Fperpage write Fperpage;
    property FILEName:string read FTemplateName write FTemplateName;
    property Dataset:TDataSet read FMaster write FMaster;
    property DetailPrint:TReportEvent read FDetailPrint write FDetailPrint;
    property varPrint:TReportEvent read FvarPrint write FvarPrint;
    property Preview:boolean read FPreview write FPreview;
    property About:TAboutWordReport read FAboutWordReport write FAboutWordReport;
  end;

  TAboutWordReportProp=class (TPropertyEditor)
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;
  TDOCFileProperty = class(TStringProperty)
  public
	 procedure Edit; override;
	 function GetAttributes: TPropertyAttributes; override;
  end;

  procedure Register;

implementation

uses ComObj, uAbout, uWait;

procedure Register;
begin
  RegisterComponents('Mohan', [TWordReport]);
  RegisterPropertyEditor(TypeInfo(TAboutWordReport), nil,
    '', TAboutWordReportProp);
  RegisterPropertyEditor(TypeInfo(string), TWordReport, 'FILEName', TDOCFileProperty);

end;

procedure TDOCFileProperty.Edit;
var
  MPFileOpen: TOpenDialog;
begin
  MPFileOpen:= TOpenDialog.Create(Application);
  MPFileOpen.fileName:= GetValue;
  MPFileOpen.filter:= 'Word文档(*.doc)|*.doc';
  MPFileOpen.helpContext:= 0;
  MPFileOpen.options:= MPFileOpen.Options + [ofPathMustExist, ofFileMustExist];
  Try
	 If MPFileOpen.Execute Then
		 begin
		 SetValue(MPFileOpen.fileName);
	         end;
  Finally
	 MPFileOpen.Free;
  end;
end;

function TDOCFileProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paRevertable];
end;

function TAboutWordReportProp.GetAttributes: TPropertyAttributes;
begin
  Result:=[paDialog, paReadOnly];
end;

procedure TAboutWordReportProp.Edit;
begin
  with TAboutBox.Create(Application) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

procedure TWordReport.SHOWABOUT;
begin
  with TAboutBox.Create(Application) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

constructor TWordReport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
TRY
  if (csDesigning in ComponentState) then BEGIN
         docopen:=false;
      END;
  if not (csDesigning in ComponentState) then  BEGIN
      docopen:=false;
     END;
except
END;
end;

destructor TWordReport.Destroy;
begin
try
  if not (csDesigning in ComponentState) then
        if not preview then
          if not varisnull(word) then
              closeword;
  inherited Destroy;
except
end;
end;
procedure twordreport.settablevalue(tbindex,row,col:integer;value:string);  //数据填入表中
var
    table:OleVariant;
begin
 if not docopen then adddoc ;
    if docopen then begin
       table:=doc.Tables.Item(tbindex);
       table.Cell(row,col).Range.Text:=value;
    end ;
end;
procedure twordreport.setformfiledvalue(formfldname:OleVariant;value:string);  //数据填入变量
begin
 if not docopen then adddoc ;
    if docopen then begin
       if formfieldexists(formfldname) then
      formfld.Item(formfldname).Result:=value;
    end;
end;



procedure TWordReport.Execute;
begin
try
    if fileexists(filename) then begin
         runprint;      //打印
    end else //  if fileexists(filename)
          showmessage('请输入正确的模板文件！');
except
   showmessage('您没有安装Microsoft word！');
end;
end;

procedure TWordReport.runprint;
begin
  if Assigned(FMaster) then begin                // 设置FMaster
      openword;      //打开Word
      adddoc;
      if Assigned(FvarPrint) then
          FvarPrint(self, word);              //打印窗体变量
      if autoprint then
           printauto                       //  自动打印
      else                                 //   if autoprint
           if Assigned(FDetailPrint) then  //手动打印
                    FDetailPrint(self, word);
      if fpreview then  showword
      else
         if not Fperpage then  print;
  end;

end;
procedure twordreport.printauto;
var
  js,gs,baserow:integer;
begin
   showwait;
   if  wordtable=0 then wordtable:=1;
   gs:=Fmaster.FieldCount;
   baserow:=gettablerows(wordtable)-1;
   if  Fmaster.FieldCount>gettablecols(wordtable) then
        gs:=gettablecols(wordtable);
   fmaster.DisableControls;
   fmaster.First;
   while not fmaster.Eof do begin
      Application.ProcessMessages;
      if fwait.Stop then
           break;
       totaljd(fmaster.RecordCount,fmaster.RecNo);
       if (fmaster.recno<>1) and Fperpage then adddoc;
       for js:=0 to gs-1 do begin
          fieldjd(gs,js+1);
          if fperpage then begin
              if  titleauto then
                   settablevalue(wordtable,baserow,js+1,fmaster.Fields[js].DisplayName);
                   settablevalue(wordtable,baserow+1,js+1,fmaster.Fields[js].AsString);
                   if Assigned(FvarPrint) then
                        FvarPrint(self, word);              //打印窗体变量
          end else begin   //if fperpage
              if (fmaster.recno=1) and titleauto then
                   settablevalue(wordtable,baserow,js+1,fmaster.Fields[js].DisplayName);
                   if fmaster.Fields[js].AsString<>'0' then
                        settablevalue(wordtable,baserow+fmaster.recno,js+1,fmaster.Fields[js].AsString);
          end;   //else  if fperpage
       end;
       if  not fpreview then  print;
       fmaster.Next;
       if  (not fmaster.Eof) and (not Fperpage) then
            addtablerows(wordtable,1);
   end;// end while
   fwait.Hide;
   fwait.Free;
   fmaster.EnableControls;

end;
procedure twordreport.adddoc;              //加入模板
var
   moban:OleVariant;
begin

    if fileexists(filename) then begin
      moban:=FileName;
      Word.Documents.Add(moban);
      doc:=Word.ActiveDocument;
      formfld:=doc.FormFields;
      docopen:=true;
    end else begin //  if fileexists(filename)
          showmessage('请输入正确的模板文件！');
          docopen:=false;
    end;
end;
procedure twordreport.deletedoc;              //删除模板
begin
   if docopen then begin
      doc.close(false);//文档不保存关闭
      docopen:=false;
   end;
end;
procedure twordreport.showword;              //显示word   procedure twordreport.adddoc;              //删除模板
begin
     Word.Visible:=true;
     preview:=true;
end;

function twordreport.getformfields:tstringlist; //返回窗口变量名称
var
   strlist:tstringlist;
   js:integer;
begin
 if not docopen then adddoc;
   strlist:=tstringlist.Create;
   if docopen then begin
         for js:=1 to getformfieldscount do
             strlist.Add(formfld.Item(js).name);
         result:=strlist;
   end else
         result:=strlist;
end;
function twordreport.getformfieldscount:integer;  //返回窗口变量 个数
begin
 if not docopen then adddoc;
    if docopen then
        result:=formfld.count
    else
        result:=-1;
end;
function twordreport.gettablescount:integer;  //返回文档中表之个数
begin
 if not docopen then adddoc ;
    if docopen then
        result:=doc.Tables.count
    else
        result:=-1;
end;
function twordreport.gettablecols(tbindex:integer):integer;  //返回文档中表列数
var
    table:OleVariant;
begin
 if not  docopen then adddoc;
 if docopen then begin
        table:=doc.Tables.Item(tbindex);
        result:=table.Columns.count;
 end else
        result:=-1;
end;

function twordreport.gettablerows(tbindex:integer):integer;   {  返回文档中表行数  }
var
    table:OleVariant;
begin
 if not docopen then adddoc ;
 if docopen then begin
       table:=doc.Tables.Item(tbindex);
       result:=table.rows.count;
 end else
       result:=-1;
end;
procedure twordreport.addtablerows(tbindex,rows:integer);  //表行数增加
var
    table:OleVariant;
    js:integer;
begin
 if not docopen then adddoc ;
 try
    if docopen then begin
       table:=doc.Tables.Item(tbindex);
       for js:=1 to rows do
           table.Rows.Add;
    end;
  except
 end;
end;
procedure twordreport.addtablecols(tbindex,rows:integer);  //表列数增加
var
    table:OleVariant;
    js:integer;
begin
 if not docopen then adddoc ;
 try
    if docopen then begin
       table:=doc.Tables.Item(tbindex);
       for js:=1 to rows do
           table.columns.add;
    end;
 except
 end;
end;


procedure twordreport.managedoc;      //基本情况
var
   str:string;
   js:integer;
   strlist:tstringlist;
begin
   strlist:=tstringlist.Create;
   str:='文件中基本情况：'+#13+'有表'+inttostr(gettablescount)+'个'+#13;
   str:=str+'其中：'+#13;
   for js:=1 to  gettablescount   do
         str:=str+'表'+inttostr(js)+'有:'+inttostr(gettablerows(js))+'行'
                                         +inttostr(gettablecols(js))+'列'+#13+#13;
   str:=str+'有变量'+inttostr(getformfieldscount)+'个,见下：'+#13;
   strlist:=getformfields;
   for js:=0 to strlist.Count-1 do
        str:=str+'变量'+inttostr((js+1))+':'+strlist.Strings[js]+#13;
   showmessage(str);

end;
procedure Twordreport.showopen;
begin
  if varisnull(word) then
       showmessage('not')
  else
       showmessage('ok');
end;
procedure Twordreport.openword;
begin
TRY
   word:=CreateOleObject('word.application');
   setcaption('统计报表');
except
    showmessage('您没有安装Microsoft word！');
END;
end;
procedure Twordreport.setcaption(cap:string);
begin
TRY
   word.Caption :=cap;
except
END;
end;

procedure Twordreport.closeword;
begin
try
    word.quit(false);
    word:=null;
except
end;
end;
procedure Twordreport.print;
begin
    word.printout;
end;
procedure Twordreport.showwait;
begin
   fwait:=tfwait.Create(self);
   fwait.Show;
   fwait.Update;
end;
procedure Twordreport.totaljd(max,value:integer);
begin
    fwait.jd.MaxValue:=max;
    fwait.jd.Progress:=value;
end;
procedure Twordreport.fieldjd(max,value:integer);
begin
    fwait.jd2.MaxValue:=max;
    fwait.jd2.Progress:=value;
end;
function twordreport.formfieldexists(formfld:OleVariant):boolean;
var
   strlist:tstringlist;
begin
   strlist:=tstringlist.Create;
   strlist:=getformfields;
   if strlist.IndexOf(formfld)>-1 then
       result:=true
   else
       result:=false;
end;
end.