main.pas

来自「用delphi+intraweb写的简单报表系统(activeform使用技术)」· PAS 代码 · 共 294 行

PAS
294
字号
UNIT main;

INTERFACE

USES
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Math,
  Dialogs, BaseFormUnit, IWVCLComponent, IWBaseLayoutComponent, ADODB, ComObj,
  IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, ShellAPI,
  IWExtCtrls, IWCompEdit, IWVCLBaseContainer, IWContainer, IWHTMLContainer,
  IWRegion, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl,
  IWCompRectangle, IWTreeview, IWCompObject, IWCompActiveX, IWCompListbox,
  IWCompLabel, IWHTMLControls, IniFiles;

TYPE
  TReport=RECORD
    sName:STRING;
    sTitle:STRING;
    sSQL:STRING;
    sData:STRING;                       //最后结果的sql语句
    sField:STRING;
    ZTName:STRING;                      //用友帐套数据库名称
    UseDate:TDate;                      //模块启用时间
    sFile:STRING;                       //模板文件路径
  END;

  TMainForm=CLASS(TFormBase)
    MainTemplate:TIWTemplateProcessorHTML;
    pnlReport:TIWRegion;
    tvReport:TIWTreeView;
    mainInfo:TIWRectangle;
    IWLink1:TIWLink;
    PROCEDURE IWAppFormCreate(Sender:TObject);
    PROCEDURE tvReportTreeItemClick(Sender:TObject; ATreeViewItem:TIWTreeViewItem);
    PROCEDURE IWLink1Click(Sender:TObject);
  PRIVATE
    { Private declarations }
  PUBLIC
    { Public declarations }
    FRepName:STRING;
    FReport:TReport;
    PROCEDURE CreateSubTreeRep(VTree:TIWTreeView; FNodeName:STRING; Node:TIWTreeViewItem=NIL);
    FUNCTION OpenReportData(pRepName:STRING):integer;
    FUNCTION GetReportParams(pRepName:STRING):integer;
    FUNCTION AddReportList(AList:TStrings):integer;
  END;

VAR
  MainForm:TMainForm;

IMPLEMENTATION

USES DataModuleUnit, ADOFuncs, XFuncs, HapReportFuncs, XFunc, GlobalVar, ServerController;

{$R *.dfm}

PROCEDURE TMainForm.CreateSubTreeRep(VTree:TIWTreeView; FNodeName:STRING; Node:TIWTreeViewItem=NIL);
VAR
  mLocalName, S:STRING;
  TreeNode:TIWTreeViewItem;
  Ads_Tmp:TADOQuery;
BEGIN
  Ads_Tmp:=TADOQuery.Create(NIL);
  Ads_Tmp.ConnectionString:=AccessDataString;
  IF FNodeName<>'' THEN
    S:='SELECT * FROM ReportItems Where iParenID='+FNodeName+' order by iRepID'
  ELSE
    S:='SELECT * FROM ReportItems order by iRepID';

  TRY
    OpenSQL(Ads_Tmp, S);
    WITH Ads_Tmp DO
    BEGIN
      WHILE NOT Eof DO
      BEGIN
        mLocalName:=FieldByName('iRepID').AsString;

        TreeNode:=VTree.Items.Add;
        WITH TreeNode DO
        BEGIN
          ParentItem:=Node;

          Tag:=FieldByName('iRepID').AsInteger;
          Caption:=mLocalName+'='+FieldByName('sRepName').AsString;
        END;

        CreateSubTreeRep(VTree, mLocalName, TreeNode);
        Next;
      END;
    END;
  FINALLY
    Ads_Tmp.Close;
    Ads_Tmp.Free;
  END;
END;

PROCEDURE TMainForm.IWAppFormCreate(Sender:TObject);
VAR AItem:TIWTreeViewItem;
BEGIN
  INHERITED;
  { acxRepPrinter.CodeBase:='/cabs/DNPrnt.Cab';
   acxRepPrinter.ClassID:='clsid:9CDE204E-0CC2-11D6-9011-00E09873B6BB';
   DNPrinter:=TDNPrinter.Create(Self);

   acxRepPrinter.Width:=560;
   acxRepPrinter.Height:=700;
 }

  AItem:=tvReport.Items.Add;
  AItem.ParentItem:=NIL;
  AItem.Caption:='报表系统';

  userstat.Visible:=False;
  Self.CreateSubTreeRep(tvReport, '0', AItem);

  tvReport.TreeViewImages.OpenFolderImage.Filename:='';
  tvReport.TreeViewImages.DocumentImage.Filename:='';
END;

PROCEDURE TMainForm.tvReportTreeItemClick(Sender:TObject;
  ATreeViewItem:TIWTreeViewItem);
BEGIN
  INHERITED;
  IF ATreeViewItem.HasChild THEN exit;
  IF tvReport.Selected=NIL THEN exit;

  FRepName:=StrToStr(Char('='), tvReport.Selected.Caption, 1);

  TRY
    Screen.Cursor:=crHourGlass;
    TRY
      GetReportParams(FRepName);
      Self.OpenReportData(FRepName);
    EXCEPT
    END;
  FINALLY
    Screen.Cursor:=crDefault;
  END;
END;

FUNCTION TMainForm.OpenReportData(pRepName:STRING):integer;
VAR sSQL, S, sFile, sUrl, LWindowName, LOptions:STRING;
  sTempTable:STRING;
  fp:olevariant;
  AList:TStrings;
