commusefunction.~dpr

对fastreport进行封装成dll,只需传一个query即可显示报表内容,显示的列可以自定义,对学习fastreport可以参考一下

library CommUseFunction;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass pchars as parameters or function results. This
  applies to all pchars passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass pchar information
  using PChar or Shortpchar parameters. }

uses
  SysUtils,
  Classes,
  Registry,
  inifiles,
  windows,
  Excel2000,
  forms,
  adoDB,
  Variants,
  ActiveX,
  DB,
 // FR_Ctrls,
  FR_View,
 // ExtCtrls,
  FR_Class,
  FR_Shape,
  FR_DBSet,
  ComCtrls,
  Printers,
  
  CommUseFunctionExport in 'CommUseFunctionExport.pas',
  Preview in 'Preview.pas' {FormPreview},
  SetupReportPreview in 'SetupReportPreview.pas' {frmSetupReport},
  PublicFuncion in 'PublicFuncion.pas',
  messageRegister in 'messageRegister.pas' {frmmessageRegister};

{$R *.res}
var
  dllApp:TApplication;
  dllScreen:TScreen;

function ReadReg(Key,Value:pchar):pchar;stdcall; //读一个銉值下的值
var
Reg:TRegistry;
begin
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(key,false) then
    begin
      result:=Pchar(Reg.Readstring(value));
       reg.CloseKey;
    end;
  finally

    reg.Free;
  end;
end;

procedure WriteReg(key,Value:pchar);stdcall; //写一个值到指定的键下
var
Reg:TRegistry;
begin
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(key,false) then
    begin
      Reg.Writestring(key,value);
      reg.CloseKey;
    end;
  finally

    reg.Free;
  end;
end;


procedure WriteToTextFile(sFileName, sText: pchar); stdcall; //写一个文本信息到一个文本文件中
var
tf:textfile;
stemp:pchar;
p:pchar;
begin

  try
   assignfile(tf,sFileName);

   if fileexists(sFileName) then
      Reset(tf)
   else
    reWrite(tf);
    Append(tf);
    WriteLn(tf,sText);
    Flush(tf);
    closefile(tf);
   except
   end;
end;
//ini文件          文件名　　段　　　　键　　值　　
procedure WriteIni(sFileName,sSection,ident,sText:string);stdcall;
var
 ini:Tinifile;
 sname,ssSection,sident,ssText:string;
begin

   ini:=Tinifile.Create(sFileName);

   ini.Writestring(sSection,ident,sText);
   ini.Free;
end;
//ini文件          文件名　　段　　　　键　　默认值　
function ReadIni(sFileName,sSection,ident,DefaultText:string):string;stdcall;
var
 ini:Tinifile;

begin

   ini:=Tinifile.Create(sFileName);
   result:=ini.Readstring(sSection,ident,DefaultText);
   ini.Free;
end;

 function NumToExcelCellNum(iNum:integer):pchar;
  begin
     case iNum of
       1:result:='A';
       2:result:='B';
       3:result:='C';
       4:result:='D';
       5:result:='E';
       6:result:='F';
       7:result:='G';
       8:result:='H';
       9:result:='I';
       10:result:='J';
       11:result:='K';
       12:result:='M';
       13:result:='N';
       else
         result:='H';
     end;
  end;

procedure QueryToExcel(connstr,sqlstr,sCaption:pchar); stdcall;

var
   i,row,col,icount:integer ;
   ExcelApplication: TExcelApplication;
   ExcelWorkbook: TExcelWorkbook;
   ExcelWorksheet: TExcelWorksheet;
   sExcelCell:string;
   adoquery:TADOQuery;
   con:TADOConnection;
   SumMoney:array[0..20] of Currency;
begin
   con:=TADOConnection.Create(nil);
   adoquery:=TADOQuery.Create(nil);
   adoquery.Connection:=con;
   con.ConnectionString:=strpas(connstr);
   con.LoginPrompt:=false;
   try
    con.Connected:=true;
    adoquery.SQL.Text:=strpas(sqlstr);
    adoquery.Open;
   except
     application.MessageBox('联系失败，传入的联接串不对','提示',MB_ICONINFORMATION or MB_Ok) ;
      adoquery.Free;
      con.Close;
      con.Free;
      exit;
   end;

   try
    ExcelApplication:=TExcelApplication.Create(nil) ;
    ExcelApplication.Connect ;
    ExcelWorkbook:=TExcelWorkbook.Create(nil);
    ExcelWorksheet:=TExcelWorksheet.Create(nil)  ;
  except
    application.MessageBox('Excel 可能未安装','提示',MB_ICONINFORMATION or MB_Ok) ;
    ExcelWorksheet.Free;
    ExcelWorksheet := nil;
    ExcelWorkbook.Free;
    ExcelWorkbook := nil;
    ExcelApplication.Disconnect;
    ExcelApplication.Free;
    ExcelApplication := nil;
    exit;
  end;

  with ExcelApplication do
  begin
    Visible[0]:=true ;
    caption:=sCaption;
    workbooks.Add(null,0);
    ExcelWorkbook.ConnectTo(workbooks[1]);
    ExcelWorksheet.ConnectTo(ExcelWorkbook.Worksheets[1] as _Worksheet);
  end;
  icount:=adoQuery.FieldCount;
  for i:=0 to icount-1 do
    SumMoney[i]:=0;
 sExcelCell:=NumToExcelCellNum(adoQuery.FieldCount);
 ExcelWorksheet.Range['a1',sExcelCell+'1'].Merge(true); //合并
 ExcelWorksheet.Range['a1',sExcelCell+'1'].HorizontalAlignment:=xlCenter;   //水平居中]
 ExcelWorksheet.Cells.Item[1,1]:=sCaption+'明细记录';
 ExcelWorksheet.Range['a1',sExcelCell+'1'].Font.Size:=20;
  for i:=0 to icount-1 do
  begin
     ExcelWorksheet.Cells.Item[2,i+1]:=adoQuery.Fields[i].FieldName;
     if adoQuery.Fields[i].DataType=ftDateTime then
     begin
     sExcelCell:=NumToExcelCellNum(i+1);
     ExcelApplication.Range[sExcelCell+'1',sExcelCell+'1'].ColumnWidth:=12;
     end;
  end;
  row:=3;
  adoquery.First;
  while not adoquery.Eof do
  begin
     application.ProcessMessages;
     for i:=0 to icount-1 do
     begin
        if adoQuery.Fields[i].DataType=ftBCD then
           SumMoney[i]:=SumMoney[i]+adoquery.Fields[i].AsCurrency;
        ExcelWorksheet.Cells.Item[row,i+1]:=adoquery.fieldbyname(adoQuery.Fields[i].FieldName).AsString;
     end;
     inc(row);
     adoquery.Next;
  end;
  con.Close;
  con.Free;
  adoquery.Close;
  adoquery.Free;

  ExcelWorkSheet.Cells.Item[row, 1]:='合计:';
  ExcelWorkSheet.Cells.Item[row, 2]:=inttostr(row-3)+'人';
  for i:=0 to icount-1 do
    if SumMoney[i]<>0 then
       ExcelWorkSheet.Cells.Item[row, i+1]:=currtostr(SumMoney[i]);
  ExcelApplication.ScreenUpdating[0]:=true;
  ExcelWorksheet.Free;
  ExcelWorksheet := nil;
  ExcelWorkbook.Free;
  ExcelWorkbook := nil;
  ExcelApplication.Free;
  ExcelApplication := nil;
end;

procedure ADOQueryToExcel(adoquery:TADOQuery;sCaption:pchar); stdcall;

var
   i,row,col,icount,j:integer ;
   ExcelApplication: TExcelApplication;
   ExcelWorkbook: TExcelWorkbook;
   ExcelWorksheet: TExcelWorksheet;
   sExcelCell:string;
   SumMoney:array[0..20] of Currency;
