jvcldata.pas

East make Tray Icon in delphi

begin
  Result := JVCLDir + '\packages';
end;

function TJVCLData.GetJVCLPackagesXmlDir: string;
begin
  Result := JVCLPackagesDir + '\xml';
end;

function TJVCLData.GetTargetConfig(Index: Integer): TTargetConfig;
begin
  Result := FConfigs[Index];
end;

procedure TJVCLData.Init;
var
  i: Integer;
  S: string;
begin
 // dxgettext detection
  S := ReadRegString(HKEY_CLASSES_ROOT, PChar(sDxgettextRegKey), '');
  FIsDxgettextInstalled := S <> '';
  if FIsDxgettextInstalled then
  begin
    if S[1] = '"' then
    begin
      Delete(S, 1, 1);
      i := 1;
      while (i <= Length(S)) and (S[i] <> '"') do
        Inc(i);
      SetLength(S, i - 1);
    end;
    FDxgettextDir := ExtractFileDir(S);
    if not FileExists(FDxgettextDir + '\msgfmt.exe') then
    begin
      FIsDxgettextInstalled := False;
      FDxgettextDir := '';
    end;
  end;
end;

function TJVCLData.IsJVCLInstalledAnywhere(MinVersion: Integer): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to Targets.Count - 1 do
    if TargetConfig[i].InstalledJVCLVersion >= MinVersion then
    begin
      Result := True;
      Break;
    end;
end;

function TJVCLData.JvclIncFilename: string;
begin
  Result := Format(sJvclIncFile, [JVCLDir]);
end;

procedure TJVCLData.SaveTargetConfigs;
var
  i: Integer;
begin
  for i := 0 to Targets.Count - 1 do
    TargetConfig[i].Save;
end;

procedure TJVCLData.SetBuild(Value: Integer);
var
  i: Integer;
begin
  for i := 0 to Targets.Count - 1 do
    TargetConfig[I].Build := Value <> 0;
end;

procedure TJVCLData.SetCleanPalettes(Value: Integer);
var
  i: Integer;
begin
  for i := 0 to Targets.Count - 1 do
    TargetConfig[I].CleanPalettes := Value <> 0;
end;

procedure TJVCLData.SetCompileOnly(const Value: Integer);
var
  i: Integer;
begin
  for i := 0 to Targets.Count - 1 do
    TargetConfig[i].CompileOnly := Value <> 0;
end;

procedure TJVCLData.SetDeveloperInstall(Value: Integer);
var
  i: Integer;
begin
  for i := 0 to Targets.Count - 1 do
    TargetConfig[i].DeveloperInstall := Value <> 0;
end;

procedure TJVCLData.SetGenerateMapFiles(const Value: Integer);
var
  i: Integer;
begin
  for i := 0 to Targets.Count - 1 do
    TargetConfig[i].GenerateMapFiles := Value <> 0;
end;

procedure TJVCLData.SetDebugUnits(const Value: Integer);
var
  i: Integer;
begin
  for i := 0 to Targets.Count - 1 do
    TargetConfig[i].DebugUnits := Value <> 0;
end;

{ TTargetConfig }

constructor TTargetConfig.Create(AOwner: TJVCLData; ATarget: TCompileTarget);
begin
  inherited Create(nil);
  FOwner := AOwner;
  FTarget := ATarget;

  FInstallMode := [pkVcl];
  FDefaultHppDir := Format(sBCBIncludeDir, [Target.RootDir]);
  FHppDir := FDefaultHppDir;
  FCleanPalettes := True;
  FDeveloperInstall := False;
  FAutoDependencies := True;
  FBplDir := Target.BplDir;
  FDcpDir := Target.DcpDir;
  FDefaultJCLDir := CmdOptions.JclPath;
  FJCLDir := FDefaultJCLDir;
  Init;
  FInstallJVCL := CanInstallJVCL;

  FFrameworks := TJVCLFrameworks.Create(Self);
  FJVCLConfig := TJVCLConfig.Create;
  Load;
end;

destructor TTargetConfig.Destroy;
begin
  FFrameworks.Free;
  inherited Destroy;
end;

