rm_jvinterpreterfm.pas

这是一个功能强大

    JvInterpreterReadComponentRes(Stream, Form);
  finally
    FreeDfmStream(Stream);
  end;
  // Class Fields support begin
  // copy form fields from pattern
  SrcClass := TJvInterpreterAdapterAccessProtected(Adapter).GetSrcClass(
    AForm.FClassIdentifier);
  AForm.FFieldList.Assign(TJvInterpreterClass(SrcClass).ClassFields);
  // Class Fields support end
  try
    if Assigned(Form.OnCreate) then
      Form.OnCreate(Form);
  except
    Application.HandleException(Form);
  end;
  if Form.FormStyle <> fsMDIChild then
    Form.Visible := False;
end;

function TJvInterpreterFm.GetValue(const Identifier: string; var Value: Variant;
  var Args: TJvInterpreterArgs): Boolean;
var
  JvInterpreterSrcClass: TJvInterpreterIdentifier;
  JvInterpreterForm: TJvInterpreterForm;

  function GetFromForm(Form: TJvInterpreterForm): Boolean;
  var
    Com: TComponent;
  begin
    if Cmp(Identifier, 'Self') then
    begin
      Value := O2V(Form);
      Result := True;
      Exit;
    end;
    Com := Form.FindComponent(Identifier);
    if Com = nil then
    begin
      if (LocalVars <> nil) and (LocalVars.FindVar('', Identifier) <> nil) then
      begin
        Result := LocalVars.GetValue(Identifier, Value, Args);
        Exit;
      end;
      // Class Fields support begin
      with Form.FFieldList do
      if FindVar('', Identifier) <> nil then
      begin
        Result := GetValue(Identifier, Value, Args);
        Exit;
      end;
      // Class Fields support end
      { may be TForm method or published property }
      Args.Obj := Form;
      Args.ObjTyp := varObject;
      try
        Result := inherited GetValue(Identifier, Value, Args);
      finally
        Args.Obj := nil;
        Args.ObjTyp := 0;
      end;
    end
    else
    begin
      Value := O2V(Com);
      Result := True;
    end;
  end;

begin
  if (Args.Obj = nil) and (CurInstance is TJvInterpreterForm) then
    Result := GetFromForm(CurInstance as TJvInterpreterForm)
  else
  if (Args.Obj <> nil) and (Args.ObjTyp = varObject) and
    (Args.Obj is TJvInterpreterForm) then
  begin
    { run-time form creation }
    if Cmp(Identifier, 'Create') then
    begin
      JvInterpreterSrcClass := TJvInterpreterAdapterAccessProtected(Adapter).GetSrcClass(
        (Args.Obj as TJvInterpreterForm).FClassIdentifier);
      (Args.Obj as TJvInterpreterForm).FUnitName := JvInterpreterSrcClass.UnitName;
      LoadForm(Args.Obj as TJvInterpreterForm);
      Value := O2V(Args.Obj);
      Result := True;
      Exit;
    end
    else
      Result := GetFromForm(Args.Obj as TJvInterpreterForm)
  end
  else
    Result := False;

  if Result then
    Exit;

  { run-time form creation }
  JvInterpreterSrcClass := TJvInterpreterAdapterAccessProtected(Adapter).GetSrcClass(Identifier);
  if JvInterpreterSrcClass <> nil then
  begin
    JvInterpreterForm := TJvInterpreterForm.CreateNew(Application);
    JvInterpreterForm.FClassIdentifier := Identifier;
    Value := O2V(JvInterpreterForm);
    Result := True;
    Exit;
  end;

  Result := Result or inherited GetValue(Identifier, Value, Args);
end;

function TJvInterpreterFm.SetValue(const Identifier: string; const Value: Variant;
  var Args: TJvInterpreterArgs): Boolean;
  // Class Fields support begin
var
  JvInterpreterForm: TJvInterpreterForm;

  function SetFormValue(Form: TJvInterpreterForm): Boolean;
  begin
    Result := False;
    with Form.FFieldList do
      if FindVar('', Identifier) <> nil then
        Result := SetValue(Identifier, Value, Args);
  end;
  // Class Fields support end

begin
  if (Args.Obj = nil) and (CurInstance is TJvInterpreterForm) then
  begin
    if (LocalVars <> nil) and (LocalVars.FindVar('', Identifier) <> nil) then
    begin
      Result := LocalVars.SetValue(Identifier, Value, Args);
      Exit;
    end;
    // Class Fields support begin
    { may be TForm field }
    Result := SetFormValue(TJvInterpreterForm(CurInstance));
    if not Result then
    begin
    // Class Fields support end
      { may be TForm method or published property }
      Args.Obj := CurInstance;
      Args.ObjTyp := varObject;
      try
        Result := inherited SetValue(Identifier, Value, Args);
      finally
        Args.Obj := nil;
        Args.ObjTyp := 0;
      end;
    end;
  end
  // Class Fields support begin
  else
  if (Args.Obj <> nil) and (Args.ObjTyp = varObject) and
     (Args.Obj is TJvInterpreterForm) then
  begin
    JvInterpreterForm := TJvInterpreterForm(Args.Obj);
    try
      Args.Obj := nil;
      Result := SetFormValue(JvInterpreterForm);
    finally
      Args.Obj := JvInterpreterForm;
    end;
  end
  // Class Fields support end
  else
    Result := False;
  Result := Result or inherited SetValue(Identifier, Value, Args);
end;

function TJvInterpreterFm.GetUnitSource(const UnitName: string; var Source: string): Boolean;
var
  FN: TFileName;
