wordrep.pas

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

unit WordReport;

interface

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

type
  twordrep = class;

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

  TAboutWordReport = class
  end;

  twordrep = class(TComponent)
  private
    { Private declarations }
    word,doc,formfld:OleVariant;
    Factive,Fperpage,docopen,Fautoprint:boolean;
    FTemplateName:string;
    FMaster:TDataSet;
    FvarPrint:TReportEvent;
    FDetailPrint:TReportEvent;
    FPreview:boolean;
    FAboutWordReport:TAboutWordReport;
    procedure runprint;
    procedure dbcheck;
    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;              //删除模板
    function settablevalue(tbindex,row,col:integer;value:string):boolean;  //数据填入表中
    function setformfiledvalue(formfldname:OleVariant;value:string):boolean;  //数据填入变量
    function addtablerows(tbindex,rows:integer):boolean;  //表行数增加
    function addtablecols(tbindex,rows:integer):boolean;  //表列数增加
    function settbvalue(tbindex,row,col:integer;value:string):boolean;  //数据填入表中
    procedure managedoc;      //基本情况
    procedure showopen;
  published
    { Published declarations }
    property autoprint:boolean read Fautoprint write Fautoprint;
    property Active:boolean read Factive write factive;
    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('LZC', [twordrep]);
  RegisterPropertyEditor(TypeInfo(TAboutWordReport), nil,
    '', TAboutWordReportProp);
  RegisterPropertyEditor(TypeInfo(string), twordrep, '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 twordrep.SHOWABOUT;
begin
  with TAboutBox.Create(Application) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

constructor twordrep.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
TRY
  if (csDesigning in ComponentState) then BEGIN
         active:=FALSE;
         docopen:=false;
      END;
  if not (csDesigning in ComponentState) then  BEGIN
       word:=CreateOleObject('word.application');
       docopen:=false;
     END;
except
    showmessage('您没有安装Microsoft word！');
END;
end;

destructor twordrep.Destroy;
begin
try
  if not (csDesigning in ComponentState) then
        if not preview then
            word.Quit(false);
  inherited Destroy;
except
end;
end;
function twordrep.settablevalue(tbindex,row,col:integer;value:string):boolean;  //数据填入表中
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;
       result:=true;
    end else
        result:=false;
end;
function twordrep.setformfiledvalue(formfldname:OleVariant;value:string):boolean;  //数据填入变量
begin
 if not docopen then adddoc ;
    if docopen then begin
      formfld.Item(formfldname).Result:=value;
       result:=true;
    end else
        result:=false;
end;



procedure twordrep.Execute;
begin
try
    if fileexists(filename) then begin
         runprint;
    end else //  if fileexists(filename)
          showmessage('请输入正确的模板文件！');
except
   showmessage('您没有安装Microsoft word！');
end;
end;
procedure twordrep.dbcheck;
begin
      if Assigned(FMaster) then  begin
            if FMaster.Active then begin
                    end
            else  // if FMaster.Active
                       showmessage('数据库没有打开！');end
      else  //   if Assigned(FMaster)
            showmessage('数据库没有指定！');
end;
procedure twordrep.runprint;
begin

      if Assigned(FvarPrint) then
            FvarPrint(self, word);
      if autoprint then begin
           if Assigned(FMaster) then  printauto;
      end else  //   if autoprint
        if Assigned(FDetailPrint) then
            FDetailPrint(self, word);

//      if Assigned(FDetail) then     // 在wordreport中设置了detaildataset
//            DoDetail;
end;
procedure twordrep.printauto;
begin
   showmessage('autoprint');
end;
procedure twordrep.adddoc;              //加入模板
var
   moban:OleVariant;
begin

    if fileexists(filename) then begin
      moban:=FileName;
      if varisnull(word) then  begin
           word:=CreateOleObject('word.application');
           showmessage('wordclose');
      end;

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

function twordrep.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 twordrep.getformfieldscount:integer;  //返回窗口变量 个数
begin
 if not docopen then adddoc;
    if docopen then
        result:=formfld.count
    else
        result:=-1;
end;
function twordrep.gettablescount:integer;  //返回文档中表之个数
begin
 if not docopen then adddoc ;
    if docopen then
        result:=doc.Tables.count
    else
        result:=-1;
end;
function twordrep.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 twordrep.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;
function twordrep.addtablerows(tbindex,rows:integer):boolean;  //表行数增加
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;
       result:=true;
    end else
        result:=false;
  except
 end;
end;
function twordrep.addtablecols(tbindex,rows:integer):boolean;  //表列数增加
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;
       result:=true;
    end else
        result:=false;
  except
 end;
end;

function twordrep.settbvalue(tbindex,row,col:integer;value:string):boolean; //数据填入表中
var
    table:OleVariant;
begin
 if not docopen then adddoc ;
 try
    if docopen then begin
       table:=doc.Tables.Item(tbindex);
       table.Cell(row,col).Range.Text:=value;
       result:=true;
    end else
        result:=false;
  except
 end;
end;
procedure twordrep.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 twordrep.showopen;
begin
  if varisempty(word) then
       showmessage('not')
  else
       showmessage('ok');
end;
end.