rm_common.pas

这是一个功能强大

  i: Integer;
  tmp: TRMCustomFunctionLibrary;
begin
  for i := 0 to RMFunctionList.Count - 1 do
  begin
    if TRMCustomFunctionLibrary(RMFunctionList[i]).ClassName = ClassRef.ClassName then
      Exit;
  end;

  tmp := TRMCustomFunctionLibrary(ClassRef.NewInstance);
  tmp.Create;
  RMFunctionList.Add(tmp);
end;

procedure RMUnRegisterFunctionLibrary(ClassRef: TClass);
var
  i: Integer;
begin
  if FRMFunctionList = nil then Exit;

  for i := 0 to RMFunctionList.Count - 1 do
  begin
    if TRMCustomFunctionLibrary(RMFunctionList[i]).ClassName = ClassRef.ClassName then
    begin
      TRMCustomFunctionLibrary(RMFunctionList[i]).Free;
      RMFunctionList.Delete(i);
      Break;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMCustomFunctionLibrary}

constructor TRMCustomFunctionLibrary.Create;
begin
  inherited Create;

  FList := TStringList.Create;
  FFunctionList := TList.Create;
end;

destructor TRMCustomFunctionLibrary.Destroy;
begin
  Clear;
  FFunctionList.Free;
  FList.Free;

  inherited Destroy;
end;

procedure TRMCustomFunctionLibrary.Clear;
begin
  while FFunctionList.Count > 0 do
  begin
    Dispose(PRMFunctionDesc(FFunctionList[0]));
    FFunctionList.Delete(0);
  end;
end;

procedure TRMCustomFunctionLibrary.DoFunction(aParser: TRMCustomParser; aFuncNo: Integer; aParams: array of Variant;
  var aValue: Variant);
begin
//
end;

function TRMCustomFunctionLibrary.OnFunction(aParser: TRMCustomParser; const aFunctionName: string;
  aParams: array of Variant; var aValue: Variant): Boolean;
var
  i: Integer;
begin
  Result := False;
  i := FList.IndexOf(aFunctionName);
  if i >= 0 then
  begin
    DoFunction(aParser, i, aParams, aValue);
    Result := True;
  end;
end;

procedure TRMCustomFunctionLibrary.AddFunctionDesc(const aFuncName, aCategory,
  aDescription, aFuncPara: string);
var
  pfunc: PRMFunctionDesc;
begin
  New(pfunc);
  pfunc^.FuncName := aFuncName;
  pfunc^.Category := aCategory;
  pfunc^.Description := aDescription;
  pfunc^.FuncPara := aFuncPara;

  FFunctionList.Add(pfunc);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure FreeAddInReportPageList;
var
  i: Integer;
begin
  if FRMAddInReportPageList = nil then Exit;

  for i := 0 to FRMAddInReportPageList.Count - 1 do
    TRMAddInObjectInfo(FRMAddInReportPageList[i]).Free;

  FreeAndNil(FRMAddInReportPageList);
end;

procedure FreeAddInObjectList;
var
  i: Integer;
begin
  if FRMAddInObjectList = nil then Exit;
  for i := 0 to FRMAddInObjectList.Count - 1 do
    TRMAddinObjectInfo(FRMAddInObjectList[i]).Free;

  FreeAndNil(FRMAddInObjectList);
end;

procedure FreeExportFilterList;
var
  i: Integer;
begin
  if FRMExportFilterList = nil then Exit;
  for i := 0 to FRMExportFilterList.Count - 1 do
    TRMExportFilterInfo(FRMExportFilterList[i]).Free;

  FreeAndNil(FRMExportFilterList);
end;

procedure FreeToolsList;
var
  i: Integer;
begin
  if FRMToolsList = nil then Exit;
  for i := 0 to FRMToolsList.Count - 1 do
    TRMToolsInfo(FRMToolsList[i]).Free;

  FreeAndNil(FRMToolsList);
end;

procedure FreeComAdapterList;
var
  i: Integer;
begin
  if FComAdapterList = nil then Exit;

  for i := 0 to FComAdapterList.Count - 1 do
    TRMPageEditorInfo(FComAdapterList[i]).Free;

  FreeAndNil(FComAdapterList);
end;

procedure FreePageEditorList;
var
  i: Integer;
begin
  if FRMPageEditorList = nil then Exit;

  for i := 0 to FRMPageEditorList.Count - 1 do
    TRMPageEditorInfo(FRMPageEditorList[i]).Free;

  FreeAndNil(FRMPageEditorList);