procedure TTargetConfig.Init;
  // Memory allocations must go to the constructor because Init could be called
  // more the once.

  function FindJCL(List: TStrings): string;
  var
    i, jclIndex, BrowseIndex, ps: Integer;
    Dir: string;
    Identify: Boolean;
  begin
    Result := '';
    for i := 0 to List.Count - 1 do
    begin
      Dir := Target.ExpandDirMacros(List[i]);

      for BrowseIndex := 0 to High(JCLBrowsePaths) do
      begin
        // obtain the assumed JCL root directory
        Identify := False;
        if EndsWith(JCLBrowsePaths[BrowseIndex], '\', False) then
        begin
          ps := Pos(LowerCase(Path(JCLBrowsePaths[BrowseIndex])), LowerCase(Dir));
          if ps > 0 then
          begin
            Delete(Dir, ps, MaxInt);
            Identify := True;
          end;
        end
        else
        if EndsWith(Dir, Path(JCLBrowsePaths[BrowseIndex]), True) then
        begin
          Dir := ExtractFileDir(ExtractFileDir(Dir));
          Identify := True;
        end;

        if Identify then
        begin
          FMissingJCL := False;
          // Check if the assumed JCL directory contains the files that identify
          // the JCL.
          for jclIndex := 0 to High(JCLIdentify) do
            if not FileExists(Dir + Path(JCLIdentify[jclIndex])) then
            begin
              FMissingJCL := True;
              Break;
            end;

          if not FMissingJCL then
          begin
            Result := Dir;
            Break;
          end;
        end;
      end;

      if Result <> '' then
        Break;
    end;
  end;

var
  S: string;
begin
  FInstallMode := [];
  FCompiledJCL := False;
  FOutdatedJCL := False;

  // identify JVCL version
  FInstalledJVCLVersion := 0;
  if Target.FindPackageEx('JvPack1') <> nil then
    FInstalledJVCLVersion := 1
  else if Target.FindPackageEx('jvcl2') <> nil then
    FInstalledJVCLVersion := 2
  else if Target.FindPackageEx('JvCore') <> nil then // VCL
  begin
    Include(FInstallMode, pkVCL);
    FInstalledJVCLVersion := 3;
  end;
  if Target.FindPackageEx('JvQCore') <> nil then // CLX
  begin
    Include(FInstallMode, pkCLX);
    FInstalledJVCLVersion := 3;
  end;
  if FInstallMode = [] then // if no VCL and no CLX that it is CLX
    Include(FInstallMode, pkVCL);

  // identify JCL version
  FMissingJCL := True;
  if FJCLDir = '' then
  begin
    SetJCLDir(FindJCL(Target.BrowsingPaths));
    if FJCLDir = '' then
      SetJCLDir(FindJCL(Target.SearchPaths));
  end;

  // Check for the JCL bpl file, that's the most reliable way to find
  // if the JCL is actually installed because users may not have put the
  // JCL directory in their browsing and/or search paths, especially
  // BCB users.
  if (Target.IsBCB and
      FileExists(Format('%s\CJcl%d0.bpl', [BplDir, Target.Version]))) or
     (not Target.IsBCB and
      FileExists(Format('%s\DJcl%d0.bpl', [BplDir, Target.Version]))) then
    FMissingJCL := False;


  // are C/DJcl.dcp and C/DJclVcl.dcp available
  if Target.Version = 5 then S := '50' else S := '';

  if (Target.IsBCB and
      FileExists(Format('%s\CJcl%s.dcp', [BplDir, S])) and
      FileExists(Format('%s\CJclVcl%s.dcp', [BplDir, S])))
     or
     (not Target.IsBCB and
      FileExists(Format('%s\DJcl%s.dcp', [BplDir, S])) and
      FileExists(Format('%s\DJclVcl%s.dcp', [BplDir, S])))
     then
  begin
    FCompiledJCL := True;

    { (ahuser) Removed because some files require JCL source }
    // (obones) More exactly, this is required for the compilation
    // of the JCL DCP file for BCB targets.

    {if FJCLDir = '' then // replace JCL directory
      FJCLDir := BplDir;

    if Target.IsBCB then
      FMissingJCL := False
    else
    begin
      // Delphi requires .bpl files
      if FileExists(Format('%s\DJcl%s.bpl', [BplDir, S])) and
         FileExists(Format('%s\DJclVcl%s.bpl', [BplDir, S])) then
        FMissingJCL := False;
    end;}
  end;
  FDefaultJCLDir := JCLDir;
end;

function TTargetConfig.CanInstallJVCL: Boolean;
begin
  Result := IsUpToDate and not MissingJCL;
end;

function TTargetConfig.IsUpToDate: Boolean;
begin
{
  Result := False;
  if Target.IsBCB then
  begin
    case Target.Version of
      5: Result := Target.LatestUpdate >= 1;
      6: Result := Target.LatestUpdate >= 1;
    end;
  end
  else
  begin
    case Target.Version of
      5: Result := Target.LatestUpdate >= 1;
      6: Result := Target.LatestUpdate >= 2;
      7: Result := True;
      8: Result := False; // not supported
    end;
  end;}

  // The IDE is up to date because the JCL Installer garantees this for us.
  // The JVCL requires an installed JCL, so this is no problem.
  Result := True;
end;

function TTargetConfig.IsOldVersionInstalled: Boolean;
begin
  Result := InstalledJVCLVersion < 3;
end;

/// <summary>
/// GetBpgFilename returns the file name of the Borland Package Group (.bpg)
/// file that is used for this target.
/// </summary>
function TTargetConfig.GetBpgFilename(Personal: Boolean; Kind: TPackageGroupKind): string;
var
  Pers, Clx: string;
begin
  if Personal then
  begin
    if Target.Version <= 5 then
      Pers := 'Std'  // do not localize
    else
      Pers := 'Per'; // do not localize
  end;

  if Kind = pkClx then
    Clx := 'Clx';

  if Target.IsBDS then
    Result := Owner.JVCLPackagesDir + Format('\%s%d%s%s Packages.bdsgroup', // do not localize
      [TargetTypes[Target.IsBCB], Target.Version, Pers, Clx])
  else
    Result := Owner.JVCLPackagesDir + Format('\%s%d%s%s Packages.bpg', // do not localize
      [TargetTypes[Target.IsBCB], Target.Version, Pers, Clx]);
end;

procedure TTargetConfig.SavePackagesSettings(ProjectGroup: TProjectGroup);
var
  i: Integer;
  Ini: TMemIniFile;
  IniFileName: string;
begin
  // save to ini
  IniFileName := ChangeFileExt(ParamStr(0), '.ini'); // do not localize
  FileSetReadOnly(IniFileName, False);
  Ini := TMemIniFile.Create(IniFileName);
  try
    Ini.EraseSection(ProjectGroup.BpgName);
    for i := 0 to ProjectGroup.Count - 1 do
      with ProjectGroup.Packages[i] do
        if not Info.IsDesign then
          Ini.WriteBool(ProjectGroup.BpgName, Info.Name, Compile);
    Ini.UpdateFile;
  finally
    Ini.Free;
  end;
end;

procedure TTargetConfig.ResetPackagesSettings(ProjectGroup: TProjectGroup);
var
  PkgIndex, i: Integer;
  BplName: string;
  IsInstalled: Boolean;
  Ini: TMemIniFile;
begin
  // Set Compile to False for each package.
  for PkgIndex := 0 to ProjectGroup.Count - 1 do
    ProjectGroup.Packages[PkgIndex].Compile := False;

  // read from ini
  Ini := TMemIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')); // do not localize
  try
    for i := 0 to ProjectGroup.Count - 1 do
      if not ProjectGroup.Packages[i].Info.IsDesign then
        ProjectGroup.Packages[i].Compile := Ini.ReadBool(ProjectGroup.BpgName, ProjectGroup.Packages[i].Info.Name, False);
  finally
    Ini.Free;
  end;

  IsInstalled := False;
  // Set Install to the registry setting. The dependency check will activate the
  // required (runtime) packages.
  for PkgIndex := 0 to ProjectGroup.Count - 1 do
  begin
    BplName := ProjectGroup.Packages[PkgIndex].Info.BplName;

    for i := 0 to Target.KnownPackages.Count - 1 do
      if CompareText(Target.KnownPackages[i].Name, BplName) = 0 then
      begin
        ProjectGroup.Packages[PkgIndex].Install := True;
        IsInstalled := True;
        Break;
      end;

    for i := 0 to Target.DisabledPackages.Count - 1 do
      if CompareText(Target.DisabledPackages[i].Name, BplName) = 0 then
      begin
        ProjectGroup.Packages[PkgIndex].Install := True;
        IsInstalled := True;
        Break;
      end;
  end;
  if not IsInstalled then
  begin
    // No package of the project group is installed, so it must be a new
    // installation.
    for PkgIndex := 0 to ProjectGroup.Count - 1 do
      ProjectGroup.Packages[PkgIndex].Install := True;
  end;
end;

function TTargetConfig.GetTargetSymbol: string;
var
  Pers: string;
begin
  if Target.IsPersonal {or (Kind = pkPersonal)} then
  begin
    if Target.Version = 5 then
      Pers := 's' // do not localize
    else
      Pers := 'p'; // do not localize
  end;
  Result := Format('%s%d%s', [TargetTypes[Target.IsBCB], Target.Version, Pers]); // do not localize
end;

function TTargetConfig.GetUnitOutDir: string;
begin
  Result := GetJVCLDir + Format('\lib\%s%d', [TargetTypes[Target.IsBCB], Target.Version]); // do not localize
end;

procedure TTargetConfig.SetInstallMode(const Value: TInstallMode);
begin
  if Value <> FInstallMode then
  begin
    if Value = [] then
      FInstallMode := [pkVcl]
    else
      FInstallMode := Value;
  end;
end;

function TTargetConfig.GetInstance: TObject;
begin
  Result := Self;
end;

function TTargetConfig.GetTarget: TCompileTarget;
begin
  Result := FTarget;
end;

function TTargetConfig.GetJVCLPackagesXmlDir: string;
begin
  Result := Owner.JVCLPackagesXmlDir;
end;

function TTargetConfig.GetJVCLDir: string;
begin
  Result := Owner.JVCLDir;
end;

function TTargetConfig.GetJVCLPackagesDir: string;
begin
  Result := Owner.JVCLPackagesDir;
end;

function TTargetConfig.GetJCLDir: string;
begin
  Result := FJCLDir;