BEGIN
  TRY
    FDM.DYConn.ConnectionString:=FDM.ConnectDBStr;
    FDM.DYConn.CommandTimeout:=9000;
    FDM.DYConn.Open;
  EXCEPT
    exit;
  END;

  FDM.DYConn.DefaultDatabase:=FReport.ZTName;

  sTempTable:='XXLR_Temp'+mGetComputerName+IntToStr(Trunc(Now*10000.00));
  TRY
    IF Trim(FReport.sSQL)<>'' THEN
    BEGIN
      sSQL:=ReplaceStr(FReport.sSQL, '@模块时间@', FormatDateTime('yyyy-MM-dd', FReport.UseDate));
      sSQL:=ReplaceStr(sSQL, '@起始时间@', edtStartDate.Text);
      sSQL:=ReplaceStr(sSQL, '@结束时间@', edtEndDate.Text);
      sSQL:=ReplaceStr(sSQL, '@包含未入帐@', '0');

      sSQL:=ReplaceStr(sSQL, '%TempTableName%', sTempTable);

      debuglog(sSQL);
      FDM.DYConn.Execute(sSQL);
      //OpenQuery(FDM.DYConn, FDM.aqShare, sSQL);
    END ELSE
    BEGIN
      Result:=-1;
      exit;
    END;

    TRY
      S:=ReplaceStr(FReport.sData, '%TempTableName%', sTempTable);

      fp:=createoleobject('printx.adocon');
      AList:=TStringList.Create;

      debuglog(FReport.sField);
      debuglog(S);
      AList.LoadFromFile(AppDir+'Templates\1.html');
      AList.Add(fp.fprint(FDM.ConnectDBStr, S, FReport.sField));
      S:=AList.Text;

      AList.LoadFromFile(AppDir+'Templates\2.html');
      AList.Insert(0, S);
      sFile:='rep'+IntToStr(Trunc(frac(Now)*1000000.00))+'.html';
      AList.SaveToFile(IWServerController.FilesDir+sFile);
      AList.SaveToFile(myGetTempPath+sFile);
      sUrl:=IWServerController.FilesURL+sFile;
      WebApplication.NewWindow(sUrl);
      //LWindowName := 'Report';
      //LOptions := 'scrollbars=yes,width=400,height=600';
      //AddToInitProc('NewWindow("' + sURL + '", "' + LWindowName + '","' + LOptions + '");');
      //WebApplication.GoToURL('../temp/'+sFile);

      DeleteFile(sFile);
    FINALLY

    END;
  FINALLY
    AList.Free;
    FDM.DYConn.Close;
  END;
END;

FUNCTION TMainForm.GetReportParams(pRepName:STRING):integer;
VAR k, v:integer;
  sSQL, sRepID, sParamID:STRING;
BEGIN
  sSQL:='select * from ReportItems where sRepName='+QuotedStr(pRepName);
  TRY
    OpenQuery(AccessDataString, FDM.aqTemp, sSQL);

    FReport.sName:=pRepName;
    FReport.sTitle:=FDM.aqTemp.FieldByName('sRepTitle').AsString;
    FReport.sSQL:=FDM.aqTemp.FieldByName('sRepSQL').AsString;
    FReport.sData:=FDM.aqTemp.FieldByName('sRepData').AsString;
    FReport.sField:=FDM.aqTemp.FieldByName('sRepField').AsString;
    FReport.ZTName:=FDM.aqTemp.FieldByName('sLinkAcc').AsString;
    FReport.UseDate:=FDM.aqTemp.FieldByName('dUseDate').AsDateTime;
    FReport.sFile:=FDM.aqTemp.FieldByName('sNormal').AsString;
    sRepID:=FDM.aqTemp.FieldByName('iRepID').AsString;

  FINALLY
    FDM.aqTmp.Close;
    FDM.aqTemp.Close;
  END;
END;

FUNCTION TMainForm.AddReportList(AList:TStrings):integer;
VAR S:STRING;
BEGIN
  S:='SELECT * FROM ReportItems Where iParenID=3 order by iRepID';

  TRY
    OpenQuery(AccessDataString, FDM.aqTemp, S);
    AList.Clear;
    WHILE NOT FDM.aqTemp.Eof DO
    BEGIN
      AList.Add(FDM.aqTemp.FieldByName('sRepName').AsString);
      FDM.aqTemp.Next;
    END;
    Result:=AList.Count;
  FINALLY
    FDM.aqTemp.Close;
  END;
END;

PROCEDURE TMainForm.IWLink1Click(Sender:TObject);
VAR sSQL, S, sFile, sUrl, LWindowName, LOptions:STRING;
  sTempTable:STRING;
  fp:olevariant;
  AList:TStrings;
  fini:TIniFile;
BEGIN
  TRY
   // ShowMessage(myGetTempPath);
    fp:=createoleobject('printx.adocon');
    AList:=TStringList.Create;
    fini:=TIniFile.Create(AppDir+'dblink.ini');

    if FReport.ZTName='' then
      FReport.ZTName:=FIni.ReadString('db', 'default', '');

    AList.LoadFromFile(AppDir+'Templates\1.html');
    AList.Add(fp.fprint(FDM.ConnectDBStr, FReport.ZTName, ''));
    S:=AList.Text;

    AList.LoadFromFile(AppDir+'Templates\3.html');
    AList.Insert(0, S);
    sFile:='person'+IntToStr(Trunc(frac(Now)*1000000.00))+'.html';
    AList.SaveToFile(IWServerController.FilesDir+sFile);
    AList.SaveToFile(myGetTempPath+sFile);
    sUrl:=IWServerController.FilesURL+sFile;
    WebApplication.NewWindow(sUrl);

    DeleteFile(sFile);
  FINALLY
    AList.Free;
    fini.Free;
  END;
END;

INITIALIZATION
  TMainForm.SetAsMainForm;
  RegisterClass(TMainForm);

END.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?