end;

procedure FreeDsgPageButton;
var
  i: Integer;
begin
  if FRMDsgPageButtonList = nil then Exit;

  for i := 0 to FRMDsgPageButtonList.Count - 1 do
    TRMToolsInfo(FRMDsgPageButtonList[i]).Free;

  FreeAndNil(FRMDsgPageButtonList);
end;

procedure FreeFunctionList;
var
  i: Integer;
begin
  if FRMFunctionList = nil then Exit;
  for i := 0 to FRMFunctionList.Count - 1 do
    TRMCustomFunctionLibrary(FRMFunctionList[i]).Free;

  FreeAndNil(FRMFunctionList);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TWideStringList_Read_Text(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Text;
end;

procedure TWideStringList_Write_Text(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Text := Value;
end;

procedure TWideStringList_Add(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Add(Args.Values[0]);
end;

procedure TWideStringList_Clear(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Clear;
end;

procedure TWideStringList_Delete(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Delete(Args.Values[0]);
end;

procedure TWideStringList_Exchange(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Exchange(Args.Values[0], Args.Values[1]);
end;

procedure TWideStringList_Find(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Find(Args.Values[0], TVarData(Args.Values[1]).vInteger);
end;

procedure TWideStringList_IndexOf(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).IndexOf(Args.Values[0]);
end;

procedure TWideStringList_Insert(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Insert(Args.Values[0], Args.Values[1]);
end;

procedure TWideStringList_Sort(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Sort;
end;

//procedure TWideStringList_AddObject(var Value: Variant; Args: TJvInterpreterArgs);
//begin
//  Value := TWideStringList(Args.Obj).AddObject(Args.Values[0], V2O(Args.Values[1]));
//end;

procedure TWideStringList_Append(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Append(Args.Values[0]);
end;

procedure TWideStringList_AddStrings(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).AddStrings(V2O(Args.Values[0]) as TWideStringList);
end;

procedure TWideStringList_Assign(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Assign(V2O(Args.Values[0]) as TPersistent);
end;

procedure TWideStringList_BeginUpdate(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).BeginUpdate;
end;

procedure TWideStringList_EndUpdate(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).EndUpdate;
end;

procedure TWideStringList_Equals(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Equals(V2O(Args.Values[0]) as TWideStringList);
end;

procedure TWideStringList_IndexOfName(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).IndexOfName(Args.Values[0]);
end;

procedure TWideStringList_IndexOfObject(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).IndexOfObject(V2O(Args.Values[0]));
end;

procedure TWideStringList_InsertObject(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).InsertObject(Args.Values[0], Args.Values[1], V2O(Args.Values[2]));
end;

procedure TWideStringList_LoadFromFile(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).LoadFromFile(Args.Values[0]);
end;

procedure TWideStringList_LoadFromStream(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).LoadFromStream(V2O(Args.Values[0]) as TStream);
end;

procedure TWideStringList_Move(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Move(Args.Values[0], Args.Values[1]);
end;

procedure TWideStringList_SaveToFile(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).SaveToFile(Args.Values[0]);
end;

procedure TWideStringList_SaveToStream(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).SaveToStream(V2O(Args.Values[0]) as TStream);
end;

procedure TWideStringList_Read_Capacity(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Capacity;
end;

procedure TWideStringList_Write_Capacity(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Capacity := Value;
end;

procedure TWideStringList_Read_CommaText(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).CommaText;
end;

procedure TWideStringList_Write_CommaText(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).CommaText := Value;
end;

procedure TWideStringList_Read_Count(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Count;
end;

procedure TWideStringList_Read_Names(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Names[Args.Values[0]];
end;

procedure TWideStringList_Read_Values(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Values[Args.Values[0]];
end;

procedure TWideStringList_Write_Values(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Values[Args.Values[0]] := Value;
end;

procedure TWideStringList_Read_Objects(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(TWideStringList(Args.Obj).Objects[Args.Values[0]]);
end;

procedure TWideStringList_Write_Objects(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Objects[Args.Values[0]] := V2O(Value);
end;

procedure TWideStringList_Read_Strings(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := TWideStringList(Args.Obj).Strings[Args.Values[0]];
end;

procedure TWideStringList_Write_Strings(const Value: Variant; Args: TJvInterpreterArgs);
begin
  TWideStringList(Args.Obj).Strings[Args.Values[0]] := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

const
  cReportMachine = 'RM_Class';

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    { TWideStringList }
    AddClass('cReportMachine', TWideStringList, 'TWideStringList');
    AddGet(TWideStringList, 'Append', TWideStringList_Append, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'AddStrings', TWideStringList_AddStrings, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'Assign', TWideStringList_Assign, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'IndexOfName', TWideStringList_IndexOfName, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'LoadFromFile', TWideStringList_LoadFromFile, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'Move', TWideStringList_Move, 2, [varEmpty, varEmpty], varEmpty);
    AddGet(TWideStringList, 'SaveToFile', TWideStringList_SaveToFile, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'CommaText', TWideStringList_Read_CommaText, 0, [0], varEmpty);
    AddSet(TWideStringList, 'CommaText', TWideStringList_Write_CommaText, 0, [0]);
    AddGet(TWideStringList, 'Count', TWideStringList_Read_Count, 0, [0], varEmpty);
    AddIGet(TWideStringList, 'Names', TWideStringList_Read_Names, 1, [0], varEmpty);
    AddIGet(TWideStringList, 'Values', TWideStringList_Read_Values, 1, [0], varEmpty);
    AddISet(TWideStringList, 'Values', TWideStringList_Write_Values, 1, [1]); // ivan_ra
    AddIGet(TWideStringList, 'Objects', TWideStringList_Read_Objects, 1, [0], varEmpty);
    AddISet(TWideStringList, 'Objects', TWideStringList_Write_Objects, 1, [1]);
    AddIGet(TWideStringList, 'Strings', TWideStringList_Read_Strings, 1, [0], varEmpty);
    AddISet(TWideStringList, 'Strings', TWideStringList_Write_Strings, 1, [1]);
    AddIDGet(TWideStringList, TWideStringList_Read_Strings, 1, [0], varEmpty);
    AddIDSet(TWideStringList, TWideStringList_Write_Strings, 1, [1]);
    AddGet(TWideStringList, 'Text', TWideStringList_Read_Text, 0, [0], varEmpty);
    AddSet(TWideStringList, 'Text', TWideStringList_Write_Text, 0, [0]);
    AddGet(TWideStringList, 'Add', TWideStringList_Add, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'Clear', TWideStringList_Clear, 0, [0], varEmpty);
    AddGet(TWideStringList, 'Delete', TWideStringList_Delete, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'Exchange', TWideStringList_Exchange, 2, [varEmpty, varEmpty], varEmpty);
    AddGet(TWideStringList, 'Find', TWideStringList_Find, 2, [varEmpty, varByRef], varEmpty);
    AddGet(TWideStringList, 'IndexOf', TWideStringList_IndexOf, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'Insert', TWideStringList_Insert, 2, [varEmpty, varEmpty], varEmpty);
    AddGet(TWideStringList, 'Sort', TWideStringList_Sort, 0, [0], varEmpty);
    AddGet(TWideStringList, 'BeginUpdate', TWideStringList_BeginUpdate, 0, [0], varEmpty);
    AddGet(TWideStringList, 'EndUpdate', TWideStringList_EndUpdate, 0, [0], varEmpty);
    AddGet(TWideStringList, 'Capacity', TWideStringList_Read_Capacity, 0, [varEmpty], varEmpty);
    AddSet(TWideStringList, 'Capacity', TWideStringList_Write_Capacity, 0, [varEmpty]);
    AddGet(TWideStringList, 'SaveToStream', TWideStringList_SaveToStream, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'LoadFromStream', TWideStringList_LoadFromStream, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'IndexOfObject', TWideStringList_IndexOfObject, 1, [varEmpty], varEmpty);
    AddGet(TWideStringList, 'InsertObject', TWideStringList_InsertObject, 3, [varEmpty, varEmpty, varEmpty], varEmpty);
    AddGet(TWideStringList, 'Equals', TWideStringList_Equals, 1, [varEmpty], varEmpty);
  end;
end;

initialization
  RMRegRootKey := 'Software\WHF SoftWare\Report Machine';
  FDataSetList := nil;
  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);

finalization
  FreeAndNil(FDataSetList);
  FreeAddInObjectList;
  FreeAddInReportPageList;
  FreeExportFilterList;
  FreeToolsList;
  FreeFunctionList;
  FreePageEditorList;
  FreeDsgPageButton;
  FreeComAdapterList;

end.