begin
  

   try
    ExcelApplication:=TExcelApplication.Create(nil) ;
    ExcelApplication.Connect ;
    ExcelWorkbook:=TExcelWorkbook.Create(nil);
    ExcelWorksheet:=TExcelWorksheet.Create(nil)  ;
  except
    application.MessageBox('Excel 可能未安装','提示',MB_ICONINFORMATION or MB_Ok) ;
    ExcelWorksheet.Free;
    ExcelWorksheet := nil;
    ExcelWorkbook.Free;
    ExcelWorkbook := nil;
    ExcelApplication.Disconnect;
    ExcelApplication.Free;
    ExcelApplication := nil;
    exit;
  end;

  with ExcelApplication do
  begin
    Visible[0]:=true ;
    caption:=sCaption;
    workbooks.Add(null,0);
    ExcelWorkbook.ConnectTo(workbooks[1]);
    ExcelWorksheet.ConnectTo(ExcelWorkbook.Worksheets[1] as _Worksheet);
  end;
  icount:=adoQuery.FieldCount;
 for i:=0 to icount-1 do
  SumMoney[i]:=0;
 sExcelCell:=NumToExcelCellNum(icount);
 ExcelWorksheet.Range['a1',sExcelCell+'1'].Merge(true); //合并
 ExcelWorksheet.Range['a1',sExcelCell+'1'].HorizontalAlignment:=xlCenter;   //水平居中]
 ExcelWorksheet.Cells.Item[1,1]:=sCaption+'明细记录';
 ExcelWorksheet.Range['a1',sExcelCell+'1'].Font.Size:=20;
  for i:=0 to icount-1 do
  begin
     ExcelWorksheet.Cells.Item[2,i+1]:=adoQuery.Fields[i].FieldName;
     if adoQuery.Fields[i].DataType=ftDateTime then
     begin
     sExcelCell:=NumToExcelCellNum(i+1);
     ExcelApplication.Range[sExcelCell+'1',sExcelCell+'1'].ColumnWidth:=12;
     end;
  end;
  row:=3;
  adoquery.First;
  while not adoquery.Eof do
  begin
     application.ProcessMessages;
     for j:=0 to icount-1 do
     begin
        ExcelWorksheet.Cells.Item[row,j+1]:=adoquery.fieldbyname(adoQuery.Fields[j].FieldName).AsString;
        if adoQuery.Fields[j].DataType=ftBCD then
           SumMoney[j]:=SumMoney[j]+adoquery.Fields[j].AsCurrency;
     end;
     inc(row);
     adoquery.Next;
  end;

  ExcelWorkSheet.Cells.Item[row, 1]:='合计:';
  ExcelWorkSheet.Cells.Item[row, 2]:=inttostr(row-3)+'人';
  for i:=0 to icount-1 do
    if SumMoney[i]<>0 then
       ExcelWorkSheet.Cells.Item[row, i+1]:=currtostr(SumMoney[i]);
  ExcelApplication.ScreenUpdating[0]:=true;
  ExcelWorksheet.Free;
  ExcelWorksheet := nil;
  ExcelWorkbook.Free;
  ExcelWorkbook := nil;
  ExcelApplication.Free;
  ExcelApplication := nil;
end;

procedure ExecQuery(con:TADOConnection;sSql:pchar); stdcall;
var
q:TADOquery;
begin
  q:=TADOquery.Create(nil);
  q.Connection:=con;
  q.Close;
  q.SQL.Clear;
  q.SQL.Add(string(ssql));
  q.ExecSQL;
  try
   q.ExecSQL;
  except
   application.MessageBox(sSql,'提示',MB_ICONINFORMATION or MB_Ok) ;
  end;
  q.Close;
  q.Free;
end;

