rm_system.pas

这是一个功能强大

begin
  Add(Name, Value);
end;

procedure TRMVariables.SetStringVariable(const aName: string; aValue: Variant);
var
  i: Integer;
  s: string;
begin
  i := IndexOfName(aName);
  s := VarToStr(aValue);
  s := QuotedStr(s);
  if i >= 0 then
  begin
    Items[i].Value := s;
  end
  else
  begin
    SetVariable(aName, s);
  end;
end;

function TRMVariables.GetItem(Index: integer): TRMVariableItem;
begin
  Result := TRMVariableItem(inherited Items[Index]);
end;

function TRMVariables.GetVariable(const Name: string): Variant;
var
  i: Integer;
begin
  i := IndexOfName(Name);
  if i >= 0 then
    Result := Items[i].Value
  else
    Result := Null;
end;

procedure TRMVariables.SetValue(Index: Integer; Value: Variant);
begin
  if (Index < 0) or (Index >= Count)
    or (Items[Index].Name = '') then Exit;

  Items[Index].Value := Value;

end;

function TRMVariables.GetValue(Index: Integer): Variant;
begin
  Result := 0;
  if (Index < 0) or (Index >= Count)
    or (Items[Index].Name = '') then Exit;

  Result := Items[Index].Value;
end;

procedure TRMVariables.Insert(Index: Integer; const aName: string; aValue: Variant);
var
  i: integer;
begin
  i := Add(aName, aValue);

  if i <> -1 then
    Items[i].Index := Index;
end;

function TRMVariables.Add(const aName: string; aValue: Variant): Integer;
var
  lItem: TRMVariableItem;
begin
  Result := -1;
  if Trim(aName) = '' then Exit;

  Result := IndexOfName(aName);
  if Result <> -1 then
    Items[Result].Value := aValue
  else
  begin
    lItem := TRMVariableItem(inherited Add());
    lItem.Name := aName;
    lItem.Value := aValue;
    lItem.IsExpression := True;
    Result := Count - 1;
  end;
end;

procedure TRMVariables.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= Count) then Exit;
  inherited Delete(Index);
end;

procedure TRMVariables.AddCategory(const Name: string);
begin
  SetVariable(' ' + Name, '');
end;

procedure TRMVariables.DeleteByName(const AName: string);
begin
  Delete(IndexOfName(AName));
end;

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

{------------------------------------------------------------------------------}
{ TRMPersistentCompAdapter }

constructor TRMPersistentCompAdapter.CreateComp(aComp: TObject);
begin
  inherited Create(nil);

  FComp := aComp;
end;

destructor TRMPersistentCompAdapter.Destroy;
begin
  inherited Destroy;
end;

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

{------------------------------------------------------------------------------}
{ TRMPersistent }

constructor TRMPersistent.Create;
begin
  inherited Create;

  FEventPropVars := nil;
end;

destructor TRMPersistent.Destroy;
begin
  FComAdapter := nil;
  FreeAndNil(FEventPropVars);
  inherited Destroy;
end;

function TRMPersistent.GetEventPropVars: TRMVariables;
begin
  if FEventPropVars = nil then
  begin
    FEventPropVars := TRMVariables.Create;
  end;

  Result := FEventPropVars;
end;

procedure TRMPersistent.LoadEventInfo(aStream: TStream);
var
  i, lCount: Integer;
  lStr: string;
begin
  lCount := RMReadWord(aStream);
  for i := 0 to lCount - 1 do
  begin
    lStr := RMReadString(aStream);
    EventPropVars[lStr] := RMReadString(aStream);
  end;
end;

procedure TRMPersistent.SaveEventInfo(aStream: TStream);
var
  i: Integer;
begin
  if FEventPropVars = nil then
    RMWriteWord(aStream, 0)
  else
  begin
    RMWriteWord(aStream, FEventPropVars.Count);
    for i := 0 to FEventPropVars.Count - 1 do
    begin
      RMWriteString(aStream, FEventPropVars.Name[i]);
      RMWriteString(aStream, FEventPropVars.Value[i]);
    end;
  end;
end;

function TRMPersistent.GetPropValue(aObject: TObject; aPropName: string;
  var aValue: Variant; Args: array of Variant): Boolean;
