hapreportfuncs.pas

用delphi+intraweb写的简单报表系统（activeform使用技术）

UNIT HapReportFuncs;

INTERFACE

USES
  SysUtils, Classes, DATANEWPRINTERLib_TLB, DATANEWREPORTLib_TLB,
  ADODB, db, Windows, IWInit;

TYPE
  //本类用于函数返回值和函数执行状态
  TFunctionType=RECORD
    State:STRING;                       //函数执行状态
    Descript:STRING;                    //函数错误描述符
    obj:OleVariant;                     //函数返回值
  END;

PROCEDURE ViewReportByFile(objDNPrinter:TDNPrinter; sFileName:STRING);
PROCEDURE ViewReportByObject(objDNPrinter:TDNPrinter; sFileName:STRING; sConnectionString:STRING);
PROCEDURE ViewReportByRecordset(objDNPrinter:TDNPrinter; sFileName:AnsiString;
  objRecordset:_Recordset);
FUNCTION ConstructReport(iFlag:integer; sTitle:STRING):TDNReport;
PROCEDURE GetSQLInfo(VAR sFields:STRING; VAR sFieldWidths:STRING; VAR sFieldTitles:STRING; VAR
  sFieldAligns:STRING; VAR sFieldFormats:STRING);

IMPLEMENTATION

PROCEDURE ViewReportByFile(objDNPrinter:TDNPrinter; sFileName:STRING);
BEGIN
  WITH objDNPrinter DO
  BEGIN

    //清除所有纸张
    Papers.RemoveAll;

    //建立空白纸张
    CreatePaper('demo');

    //设置报表
    Papers[0].ReportFile:=sFileName;

    //把新建的纸张作为当前纸张
    Paper:=Papers[0];
  END;
END;

PROCEDURE ViewReportByObject(objDNPrinter:TDNPrinter; sFileName:STRING; sConnectionString:STRING);
VAR
  objDNReport:TDNReport;
BEGIN

  objDNReport:=TDNReport.Create(nil);
  WITH objDNReport DO
  BEGIN
    ReadXMLFile(sFileName);
    DNDb.ConnectionString:=sConnectionString;
  END;

  WITH objDNPrinter DO
  BEGIN

    //清除所有纸张
    Papers.RemoveAll;

    //建立空白纸张
    CreatePaper('demo');

    //设置报表
    Papers[0].ReportObject:=objDNReport.DefaultInterface;

    //把新建的纸张作为当前纸张
    Paper:=Papers[0];
  END;
END;

PROCEDURE ViewReportByRecordset(objDNPrinter:TDNPrinter; sFileName:AnsiString;
  objRecordset:_Recordset);
VAR
  objDNReport:TDNReport;
BEGIN
  objDNReport:=TDNReport.Create(nil);

  WITH objDNReport DO
  BEGIN
    ReadXMLFile(WideString(sFileName));
    DNDb.Recordset:=objRecordset;
  END;
  objDNReport.AutoConnect:=True;
  
  WITH objDNPrinter DO
  BEGIN
    //清除所有纸张
    Papers.RemoveAll;
    //建立空白纸张
    CreatePaper('demo');
    //设置报表
    Papers[0].ReportObject:=objDNReport.DefaultInterface;
    //把新建的纸张作为当前纸张
    Paper:=Papers[0];
    objDNPrinter.ShowAboutBox;
    objDNPrinter.Open;
    objDNPrinter.Show;
    objDNPrinter.PrintDirect;
  END;
END;

FUNCTION ConstructReport(iFlag:integer; sTitle:STRING):TDNReport;
VAR
  objDNReport:TDNReport;
  sFields, sFieldWidths, sFieldTitles, sFieldAligns, sFieldFormats:STRING;
  objGroup:TGroup;
  tmp:STRING;

