rblib.pas

delphi框架可以学习, 写的很好的

{ **************************************************************************** }
{ *                                                                          * }
{ *                 ReportBuilder报表系统自定义函数库                        * }
{ *                                                                          * }
{ *                                                                          * }
{ *               自定义的函数能够在RB报表系统中直接引用，                   * }
{ *                                                                          * }
{ *                                                                          * }
{ *                      Copyright (c) 2002-2004                             * }
{ *                                                                          * }
{ **************************************************************************** }
unit rbLib;

interface

uses
  dm32,
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  
  //daIDE, daDBBDE, //需要加上这项设计才能支持 Data 页
  raIDE,            //需要加上这项设计才能支持 Calc 页
  ppChrtUI,         //需要加上这项设计才能支持 DBChar、Char 修改
  ppEndUsr,ppDBPipe,ppComm,ppRelatv,ppBackgroundPrintSettings,ppViewr,
  ppPreviewFormSettings,ppUtils,ppTextSearchSettings,ppPrintr,ppDevice,ppProd,
  ppEngine,ppCache,ppBands,ppClass,ppOutlineSettings,ppOutlineReportSettings,
  ppReport,ppTmplat,raFunc, ppRTTI, ppPrnabl, ppCtrls, ppChrt,
  ppChrtDP;

type

  //用指定变量名换成变量内容,支持中文(cool)
  TdoValue = class (TraStringFunction)
  public
    procedure ExecuteFunction(aParams: TraParamList); override;
    class function GetSignature: String; override;
  end;

  function LoadRepFormDB(REP: TppReport; const RepName: String): Boolean;
  function RepSaveAs(REP: TppReport; const RepName: String): Boolean;

implementation

uses MyPublic;

{ TdoValue }

procedure TdoValue.ExecuteFunction(aParams: TraParamList);

   function ComString(S, S1, S2: String): Boolean;
   begin
     Result:= (S = S1) or (S = S2);
   end;
var
  ls_Param : String;
  ls_Result: String;
begin
  GetParamValue(0, ls_Param);

  ls_Param:= UpperCase(ls_Param);

  if ComString(ls_Param, '用户代码',   'USERCODE')   then ls_Result:= CurrentUser.UserCode
  else
  if ComString(ls_Param, '姓名',     'EMPNAME')      then ls_Result:= CurrentUser.EmpName
  else
  if ComString(ls_Param, '变量一', 'VALUE1') then ls_Result:= _PrintValue1
  else
  if ComString(ls_Param, '变量二', 'VALUE2') then ls_Result:= _PrintValue2
  else
  if ComString(ls_Param, '变量三', 'VALUE3') then ls_Result:= _PrintValue3
  else
  if ComString(ls_Param, '变量四', 'VALUE4') then ls_Result:= _PrintValue4
  else
  if ComString(ls_Param, '变量五', 'VALUE5') then ls_Result:= _PrintValue5
  else
  if ComString(ls_Param, '变量六', 'VALUE6') then ls_Result:= _PrintValue6
  else
  if ComString(ls_Param, '变量七', 'VALUE7') then ls_Result:= _PrintValue7
  else
  if ComString(ls_Param, '变量八', 'VALUE8') then ls_Result:= _PrintValue8
  else
  if ComString(ls_Param, '变量九', 'VALUE9') then ls_Result:= _PrintValue9
  else ls_Result:= '';

  SetParamValue(1, ls_Result);
end;

class function TdoValue.GetSignature: String;
begin
  Result := 'function doValue(const value: string): string;';
end;

function LoadRepFormDB(REP: TppReport;const RepName: String): Boolean;
var
  ls_SQL: String;
begin
  ls_SQL:= 'select * from rep where UPPER(repname)=''' + UpperCase(RepName) + '''';
  Result:= OpenDataSet(dm.qryRep, ls_SQL) = '';

  if not Result then exit;

  REP.Template.DatabaseSettings.Name:= RepName;
  REP.PrinterSetup.DocumentName:= RepName;

  with dm.qryRep do
  if not IsEmpty
  then REP.Template.LoadFromDatabase;
end;

function RepSaveAs(REP: TppReport; const RepName: String): Boolean;
var
  IsExist, IsSave: Boolean;
  ls_SQL: String;
begin
  IsSave:= False;
  
  ls_SQL:= 'select * from rep where UPPER(repname)=''' + UpperCase(RepName) + '''';
  Result:= OpenDataSet(dm.qryFree, ls_SQL) = '';

  if not Result then exit;

  with dm.qryFree do
  IsExist:= not IsEmpty;

  if IsExist then
  begin
    IsSave:= ShowMess('另存为', '报表：'+RepName+' 已经存在，是否覆盖它？', MB_OKCANCEL);

    if IsSave then
    begin
      REP.Template.DatabaseSettings.Name:= RepName;
      //dm.qryRep.Data:= dm.qryFree.Data;
      IsSave:= True;
    end;
  end;

  dm.qryFree.Close;

  if IsSave then
  REP.Template.SaveToDatabase;
end;

initialization
  raRegisterFunction('doValue',  TdoValue);
  
finalization
  raUnRegisterFunction('doValue');

end.