function OpenQuery(con:TADOConnection;sSql:pchar):TADOquery; stdcall;
var
q:TADOquery;
begin
  q:=TADOquery.Create(nil);
  q.Connection:=con;
  q.Close;
  q.SQL.Clear;
  q.SQL.Add(string(ssql));
  try
  q.open;
  except
   application.MessageBox(sSql,'提示',MB_ICONINFORMATION or MB_Ok) ;
  end;

  result.Recordset:=q.Recordset;
  q.Close;
  q.Free;

end;
procedure SetupReportFormat(PADOQuery:Pointer ;app:Tapplication;sFlagTableName:pchar);stdcall;
var
i:integer;
AdOQuery:TAdOQuery;
iniFileName,sWidth,sHide,sFieldName,sAlign,sSumType:string;
iTem:TListItem;
begin
   application:=app;
  { frmSetupReport:=TfrmSetupReport.Create(application);
   frmSetupReport.lvAttribute.Clear;
   frmSetupReport.ShowModal;
   frmSetupReport.Free;}
   iniFileName:=ExtractFilePath(application.ExeName)+'ReportSetup.ini';
  


   AdOQuery:=TAdOQuery.Create(application);
   TAdOQuery(PADOQuery).DisableControls;
   AdOQuery.Recordset:=TAdOQuery(PADOQuery).Recordset;
   if ADOQuery.FieldCount=0 then
   begin
     application.MessageBox(Pchar('查询语句没有字段'),Pchar('提示'),mb_iconinformation);
     AdOQuery.Close;
     AdOQuery.Free;
     exit;
   end;
   frmSetupReport:=TfrmSetupReport.Create(application);
  // frmSetupReport.frDBDataSet1.DataSet:=AdOQuery;
   frmSetupReport.lvAttribute.Clear;
   frmSetupReport.speLeftSize.text:=readini(iniFileName,sFlagTableName,'LeftSize','10');
   frmSetupReport.speRightSize.text:=readini(iniFileName,sFlagTableName,'RightSize','10');
   frmSetupReport.cbbPageOrient.ItemIndex:=frmSetupReport.cbbPageOrient.Items.IndexOf(
                                  readini(iniFileName,sFlagTableName,'PageOrient','纵向'));
   frmSetupReport.edtCaption.Text:=readini(iniFileName,sFlagTableName,'PageCaption','报表标题');
   frmSetupReport.speFontSize.Text:=readini(iniFileName,sFlagTableName,'PageFontSize','8');
   frmSetupReport.edtTableName.Text:=sFlagTableName;
   for i:=0 to ADOQuery.FieldCount-1 do
   begin
      //格式为:width,hide,align,sumType中间,号间隔
      sFieldName:=ADOQuery.Fields[i].FieldName;
      sWidth:=readini(iniFileName,sFieldName,
              'width','80'); //宽度
      sHide:=readini(iniFileName,sFieldName,
              'hide','0');//隐藏

      sAlign:=readini(iniFileName,sFieldName,
              'align','向左');//排列

      sSumType:=readini(iniFileName,sFieldName,
              'sumType','文本');//汇总类型
      with  frmSetupReport do
      begin

         iTem:=lvAttribute.Items.Add;
         iTem.Caption:='';
         if sHide='0' then
           item.Checked:=false
         else
           item.Checked:=true;
         item.SubItems.Add(trim(sFieldName));
         item.SubItems.Add(trim(sWidth));
         item.SubItems.Add(trim(sAlign));
         item.SubItems.Add(trim(sSumType));

      end;
   end;
  // frmSetupReport.BitBtn4Click(sender);
   frmSetupReport.Show;
   AdOQuery.Close;
   
   AdOQuery.Free;
   //frmSetupReport.free;

  // frmSetupReport:=nil;
end;


procedure ReportView(PADOQuery: Pointer;app:Tapplication;sCaption,sPrintPeaple:pchar;sFlagTableName:pchar);stdcall;
var
  v: TfrView;
  b,MasterDate1: TfrBandView;
  Page: TfrPage;
  frReport: TfrReport;
  sShape:TFrShapeView;