BEGIN
  objDNReport:=TDNReport.Create(nil);

  //设置数据库连接信息
  WITH objDNReport.DNDb DO
  BEGIN
    Type_:=dnDBOledb;
    //ConnectionString:=txtConnectionString.Text;
    //SQL:=txtSQL.Text;
  END;

  objDNReport.TableHeaderHeight:='800';

  //表头
  objDNReport.Sections[dnrReportHeader].Height:=2000;

  objDNReport.AutoInsertTitles(objDNReport.Sections[dnrReportHeader], 500, 600, '', sTitle, '', '宋体', 30,
    RGB(0, 0, 255));
  objDNReport.AutoInsertTitles(objDNReport.Sections[dnrReportHeader], 1500, 400, '制作人：DataNew', '',
    '制作日期：'+DateToStr(Date));

  //明细
  WITH objDNReport.Sections[dnrDetail] DO
  BEGIN
    BackStyle:=0;
    BackColor:=RGB(200, 200, 200);
  END;

  //页头
  WITH objDNReport.Sections[dnrPageHeader] DO
  BEGIN
    Height:=800;
    BackStyle:=0;
    BackColor:=RGB(0, 200, 200);
    FontBold:=True;
  END;

  //页尾
  objDNReport.Sections[dnrPageFooter].Height:=800;

  objDNReport.AutoInsertTitles(objDNReport.Sections[dnrPageFooter], 100, 300, '', '',
    ' "第 " & Page & " 页   共 " & Pages & " 页" ', '宋体', 9, False, False, False, False, False, True);

  WITH objDNReport.DNPaper DO
  BEGIN
    Arbitrary:=True;
    MarginLeft:=1;
    MarginRight:=1;
    MarginTop:=1.5;
    MarginBottom:=1.5;
  END;

  //调用 AutoInsertTable
  GetSQLInfo(sFields, sFieldWidths, sFieldTitles, sFieldAligns, sFieldFormats);
  objDNReport.AutoInsertTable(sFields, sFieldWidths, sFieldTitles, sFieldAligns, sFieldFormats);

  IF iFlag=1 THEN
  BEGIN
    objGroup:=TGroup.Create(nil);
    WITH objGroup DO
    BEGIN
     // groupby:=txtGroupBy.Text;
      SectionHeader.Height:=500;
      SectionHeader.BackStyle:=0;
      SectionHeader.BackColor:=RGB(100, 200, 0);
    END;
    //dnrGroup
    objDNReport.AutoInsertTitles(objGroup.SectionHeader, 0, 500, '[类别名称]', '', '', '宋体', 14, False,
      True, False, False, False, True);
    objDNReport.Groups.Add(objGroup.DefaultInterface);
  END;

  Result:=objDNReport;

END;

PROCEDURE GetSQLInfo(VAR sFields:STRING; VAR sFieldWidths:STRING; VAR sFieldTitles:STRING; VAR
  sFieldAligns:STRING; VAR sFieldFormats:STRING);
VAR
  i:integer;
  tmpAlign:DNAlignEnum;
  tmpFormat:STRING;
  adoCn:TADOConnection;
  adoRs:TADOQuery;
BEGIN
  sFields:='';
  sFieldWidths:='';
  sFieldTitles:='';
  sFieldAligns:='';
  sFieldFormats:='';
  tmpAlign:=dnAlignRight+dnAlignVCenter;
  tmpFormat:='';

  adoCn:=TADOConnection.Create(nil);
  //adoCn.ConnectionString:=txtConnectionString.Text;
  adoCn.LoginPrompt:=False;

  adoRs:=TADOQuery.Create(nil);
  adoRs.Connection:=adoCn;
  //adoRs.SQL.Text:=txtSQL.Text;
  TRY
    adoRs.Open;
  EXCEPT
    WebApplication.ShowMessage('数据库连接失败!');
  END;

  FOR i:=0 TO adoRs.FieldCount-1 DO
  BEGIN

    CASE adoRs.Fields[i].DataType OF
      ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency:
        tmpAlign:=dnAlignRight+dnAlignVCenter;
    ELSE
      tmpAlign:=dnAlignLeft+dnAlignVCenter;
    END;

    IF (adoRs.Fields[i].DataType=ftCurrency)OR(adoRs.Fields[i].DataType=ftBCD) THEN
      tmpFormat:='#,##0.00'
    ELSE
      tmpFormat:='';

    IF sFields='' THEN
    BEGIN
      sFields:='['+adoRs.Fields[i].FieldName+']';
      sFieldWidths:='900';
      sFieldTitles:=adoRs.Fields[i].FieldName;
      sFieldAligns:=IntToStr(tmpAlign);
      sFieldFormats:=tmpFormat;

    END
    ELSE
    BEGIN
      sFields:=sFields+'|['+adoRs.Fields[i].FieldName+']';
      sFieldWidths:=sFieldWidths+'|'+'900';
      sFieldTitles:=sFieldTitles+'|'+adoRs.Fields[i].FieldName;
      sFieldAligns:=sFieldAligns+'|'+IntToStr(tmpAlign);
      sFieldFormats:=sFieldFormats+'|'+tmpFormat;
    END;
  END;

  adoRs.Close;
  adoCn.Close;
END;

END.