begin
  E_GetComponent(aObject, aPropName);
  Result := RMGetPropValue_1(aObject, aPropName, aValue);
end;

function TRMPersistent.SetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean;
begin
  E_GetComponent(aObject, aPropName);
  Result := RMSetPropValue(aObject, aPropName, aValue);
end;

procedure TRMPersistent.SetName(const Value: string);
begin
  FName := Value;
end;

type
  THackEngine = class(TJvInterpreterProgram {TJvInterpreterFm});
  THackRMCustomComponent = class(TRMPersistent);

procedure TRMPersistent.SetObjectEvent(aEventList: TList; aEngine: TJvInterpreterProgram);
var
  i: Integer;
  lMethod: TMethod;
  lPropInfo: PPropInfo;
  lPropName: string;
  lPropValue: string;
begin
  if FEventPropVars = nil then Exit;

  for i := 0 to EventPropVars.Count - 1 do
  begin
    lPropName := EventPropVars.Name[i];
    lPropValue := EventPropVars.Value[i];
    if (lPropValue <> '') and
      aEngine.FunctionExists('Report', lPropValue) then
    begin
      lPropInfo := TypInfo.GetPropInfo(Self, lPropName);
      try
        lMethod := TMethod(THackEngine(aEngine).NewEvent(
          'Report',
          lPropValue,
          lPropInfo^.PropType^.Name,
          Self, lPropName));
        TypInfo.SetMethodProp(Self, lPropInfo, lMethod);
        aEventList.Add(lMethod.Data);
      except
      end;
    end;
  end;
end;

function TRMPersistent.GetComAdapter: IInterface;
var
  i: Integer;
begin
  if FComAdapter = nil then
  begin
    for i := 0 to RMComAdapterList.Count - 1 do
    begin
      if TRMPageEditorInfo(RMComAdapterList[i]).PageClass = ClassType then
      begin
        FComAdapter := TRMPersistentCompAdapterClass(TRMPageEditorInfo(RMComAdapterList[i]).PageEditorClass).CreateComp(Self);
        Break;
      end;
    end;
  end;

  Result := FComAdapter;
end;

procedure TRMPersistent.SetComAdapter(const Value: IInterface);
begin
  FComAdapter := Value;
end;

{------------------------------------------------------------------------------}
{ TRMComponent }

destructor TRMComponent.Destroy;
begin
  FComAdapter := nil;
  inherited Destroy;
end;

function TRMComponent.GetPropValue(aObject: TObject; aPropName: string;
  var aValue: Variant; Args: array of Variant): Boolean;
begin
  Result := False;
end;

function TRMComponent.SetPropValue(aObject: TObject; aPropName: string;
  aValue: Variant): Boolean;
begin
  Result := False;
end;

function TRMComponent.GetComAdapter: IInterface;
begin
  Result := FComAdapter;
end;

procedure TRMComponent.SetComAdapter(const Value: IInterface);
begin
  FComAdapter := Value;
end;

function TRMComponent.GetEventPropVars: TRMVariables;
begin
  if FEventPropVars = nil then
  begin
    FEventPropVars := TRMVariables.Create;
  end;

  Result := FEventPropVars;
end;

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

{ TRMCustomEventItems }

constructor TRMCustomEventItems.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TRMEventItem);
end;

function TRMCustomEventItems.GetItem(index: integer): TRMEventItem;
begin
  Result := TRMEventItem(inherited Items[Index]);
end;

{ TRMEventPropVars }

procedure TRMEventPropVars.CheckParentReport;
begin
  if FParentReport = nil then
    raise Exception.Create('ParentReport Can''t be nil!');
end;

constructor TRMEventPropVars.Create(aReport: TComponent);
begin
  inherited Create(aReport);
  FParentReport := aReport;
end;

function TRMEventPropVars.DeleteAllEventByObjName(aComponentName: string): boolean;
var
  i, iCount: Integer;
begin
  Result := false;
  iCount := self.Count;
  if (aComponentName = '') or (iCount <= 0) then
    Exit;
  for i := iCount - 1 downto 0 do
  begin
    if Sametext(TRMEventItem(Items[i]).objectName, aComponentName) then
    begin
      Delete(i);
    end;
  end;
  Result := true;
end;

function TRMEventPropVars.IndexOfEvent(aObjectName,
  aEventPropName: string): integer;
var
  i: integer;
  m: TRMEventItem;
begin
  Result := -1;
  if (Count <= 0) or (aObjectName = '') or (aEventPropName = '') then
    Exit;
  for i := 0 to Count - 1 do
  begin
    m := TRMEventItem(Items[i]);
    if SameText(m.ObjectName, aObjectName) and SameText(m.EventPropName, aEventPropName) then
    begin
      Result := i;
      Exit;
    end;
  end;
end;


function TRMEventPropVars.IndexOfEvent(AInstance: TPersistent;
  aEventPropName: string): integer;
var
  i: integer;
  m: TRMEventItem;
begin
  Result := -1;
  if (Count <= 0) or (AInstance = nil) or (aEventPropName = '') then
    Exit;
  for i := 0 to Count - 1 do
  begin
    m := TRMEventItem(Items[i]);
    if (m.Instance = AInstance) and SameText(m.EventPropName, aEventPropName) then
    begin
      Result := i;
      Exit;
    end;
  end;
end;

function TRMEventPropVars.GetEventPropVar(AInstance: TPersistent;
  APropName: string): string;
var
  lVars: TRMVariables;
  lValue: Variant;
begin
  Result := '';
  if (AInstance = nil) or (APropName = '') then
    Exit;
  if AInstance is TRMPersistent then
    lVars := TRMPersistent(AInstance).EventPropVars
  else
    lVars := nil;

  if lVars <> nil then
  begin
    lValue := lVars[APropName];
    if lValue <> Null then
      Result := lValue
    else
      Result := '';
  end;
end;

function TRMEventPropVars.SetEventPropVar(AInstance: TPersistent;
  APropName, AProcName: string): Integer;
var
  lVars: TRMVariables;
  m: TRMEventItem;
  sObjName: string;
begin
  Result := -1;
  if (AInstance = nil) or (APropName = '') then
    Exit;

  lVars := nil;
  if AInstance is TRMPersistent then
  begin
    lVars := TRMPersistent(AInstance).EventPropVars;
    sObjName := TRMPersistent(AInstance).Name;
  end
  else if AInstance is TComponent then
  begin
    sObjName := TComponent(AInstance).Name;
  end;

  if lVars = nil then Exit;

  Result := IndexOfEvent(AInstance, APropName);

  if AProcName = '' then
  begin
    lVars.DeleteByName(APropName);
    if (Result <> -1) then
      Delete(Result);

    Exit;
  end
  else
  begin
    lVars[APropName] := AProcName;
    if (Result = -1) then
    begin
      m := TRMEventItem(Add());
      m.Instance := AInstance;
      m.ObjectName := sObjName;
      m.EventPropName := APropName;
      m.EventValueName := AProcName;
      Result := Count;
    end
    else
    begin
      m := TRMEventItem(Items[Result]);
      m.EventValueName := AProcName;
    end;
  end;
end;

function TRMEventPropVars.DeleteEventProp(AInstance: TPersistent;
  APropName: string): boolean;
var
  i: Integer;
  lVars: TRMVariables;
begin
  Result := False;
  i := IndexOfEvent(AInstance, APropName);
  if (i = -1) then
    Exit;

  if Items[i].Instance is TRMPersistent then
  begin
    lVars := TRMPersistent(Items[i].Instance).EventPropVars;
  end
  else
    lVars := nil;

  if lVars <> nil then
    lVars.DeleteByName(APropName);

  Delete(i);
  Result := true;
end;

procedure TRMEventPropVars.RenameEventProc(aOldProcName,
  aNewProcName: string);
var
  i: integer;
  lVars: TRMVariables;
begin
  if SameText(aOldProcName, aNewProcName) or (Count < 1) then Exit;
  for i := 0 to Count - 1 do
  begin
    if SameText(aOldProcName, Items[i].EventValueName) then
    begin
      Items[i].EventValueName := aNewProcName;
      if Items[i].Instance is TRMPersistent then
      begin
        lVars := TRMPersistent(Items[i].Instance).EventPropVars;
      end
      else
        lVars := nil;
      if lVars <> nil then
        lVars[Items[i].EventPropName] := aNewProcName;
    end;
  end;
end;

end.