begin
  if not FInterfaceUses and (UnitSection = usInterface) then
  begin
    Source := 'unit ' + UnitName + '; end.';
    Result := True;
  end
  else
  begin
    Result := inherited GetUnitSource(UnitName, Source);
    if not Result then
    begin
      if ExtractFileExt(UnitName) = '' then
        FN := UnitName + '.pas'
      else
        FN := UnitName;
      Result := FileExists(FN);
      if not Result then
      begin
        FN := FindInPath(ExtractFileName(FN), ExtractFilePath(FFileName));
        Result := FileExists(FN);
      end;
      if Result then
        Source := LoadTextFile(FN)
    end;
  end;
end;

procedure TJvInterpreterFm.Run;
begin
  inherited Run;
end;

function TJvInterpreterFm.RunForm(const FileName: TFileName): TForm;
begin
  Result := MakeForm(FileName);
  Result.Show;
end;

function TJvInterpreterFm.RunFormModal(const FileName: TFileName): TModalResult;
begin
  with MakeForm(FileName) do
  try
    Result := ShowModal;
  finally
    Free;
  end;
end;

function TJvInterpreterFm.RunUnit(const FileName: TFileName): Variant;
var
  UnitName: string;
  S: string;
begin
  FFileName := FileName;
  try
    UnitName := ChangeFileExt(ExtractFileName(FFileName), '');
    if not (GetUnitSource(FFileName, S) or GetUnitSource(UnitName, S)) then
      JvInterpreterErrorN(ieUnitNotFound, -1, UnitName);
    Source := S;
  except
    JvInterpreterErrorN(ieUnitNotFound, -1, FFileName);
  end;
  Run;
end;

procedure TJvInterpreterFm.RunReportPreview(const FileName: string);
begin
  JvInterpreterRunReportPreview2(FileName, Self);
end;

function JvInterpreterRunFormModal(const AFileName: TFileName): TModalResult;
var
  TmpInterpreterFm: TJvInterpreterFm;
begin
  TmpInterpreterFm := TJvInterpreterFm.Create(Application);
  try
    Result := TmpInterpreterFm.RunFormModal(AFileName);
  finally
    TmpInterpreterFm.Free;
  end;
end;

function JvInterpreterRunForm(const AFileName: TFileName): TForm;
var
  TmpInterpreterFm: TJvInterpreterFm;
begin
  TmpInterpreterFm := TJvInterpreterFm.Create(Application);
  begin
    Result := TmpInterpreterFm.RunForm(AFileName);
    (Result as TJvInterpreterForm).FFreeJvInterpreterFm := True;
  end;
end;

function JvInterpreterMakeForm(const AFileName: TFileName): TForm;
var
  TmpInterpreterFm: TJvInterpreterFm;
begin
  TmpInterpreterFm := TJvInterpreterFm.Create(Application);
  begin
    Result := TmpInterpreterFm.MakeForm(AFileName);
    (Result as TJvInterpreterForm).FFreeJvInterpreterFm := True;
  end;
end;

function JvInterpreterRunUnit(const AFileName: TFileName): Variant;
var
  TmpInterpreterFm: TJvInterpreterFm;
begin
  TmpInterpreterFm := TJvInterpreterFm.Create(Application);
  try
    Result := TmpInterpreterFm.RunUnit(AFileName);
  finally
    TmpInterpreterFm.Free;
  end;
end;

{ adapter to self }
{ function JvInterpreterRunFormModal(const FileName: TFileName): TModalResult; }

procedure JvInterpreter_JvInterpreterRunFormModal(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := JvInterpreterRunFormModal(Args.Values[0]);
end;

{ function JvInterpreterRunForm(const FileName: TFileName): TForm; }

procedure JvInterpreter_JvInterpreterRunForm(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(JvInterpreterRunForm(Args.Values[0]));
end;

{ function JvInterpreterMakeForm(const FileName: TFileName): TForm; }

procedure JvInterpreter_JvInterpreterMakeForm(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(JvInterpreterMakeForm(Args.Values[0]));
end;

{ function JvInterpreterRunUnit(const FileName: TFileName): Variant }

procedure JvInterpreter_JvInterpreterRunUnit(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := JvInterpreterRunUnit(Args.Values[0]);
end;

procedure JvInterpreterRunReportPreview(const AFileName: string);
begin
  if not Assigned(JvInterpreterRunReportPreviewProc) then
    raise EJVCLException.CreateRes(@RsENoReportProc);
  JvInterpreterRunReportPreviewProc(AFileName);
end;

procedure JvInterpreterRunReportPreview2(const AFileName: string; JvInterpreterProgram: TJvInterpreterFm);
begin
  if not Assigned(JvInterpreterRunReportPreview2Proc) then
    raise EJVCLException.CreateRes(@RsENoReportProc2);
  JvInterpreterRunReportPreview2Proc(AFileName, JvInterpreterProgram);
end;

procedure RegisterJvInterpreterAdapter(JvInterpreterAdapter: TJvInterpreterAdapter);
const
  cJvInterpreterFm = 'rm_JvInterpreterFm';
begin
  with JvInterpreterAdapter do
  begin
    AddFunction(cJvInterpreterFm, 'JvInterpreterRunFormModal', JvInterpreter_JvInterpreterRunFormModal, 1, [varString],
      varEmpty);
    AddFunction(cJvInterpreterFm, 'JvInterpreterRunForm', JvInterpreter_JvInterpreterRunForm, 1, [varString], varEmpty);
    AddFunction(cJvInterpreterFm, 'JvInterpreterMakeForm', JvInterpreter_JvInterpreterMakeForm, 1, [varString], varEmpty);
    AddFunction(cJvInterpreterFm, 'JvInterpreterRunUnit', JvInterpreter_JvInterpreterRunUnit, 1, [varString], varEmpty);
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.