jvqinterpreterfm.pas

East make Tray Icon in delphi

  S: string;
  UnitName: string;
begin
  FFileName := FileName;
  UnitName := ChangeFileExt(ExtractFileName(FFileName), '');
  if not (GetUnitSource(FFileName, S) or GetUnitSource(UnitName, S)) then
    JvInterpreterErrorN(ieUnitNotFound, -1, UnitName);
  Source := S;
  Compile;
  FForm := F;
  FForm.FUnitName := UnitName;
  LoadForm(FForm);
  Result := FForm;
end;

procedure TJvInterpreterFm.CreateDfmStream(const UnitName: string; var Stream: TStream);
var
  Done: Boolean;
  DfmFile: string;
begin
  Done := False;
  if Assigned(FOnCreateDfmStream) then
    FOnCreateDfmStream(Self, UnitName, Stream, Done);
  if not Done then
  begin
    if Assigned(FOnGetDfmFileName) then
      FOnGetDfmFileName(Self, UnitName, DfmFile, Done);
    if not Done then
      DfmFile := FindInPath(ChangeFileExt(UnitName, '.dfm'),
        ExtractFilePath(FFileName));
    Done := FileExists(DfmFile);
    if Done then
      Stream := TFileStream.Create(DfmFile, fmOpenRead);
  end;

  if not Done then
    JvInterpreterErrorN(ieDfmNotFound, -1, UnitName);
end;

procedure TJvInterpreterFm.FreeDfmStream(Stream: TStream);
begin
  if Assigned(FOnFreeDfmStream) then
    FOnFreeDfmStream(Self, Stream)
  else
    Stream.Free;
end;

procedure TJvInterpreterFm.LoadForm(AForm: TJvInterpreterForm);
var
  Stream: TStream;
begin
  FForm := AForm;
  Form.FJvInterpreterFm := Self;
  CreateDfmStream(FForm.FUnitName, Stream);
  try
    JvInterpreterReadComponentRes(Stream, Form);
  finally
    FreeDfmStream(Stream);
  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(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;
      { 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 := THackAdapter(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 := THackAdapter(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(Identifier: string; const Value: Variant;
  var Args: TJvInterpreterArgs): Boolean;
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;
    { 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
  else
    Result := False;
  Result := Result or inherited SetValue(Identifier, Value, Args);
end;

function TJvInterpreterFm.GetUnitSource(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
        UnitName := UnitName + '.pas';
      if FileExists(UnitName) then
        FN := UnitName
      else
        FN := FindInPath(ExtractFileName(UnitName), ExtractFilePath(FFileName));
      Result := FileExists(FN);
      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 FileName: TFileName): TModalResult;
begin
  with TJvInterpreterFm.Create(Application) do
  try
    Result := RunFormModal(FileName);
  finally
    Free;
  end;
end;

function JvInterpreterRunForm(const FileName: TFileName): TForm;
begin
  with TJvInterpreterFm.Create(Application) do
  begin
    Result := RunForm(FileName);
    (Result as TJvInterpreterForm).FFreeJvInterpreterFm := True;
  end;
end;

function JvInterpreterMakeForm(const FileName: TFileName): TForm;
begin
  with TJvInterpreterFm.Create(Application) do
  begin
    Result := MakeForm(FileName);
    (Result as TJvInterpreterForm).FFreeJvInterpreterFm := True;
  end;
end;

function JvInterpreterRunUnit(const FileName: TFileName): Variant;
begin
  with TJvInterpreterFm.Create(Application) do
  try
    Result := RunUnit(FileName);
  finally
    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 FileName: string);
begin
  if not Assigned(JvInterpreterRunReportPreviewProc) then
    raise EJVCLException.Create(RsENoReportProc);
  JvInterpreterRunReportPreviewProc(FileName);
end;

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

procedure RegisterJvInterpreterAdapter(JvInterpreterAdapter: TJvInterpreterAdapter);
const
  cJvInterpreterFm = '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;

end.