دوست عزیز شما میتوانید در ReportBuilder فانکشنهای خود را رجیستر کنید و استفاده کنید
من یک یونیت برای خودم نوشتم که یک سری فانکشنها را رجیستر کردم
شما این یونیت نمیتوانید استفاده کنید چون یک سری از یونیتهای دیگری لازم دارد.
شما فقط نوع تعریف کردن فانکشنها و طریقه رجیستر کردن آنها را میتوانید از آن بردارید :
unit rap_Func;
interface
uses
Classes,sysutils, Forms, raFunc, ppRTTI, db, OSDB, ppUtils, Variants;
type
{ TmyDevelopersFunction }
TLibFunctions = class (TraSystemFunction)
public
class function Category: string; override;
end;
{ TmyGetDelphiComponentFunction }
TGetComponent = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TGetSysParam = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TcfValues = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
// class function HasParams: Boolean; override;
end;
TDValues = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TcfPutComaBetNumber = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TcfCalculateNumber = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TDgt2Farsi = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TCallMtd = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
{ TDeleteItem = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;}
TFarsiDate = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TChr = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TSh2M = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TM2Sh = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
TMnt2Hour = class (TLibFunctions)
public
procedure ExecuteFunction(aParams: TraParamList); override;
class function GetSignature: string; override;
end;
implementation
uses MthdIntf,Sml,ppclass,FConv,Graphics,App_Prms,GlobF unc,DateFunc,Farsi,Str_Func;
{------------------------------------------------------------------------------}
{ TmyDevelopersFunction.Category}
class function TLibFunctions.Category: string;
begin
Result := 'LibFunctions';
end;{ class function Category() }
{------------------------------------------------------------------------------}
{ TmyGetDelphiComponentFunction.ExecuteFunction}
procedure TGetComponent.ExecuteFunction(aParams: TraParamList);
var
lsString: string;
lResult: TComponent;
begin
GetParamValue(0, lsString);
lResult := Application.MainForm.FindComponent(lsString);
SetParamValue(1, lResult);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TmyGetDelphiComponentFunction.GetSignature}
class function TGetComponent.GetSignature: string;
begin
Result := 'function GetComponent(const aComponentName: String): TComponent;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
{ TmyGetDelphiComponentFunction.ExecuteFunction}
procedure TGetSysParam.ExecuteFunction(aParams: TraParamList);
var
ParamName: string;
lResult: string;
begin
GetParamValue(0, ParamName);
lResult := GetSysParam(ParamName);
SetParamValue(1, lResult);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TmyGetDelphiComponentFunction.GetSignature}
class function TGetSysParam.GetSignature: string;
begin
Result := 'function cfGetSysParam(ParamName: String): string;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TCallMtd.ExecuteFunction(aParams: TraParamList);
var
Param: variant;
MtdName:string;
Obj:TObject;
_Result: variant;
begin
GetParamValue(0, Obj);
GetParamValue(1, MtdName);
MtdName:=Uppercase(MtdName);
GetParamValue(2, Param);
_Result:=CallMethod(obj,MtdName,Param,unassigned,u nassigned,unassigned,unassigned);
SetParamValue(3, _Result);
end;
{------------------------------------------------------------------------------}
class function TCallMtd.GetSignature: string;
begin
Result := 'function CallMtd(Obj:TObject;MethodName:string;Parameter:va riant): variant;';
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TcfValues.ExecuteFunction(aParams: TraParamList);
var
_Result: String;
Index : Integer;
begin
GetParamValue(0,Index);
_Result:=Values[Index];
SetParamValue(1, _Result);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TcfValues.GetSignature: string;
begin
result := 'Function cfValues(Index:Integer) : String;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TDValues.ExecuteFunction(aParams: TraParamList);
var
_Result: String;
Index : Integer;
begin
GetParamValue(0,Index);
_Result := '';
if Index < DValues.Count then
_Result:=DValues[Index];
SetParamValue(1, _Result);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TDValues.GetSignature: string;
begin
result := 'Function DValues(Index:Integer) : String;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TcfPutComaBetNumber.ExecuteFunction(aParams: TraParamList);
var
_Result,TmpStr: String;
begin
GetParamValue(0,TmpStr);
_Result:= PutComaBetNumber(TmpStr);
SetParamValue(1, _Result);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TcfPutComaBetNumber.GetSignature: string;
begin
result := 'Function cfPutComaBetNumber(TmpStr:String) : String;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TcfCalculateNumber.ExecuteFunction(aParams: TraParamList);
var
Datep,DateCur:String;
_Result:Integer;
begin
GetParamValue(0,Datep);
GetParamValue(1,DateCur);
_Result:= CalculateNumber(Datep,DateCur);
SetParamValue(2,_Result);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TcfCalculateNumber.GetSignature: string;
begin
result :='Function cfCalculateNumber(Datep,DateCur:string):Integer;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TDgt2Farsi.ExecuteFunction(aParams: TraParamList);
var
Number:double;
_Result:string;
begin
GetParamValue(0,Number);
ConvertNumberToChar(number,_Result);
SetParamValue(1,_Result);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TDgt2Farsi.GetSignature: string;
begin
result:='Function Dgt2Farsi(Number:Double):string;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TFarsiDate.ExecuteFunction(aParams: TraParamList);
var
_Result:string;
begin
_Result:=GetServerDate;
SetParamValue(0,_Result);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TFarsiDate.GetSignature: string;
begin
result :='Function FarsiDate:String;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TChr.ExecuteFunction(aParams: TraParamList);
var
AsciiCode:integer;
_Result:char;
begin
GetParamValue(0,AsciiCode);
_Result:=chr(AsciiCode);
SetParamValue(1,_Result);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TChr.GetSignature: string;
begin
result :='Function chr(AsciiCode:integer):char;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TSh2M.ExecuteFunction(aParams: TraParamList);
var
sh,m:t_date;
begin
GetParamValue(0,sh.y);
GetParamValue(1,sh.m);
GetParamValue(2,sh.d);
shtom(sh,m);
SetParamValue(3,m.y);
SetParamValue(4,m.m);
SetParamValue(5,m.d);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TSh2M.GetSignature: string;
begin
result :='Procedure Sh2M(sh_y,sh_m,sh_d:integer;var m_y,m_m,m_d:integer);';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
procedure TM2Sh.ExecuteFunction(aParams: TraParamList);
var
sh,m:t_date;
begin
GetParamValue(0,m.y);
GetParamValue(1,m.m);
GetParamValue(2,m.d);
mtosh(m,sh);
SetParamValue(3,sh.y);
SetParamValue(4,sh.m);
SetParamValue(5,sh.d);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TM2Sh.GetSignature: string;
begin
result :='Procedure M2Sh(m_y,m_m,m_d:integer;var sh_y,sh_m,sh_d:integer);';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
{ TMnt2Hour }
procedure TMnt2Hour.ExecuteFunction(aParams: TraParamList);
var
Minute:Integer;
_Result:string;
begin
GetParamValue(0,Minute);
_Result:=Mnt2Hour(Minute);
SetParamValue(1,_Result);
end;{ procedure ExecuteFunction() }
{------------------------------------------------------------------------------}
{ TcfValues.GetSignature}
class function TMnt2Hour.GetSignature: string;
begin
result:='Function Mnt2Hour(Minute:Integer):string;';
end;{ class function GetSignature() }
{------------------------------------------------------------------------------}
Initialization
raRegisterFunction('GetComponent', TGetComponent);
raRegisterFunction('cfGetSysParam', TGetSysParam);
raRegisterFunction('CallMtd', TCallMtd);
raRegisterFunction('cfValues', TcfValues);
raRegisterFunction('DValues', TDValues);
raRegisterFunction('cfPutComaBetNumber', TcfPutComaBetNumber);
raRegisterFunction('cfCalculateNumber', TcfCalculateNumber);
raRegisterFunction('FarsiDate', TFarsiDate);
raRegisterFunction('chr', TChr);
raRegisterFunction('Dgt2Farsi', TDgt2Farsi);
raRegisterFunction('Sh2M', TSh2M);
raRegisterFunction('M2Sh', TM2Sh);
raRegisterFunction('Mnt2Hour', TMnt2Hour);
end.
کدهای خودتون رو بین تگهای Code و /code قرار دهید(ذوالقدر)
نوشته شده توسط saeed_d
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول