frxclassrtti.pas

这个是功能强大的报表软件

    else if MethodName = 'DELETE' then
      _TStrings.Delete(Caller.Params[0])
    else if MethodName = 'INDEXOF' then
      Result := _TStrings.IndexOf(Caller.Params[0])
    else if MethodName = 'INSERT' then
      _TStrings.Insert(Caller.Params[0], Caller.Params[1])
    else if MethodName = 'LOADFROMFILE' then
      _TStrings.LoadFromFile(Caller.Params[0])
    else if MethodName = 'LOADFROMSTREAM' then
      _TStrings.LoadFromStream(TStream(Integer(Caller.Params[0])))
    else if MethodName = 'SAVETOFILE' then
      _TStrings.SaveToFile(Caller.Params[0])
    else if MethodName = 'SAVETOSTREAM' then
      _TStrings.SaveToStream(TStream(Integer(Caller.Params[0])))
    else if MethodName = 'OBJECTS.GET' then
      Result := Integer(_TStrings.Objects[Caller.Params[0]])
    else if MethodName = 'OBJECTS.SET' then
      _TStrings.Objects[Caller.Params[0]] := TObject(Integer(Caller.Params[1]))
    else if MethodName = 'STRINGS.GET' then
      Result := _TStrings.Strings[Caller.Params[0]]
    else if MethodName = 'STRINGS.SET' then
      _TStrings.Strings[Caller.Params[0]] := Caller.Params[1]
  end
  else if ClassType = TfrxDataSet then
  begin
    _TfrxDataSet := TfrxDataSet(Instance);
    if MethodName = 'OPEN' then
      _TfrxDataSet.Open
    else if MethodName = 'CLOSE' then
      _TfrxDataSet.Close
    else if MethodName = 'FIRST' then
      _TfrxDataSet.First
    else if MethodName = 'NEXT' then
      _TfrxDataSet.Next
    else if MethodName = 'PRIOR' then
      _TfrxDataSet.Prior
    else if MethodName = 'EOF' then
      Result := _TfrxDataSet.Eof
    else if MethodName = 'FIELDSCOUNT' then
      Result := _TfrxDataSet.FieldsCount
    else if MethodName = 'RECORDCOUNT' then
      Result := _TfrxDataSet.RecordCount
    else if MethodName = 'HASFIELD' then
      Result := _TfrxDataSet.HasField(Caller.Params[0])
    else if MethodName = 'ISBLOBFIELD' then
      Result := _TfrxDataSet.IsBlobField(Caller.Params[0])
    else if MethodName = 'GETFIELDLIST' then
      _TfrxDataSet.GetFieldList(TStrings(Integer(Caller.Params[0])))
    else if MethodName = 'DISPLAYTEXT.GET' then
      Result := _TfrxDataSet.DisplayText[Caller.Params[0]]
    else if MethodName = 'DISPLAYWIDTH.GET' then
      Result := _TfrxDataSet.DisplayWidth[Caller.Params[0]]
    else if MethodName = 'FIELDTYPE.GET' then
      Result := _TfrxDataSet.FieldType[Caller.Params[0]]
    else if MethodName = 'VALUE.GET' then
      Result := _TfrxDataSet.Value[Caller.Params[0]]
  end
  else if ClassType = TfrxComponent then
  begin
    if MethodName = 'CLEAR' then
      TfrxComponent(Instance).Clear
    else if MethodName = 'FINDOBJECT' then
      Result := Integer(TfrxComponent(Instance).FindObject(Caller.Params[0]))
    else if MethodName = 'LOADFROMSTREAM' then
      TfrxComponent(Instance).LoadFromStream(TStream(Integer(Caller.Params[0])))
    else if MethodName = 'SAVETOSTREAM' then
      TfrxComponent(Instance).SaveToStream(TStream(Integer(Caller.Params[0])), Caller.Params[1])
    else if MethodName = 'SETBOUNDS' then
      TfrxComponent(Instance).SetBounds(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
  end
  else if ClassType = TfrxDialogControl then
  begin
    if MethodName = 'SETFOCUS' then
      if TfrxDialogControl(Instance).Control is TWinControl then
        TWinControl(TfrxDialogControl(Instance).Control).SetFocus;
  end
  else if ClassType = TfrxStretcheable then
  begin
    if MethodName = 'CALCHEIGHT' then
      Result := TfrxStretcheable(Instance).CalcHeight
  end
  else if ClassType = TfrxCustomMemoView then
  begin
    if MethodName = 'CALCWIDTH' then
      Result := TfrxCustomMemoView(Instance).CalcWidth
  end
  else if ClassType = TfrxPictureView then
  begin
    if MethodName = 'LOADFROMFILE' then
      TfrxPictureView(Instance).Picture.LoadFromFile(Caller.Params[0])
  end
  else if ClassType = TfrxDialogPage then
  begin
    if MethodName = 'SHOWMODAL' then
      Result := TfrxDialogPage(Instance).ShowModal
  end
  else if ClassType = TfrxVariables then
  begin
    if MethodName = 'CREATE' then
      Result := Integer(TfrxVariables(Instance).Create)
    else if MethodName = 'VARIABLES.GET' then
      Result := TfrxVariables(Instance).Variables[Caller.Params[0]]
    else if MethodName = 'VARIABLES.SET' then
      TfrxVariables(Instance).Variables[Caller.Params[0]] := Caller.Params[1]
  end
  else if ClassType = TfrxArray then
  begin
    if MethodName = 'CREATE' then
      Result := Integer(TfrxArray(Instance).Create)
    else if MethodName = 'VARIABLES.GET' then
      Result := TfrxArray(Instance).Variables[Caller.Params[0]]
    else if MethodName = 'VARIABLES.SET' then
      TfrxArray(Instance).Variables[Caller.Params[0]] := Caller.Params[1]
  end
  else if ClassType = TfrxReport then
  begin
    if MethodName = 'CALC' then
      Result := TfrxReport(Instance).Calc(Caller.Params[0], TfsScript(1))
    else if MethodName = 'GETDATASET' then
      Result := Integer(TfrxReport(Instance).GetDataset(Caller.Params[0]))
    else if MethodName = 'LOADFROMFILE' then
      Result := TfrxReport(Instance).LoadFromFile(Caller.Params[0])
    else if MethodName = 'SAVETOFILE' then
      TfrxReport(Instance).SaveToFile(Caller.Params[0])
    else if MethodName = 'SHOWREPORT' then
      TfrxReport(Instance).ShowReport
  end
  else if ClassType = TfrxCustomEngine then
  begin
    if MethodName = 'ADDANCHOR' then
      TfrxPreviewPages(TfrxCustomEngine(Instance).PreviewPages).AddAnchor(Caller.Params[0])
    else if MethodName = 'GETANCHORPAGE' then
      Result := TfrxPreviewPages(TfrxCustomEngine(Instance).PreviewPages).GetAnchorPage(Caller.Params[0])
    else if MethodName = 'NEWPAGE' then
      TfrxCustomEngine(Instance).NewPage
    else if MethodName = 'NEWCOLUMN' then
      TfrxCustomEngine(Instance).NewColumn
    else if MethodName = 'FREESPACE' then
      Result := TfrxCustomEngine(Instance).FreeSpace
    else if MethodName = 'SHOWBAND' then
      TfrxCustomEngine(Instance).ShowBand(TfrxBand(Integer(Caller.Params[0])))
    else if MethodName = 'STOPREPORT' then
      TfrxCustomEngine(Instance).StopReport
  end
  else if ClassType = TfrxCustomOutline then
  begin
    if MethodName = 'ADDITEM' then
      TfrxCustomOutline(Instance).AddItem(Caller.Params[0],
        Round(TfrxCustomOutline(Instance).Engine.CurY))
    else if MethodName = 'LEVELROOT' then
      TfrxCustomOutline(Instance).LevelRoot
    else if MethodName = 'LEVELUP' then
      TfrxCustomOutline(Instance).LevelUp
  end
  else if ClassType = TfrxStyles then
  begin
      if MethodName = 'CREATE' then
        Result := Integer(TfrxStyles(Instance).Create(TfrxReport(Integer(Caller.Params[0]))))
      else if MethodName = 'ITEMS.GET' then
        Result := Integer(TfrxStyles(Instance).Items[Caller.Params[0]])
      else if MethodName = 'ADD' then
        Result := Integer(TfrxStyles(Instance).Add)
      else if MethodName = 'FIND' then
        Result := Integer(TfrxStyles(Instance).Find(Caller.Params[0]))
      else if MethodName = 'APPLY' then
        TfrxStyles(Instance).Apply
      else if MethodName = 'GETLIST' then
        TfrxStyles(Instance).GetList(TStrings(Integer(Caller.Params[0])))
      else if MethodName = 'LOADFROMFILE' then
        TfrxStyles(Instance).LoadFromFile(Caller.Params[0])
      else if MethodName = 'LOADFROMSTREAM' then
        TfrxStyles(Instance).LoadFromStream(TStream(Integer(Caller.Params[0])))
      else if MethodName = 'SAVETOFILE' then
        TfrxStyles(Instance).SaveToFile(Caller.Params[0])
      else if MethodName = 'SAVETOSTREAM' then
        TfrxStyles(Instance).SaveToStream(TStream(Integer(Caller.Params[0])))
  end
  else if MethodName = 'DAYOF' then
    Result := StrToInt(FormatDateTime('d', Caller.Params[0]))
  else if MethodName = 'MONTHOF' then
    Result := StrToInt(FormatDateTime('m', Caller.Params[0]))
  else if MethodName = 'YEAROF' then
    Result := StrToInt(FormatDateTime('yyyy', Caller.Params[0]))
end;

function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
  const PropName: String): Variant;
begin
  Result := 0;

  if ClassType = TWideStrings then
  begin
    if PropName = 'COUNT' then
      Result := TWideStrings(Instance).Count
    else if PropName = 'TEXT' then
      Result := TWideStrings(Instance).Text
  end
  else if ClassType = TfrxDataSet then
  begin
    if PropName = 'RECNO' then
      Result := TfrxDataSet(Instance).RecNo
  end
  else if ClassType = TfrxComponent then
  begin
    if PropName = 'OBJECTS' then
      Result := Integer(TfrxComponent(Instance).Objects)
    else if PropName = 'ALLOBJECTS' then
      Result := Integer(TfrxComponent(Instance).AllObjects)
    else if PropName = 'PARENT' then
      Result := Integer(TfrxComponent(Instance).Parent)
    else if PropName = 'PAGE' then
      Result := Integer(TfrxComponent(Instance).Page)
    else if PropName = 'ABSLEFT' then
      Result := TfrxComponent(Instance).AbsLeft
    else if PropName = 'ABSTOP' then
      Result := TfrxComponent(Instance).AbsTop
  end
  else if ClassType = TfrxView then
  begin
    if PropName = 'TAGSTR' then
      Result := TfrxView(Instance).TagStr
  end
  else if ClassType = TfrxCustomMemoView then
  begin
    if PropName = 'TEXT' then
      Result := TfrxMemoView(Instance).Text
    else if PropName = 'ANSITEXT' then
      Result := TfrxMemoView(Instance).AnsiText
    else if PropName = 'LINES' then
      Result := Integer(TfrxMemoView(Instance).Memo)
    else if PropName = 'VALUE' then
      Result := TfrxMemoView(Instance).Value
  end
  else if ClassType = TfrxBand then
  begin
    if PropName = 'OVERFLOW' then
      Result := TfrxBand(Instance).Overflow
  end
  else if ClassType = TfrxDialogPage then
  begin
    if PropName = 'MODALRESULT' then
      Result := TfrxDialogPage(Instance).ModalResult
  end
  else if ClassType = TfrxReport then 
  begin
    if PropName = 'TERMINATED' then
      Result := TfrxReport(Instance).Terminated
    else if PropName = 'VARIABLES' then
      Result := Integer(TfrxReport(Instance).Variables)
    else if PropName = 'STYLES' then
      Result := Integer(TfrxReport(Instance).Styles)
  end
  else if ClassType = TfrxEngineOptions then
  begin
    if PropName = 'DESTROYFORMS' then
      Result := TfrxEngineOptions(Instance).DestroyForms
  end
end;

procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
  const PropName: String; Value: Variant);
begin
  if ClassType = TWideStrings then
  begin
    if PropName = 'TEXT' then
      TWideStrings(Instance).Text := Value
  end
  else if ClassType = TfrxComponent then
  begin
    if PropName = 'PARENT' then
      TfrxComponent(Instance).Parent := TfrxComponent(Integer(Value))
  end
  else if ClassType = TfrxView then
  begin
    if PropName = 'TAGSTR' then
      TfrxView(Instance).TagStr := Value
  end
  else if ClassType = TfrxCustomMemoView then
  begin
    if PropName = 'TEXT' then
    begin
      {avoid bug when use Memo.Text:= String in script with charset <> DEFAULT}
      if (TfrxMemoView(Instance).Font.Charset <> 1) and (VarType(Value) = varString) then
        TfrxMemoView(Instance).Text := AnsiToUnicode(AnsiString(Value), TfrxMemoView(Instance).Font.Charset)
      else TfrxMemoView(Instance).Text := Value;
    end
    else if PropName = 'ANSITEXT' then
      TfrxMemoView(Instance).AnsiText := AnsiString(Value)
    else if PropName = 'LINES' then
      TfrxMemoView(Instance).Memo.Assign(TStrings(Integer(Value)));
  end
  else if ClassType = TfrxDialogPage then
  begin
    if PropName = 'MODALRESULT' then
      TfrxDialogPage(Instance).ModalResult := Value
  end
  else if ClassType = TfrxReport then
  begin
    if PropName = 'TERMINATED' then
      TfrxReport(Instance).Terminated := Value
  end
  else if ClassType = TfrxEngineOptions then
  begin
    if PropName = 'DESTROYFORMS' then
      TfrxEngineOptions(Instance).DestroyForms := Value
  end
end;


initialization
  fsRTTIModules.Add(TFunctions);

finalization
  if fsRTTIModules <> nil then
    fsRTTIModules.Remove(TFunctions);

end.


//