jvcldata.pas

East make Tray Icon in delphi

end;

function TTargetConfig.GetHppDir: string;
begin
  Result := FHppDir;
end;

function TTargetConfig.GetDebugUnits: Boolean;
begin
  Result := FDebugUnits;
end;

function TTargetConfig.GetAutoDependencies: Boolean;
begin
  Result := FAutoDependencies and not Build;
end;

function TTargetConfig.GetBuild: Boolean;
begin
  Result := FBuild;
end;

function TTargetConfig.GetCompileOnly: Boolean;
begin
  Result := FCompileOnly;
end;

function TTargetConfig.GetGenerateMapFiles: Boolean;
begin
  Result := FGenerateMapFiles;
end;

function TTargetConfig.GetBplDir: string;
begin
  Result := FBplDir;
end;

function TTargetConfig.GetDcpDir: string;
begin
  Result := FDcpDir;
end;

function TTargetConfig.GetFrameworkCount: Integer;
var
  Kind: TPackageGroupKind;
begin
  Result := 0;
  for Kind := pkFirst to pkLast do
  begin
    if Frameworks.Items[Target.IsPersonal, Kind] <> nil then
      Inc(Result);
  end;
end;

function TTargetConfig.GetDeveloperInstall: Boolean;
begin
  Result := FDeveloperInstall;
end;

function TTargetConfig.GetDxgettextDir: string;
begin
  Result := Owner.DxgettextDir;
  if Result <> '' then
    if Target.Version = 5 then
      Result := Result + '\delphi5'; // do not localize
end;

procedure TTargetConfig.SetJCLDir(const Value: string);
var
  i: Integer;
begin
  if Value <> FJCLDir then
  begin
    FJCLDir := Value;

    // Check if the JCL is outdated
    FOutdatedJCL := False;
    for i := 0 to High(JCLIdentifyOutdated) do
    begin
      if JCLIdentifyOutdated[i] = '' then
        Continue;
      if JCLIdentifyOutdated[i][1] = '+' then
      begin
        if not FileExists(FJCLDir + Path(Copy(JCLIdentifyOutdated[i], 2, MaxInt))) then
        begin
          FOutdatedJCL := True;
          Break;
        end;
      end
      else if JCLIdentifyOutdated[i][1] = '-' then
      begin
        if FileExists(FJCLDir + Path(Copy(JCLIdentifyOutdated[i], 2, MaxInt))) then
        begin
          FOutdatedJCL := True;
          Break;
        end;
      end;
    end;
  end;
end;

procedure TTargetConfig.Save;
var
  Kind: TPackageGroupKind;
  Ini: TMemIniFile;
  IniFileName: string;
begin
  if JVCLConfig.Modified then
  begin
    FileSetReadOnly(JVCLConfig.Filename, False);
    JVCLConfig.SaveToFile(JVCLConfig.Filename);
  end;

  for Kind := pkFirst to pkLast do
  begin
    if Frameworks.Items[False, Kind] <> nil then
      SavePackagesSettings(Frameworks.Items[False, Kind]);
    if Frameworks.Items[True, Kind] <> nil then
      SavePackagesSettings(Frameworks.Items[True, Kind]);
  end;

  IniFileName := ChangeFileExt(ParamStr(0), '.ini'); // do not localize
  FileSetReadOnly(IniFileName, False);
  Ini := TMemIniFile.Create(IniFileName);
  try
    if JCLDir = FDefaultJCLDir then
      Ini.DeleteKey(Target.DisplayName, 'JCLDir') // do not localize
    else
      Ini.WriteString(Target.DisplayName, 'JCLDir', JCLDir); // do not localize

    if not Target.IsBCB or (HppDir = FDefaultHppDir) then
      Ini.DeleteKey(Target.DisplayName, 'HPPDir') // do not localize
    else
      Ini.WriteString(Target.DisplayName, 'HPPDir', HppDir); // do not localize

    if BplDir = Target.BplDir then
      Ini.DeleteKey(Target.DisplayName, 'BPLDir') // do not localize
    else
      Ini.WriteString(Target.DisplayName, 'BPLDir', BplDir); // do not localize

    if DcpDir = Target.DcpDir then
      Ini.DeleteKey(Target.DisplayName, 'DCPDir') // do not localize
    else
      Ini.WriteString(Target.DisplayName, 'DCPDir', DcpDir); // do not localize

    Ini.WriteBool(Target.DisplayName, 'DeveloperInstall', DeveloperInstall); // do not localize
    Ini.WriteBool(Target.DisplayName, 'CleanPalettes', CleanPalettes); // do not localize
    for Kind := pkFirst to pkLast do
      Ini.WriteBool(Target.DisplayName, 'InstallMode_' + IntToStr(Integer(Kind)), Kind in InstallMode); // do not localize
    Ini.WriteBool(Target.DisplayName, 'AutoDependencies', AutoDependencies); // do not localize
    Ini.WriteBool(Target.DisplayName, 'GenerateMapFiles', GenerateMapFiles); // do not localize
    Ini.WriteBool(Target.DisplayName, 'DebugUnits', DebugUnits); // do not localize

    Ini.UpdateFile;
  finally
    Ini.Free;
  end;
end;

procedure TTargetConfig.Load;
var
  Kind: TPackageGroupKind;
  Ini: TMemIniFile;
  Mode: TInstallMode;
  Filename: string;
begin
  for Kind := pkFirst to pkLast do
  begin
    if Frameworks.Items[False, Kind] <> nil then
      ResetPackagesSettings(Frameworks.Items[False, Kind]);
    if Frameworks.Items[True, Kind] <> nil then
      ResetPackagesSettings(Frameworks.Items[True, Kind]);
  end;

  Ini := TMemIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  try
    if JCLDir = '' then
      JCLDir := ExcludeTrailingPathDelimiter(Ini.ReadString(Target.DisplayName, 'JCLDir', JCLDir)); // do not localize
    HppDir := ExcludeTrailingPathDelimiter(Ini.ReadString(Target.DisplayName, 'HPPDir', HppDir));   // do not localize
    BplDir := ExcludeTrailingPathDelimiter(Ini.ReadString(Target.DisplayName, 'BPLDir', BplDir));   // do not localize
    DcpDir := ExcludeTrailingPathDelimiter(Ini.ReadString(Target.DisplayName, 'DCPDir', DcpDir));   // do not localize
    DeveloperInstall := Ini.ReadBool(Target.DisplayName, 'DeveloperInstall', DeveloperInstall); // do not localize
    CleanPalettes := Ini.ReadBool(Target.DisplayName, 'CleanPalettes', CleanPalettes); // do not localize
    GenerateMapFiles := Ini.ReadBool(Target.DisplayName, 'GenerateMapFiles', GenerateMapFiles); // do not localize
    DebugUnits := Ini.ReadBool(Target.DisplayName, 'DebugUnits', DebugUnits); // do not localize
    Mode := [];
    for Kind := pkFirst to pkLast do
      if Ini.ReadBool(Target.DisplayName, 'InstallMode_' + IntToStr(Integer(Kind)), Kind in InstallMode) then // do not localize
        Include(Mode, Kind);
    InstallMode := Mode;
    //AutoDependencies := Ini.ReadBool(Target.DisplayName, 'AutoDependencies', AutoDependencies);

    // fix "Delphi\\Projects" bug
    HppDir := FixBackslashBackslash(HppDir);
    BplDir := FixBackslashBackslash(BplDir);
    DcpDir := FixBackslashBackslash(DcpDir);

    // Load jvcl%t.inc. Or the jvclbase.inc when no jvcl%t.inc exists
    Filename := GetJVCLDir + '\common\' + Format('jvcl%s%d.inc', [LowerCase(TargetTypes[Target.IsBCB]), Target.Version]);
    if not FileExists(Filename) then
    begin
      JVCLConfig.LoadFromFile(GetJVCLDir + '\common\jvclbase.inc');
      JVCLConfig.Filename := Filename;
      JVCLConfig.Modified := True; // must be stored
    end
    else
      JVCLConfig.LoadFromFile(Filename);

    // set (hidden) personal edition configuration
    JVCLConfig.Enabled['DelphiPersonalEdition'] := Target.IsPersonal;

    UpdateOptions;
  finally
    Ini.Free;
  end;
end;

procedure TTargetConfig.EnableOption(const Name: string; Enable: Boolean);
begin
  if Name <> '' then
    JVCLConfig.Enabled[Name] := Enable and JVCLConfig.Enabled[Name];
end;

function TTargetConfig.RegisterProjectGroupToIDE(ProjectGroup: TProjectGroup): Boolean;
var
  PackageIndex, i: Integer;
  KnownPackages, DisabledPackages: TDelphiPackageList;
  Target: TCompileTarget;
begin
  Target := ProjectGroup.Target;
  KnownPackages := Target.KnownPackages;
  DisabledPackages := Target.DisabledPackages;

  // remove JVCL packages
  for i := DisabledPackages.Count - 1 downto 0 do
    if StartsWith(DisabledPackages.Items[i].Name, 'Jv', True) then
      DisabledPackages.Delete(i);

  for i := KnownPackages.Count - 1 downto 0 do
    if StartsWith(KnownPackages.Items[i].Name, 'Jv', True) then
      KnownPackages.Delete(i);


  for PackageIndex := 0 to ProjectGroup.Count - 1 do
  begin
    if ProjectGroup.Packages[PackageIndex].Install and
       ProjectGroup.Packages[PackageIndex].Info.IsDesign then
    begin
      KnownPackages.Add(
        ProjectGroup.TargetConfig.BplDir + '\' + ProjectGroup.Packages[PackageIndex].TargetName, // do not localize
        ProjectGroup.Packages[PackageIndex].Info.Description
      );
    end;
  end;

  ProjectGroup.Target.SavePaths;
  ProjectGroup.Target.SavePackagesLists;
  Result := True;
end;

function TTargetConfig.RegisterToIDE: Boolean;
var
  Kind: TPackageGroupKind;
  i: Integer;
  AllPackages, PackageGroup: TProjectGroup;
begin
  if InstalledJVCLVersion < 3 then
    DeinstallJVCL(nil, nil);

  // remove old
  AddPaths(Target.BrowsingPaths, False, Owner.JVCLDir,
    ['common', 'run', 'qcommon', 'qrun']); // do not localize
  AddPaths(Target.SearchPaths, False, Owner.JVCLDir,
    ['common', 'run', 'qcommon', 'qrun']); // do not localize
  AddPaths(Target.DebugDcuPaths, {Add:=}False, Owner.JVCLDir,
    [Target.InsertDirMacros(UnitOutDir + '\debug'), UnitOutDir + '\debug']); // do not localize


  // common
  AddPaths(Target.BrowsingPaths, True, Owner.JVCLDir,
    ['common']); // do not localize
  AddPaths(Target.SearchPaths, True, Owner.JVCLDir,
    ['common', Target.InsertDirMacros(UnitOutDir)]); // do not localize
  if DebugUnits and not DeveloperInstall then
    AddPaths(Target.DebugDcuPaths, True, Owner.JVCLDir,
      [Target.InsertDirMacros(UnitOutDir + '\debug')]); // do not localize

  // add
  if pkVCL in InstallMode then
  begin
    AddPaths(Target.BrowsingPaths, True, Owner.JVCLDir,
      ['run']); // do not localize
    AddPaths(Target.SearchPaths, {Add:=}DeveloperInstall, Owner.JVCLDir,
      ['run']); // do not localize
  end;
  if pkCLX in InstallMode then
  begin
    AddPaths(Target.BrowsingPaths, True, Owner.JVCLDir,
      ['qcommon', 'qrun']); // do not localize
    AddPaths(Target.SearchPaths, {Add:=}DeveloperInstall, Owner.JVCLDir,
      ['qcommon', 'qrun']); // do not localize
  end;

  AllPackages := TProjectGroup.Create(Self, '');
  try
    for Kind := pkFirst to pkLast do
    begin
      if Kind in InstallMode then
      begin
        PackageGroup := Frameworks.Items[Target.IsPersonal, Kind];
        if PackageGroup <> nil then
        begin
          for i := 0 to PackageGroup.Count - 1 do
            if PackageGroup.Packages[i].Install then
              AllPackages.AddPackage(PackageGroup.Packages[i]);
        end;
      end;
    end;
    Result := RegisterProjectGroupToIDE(AllPackages);
  finally
    AllPackages.Free;
  end;
end;

procedure TTargetConfig.DoCleanPalette(reg: TRegistry; const Name: string;
  RemoveEmptyPalettes: Boolean);
var
  Entries, S: string;
  List: TStrings;
  i, ps: Integer;
begin
  Entries := reg.ReadString(Name);
  List := TStringList.Create;
  try
    ps := 0;
    for i := 1 to Length(Entries) do
      if Entries[i] = ';' then // do not localize
      begin
        List.Add(SubStr(Entries, ps + 1, i - 1));
        ps := i;
      end;
    if ps < Length(Entries) then
      List.Add(SubStr(Entries, ps + 1, Length(Entries)));

    for i := List.Count - 1 downto 0 do
    begin
      ps := Pos('.', List[i]); // for Delphi 6, 7 and BCB 6
      if Copy(List[i], ps + 1, 3) = RsComponentPalettePrefix then
        List.Delete(i);
    end;

    S := '';
    for i := 0 to List.Count - 1 do
      S := S + List[i] + ';'; // do not localize
    // last char is ';'

    if (S <> '') or (not RemoveEmptyPalettes) then
    begin
      if S <> Entries then
        reg.WriteString(Name, S)
    end
    else
      reg.DeleteValue(Name);

  finally
    List.Free;
  end;
end;

procedure TTargetConfig.CleanJVCLPalette(RemoveEmptyPalettes: Boolean);
var
  i: Integer;
  Reg: TRegistry;
  List: TStrings;
begin
  reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey(Target.RegistryKey + '\Palette', False) then // do not localize
    begin
      List := TStringList.Create;
      try
        Reg.GetValueNames(List);
        for i := 0 to List.Count - 1 do
          DoCleanPalette(reg, List[i], RemoveEmptyPalettes);
      finally
        List.Free;
      end;
    end;
  finally
    Reg.Free;
  end;
end;

procedure TTargetConfig.DeinstallJVCL(Progress: TDeinstallProgressEvent;
  DeleteFiles: TDeleteFilesEvent);

  procedure DoProgress(const Text: string; Position, Max: Integer);
  begin
    if Assigned(Progress) then
      Progress(Self, Text, Position, Max);
  end;

var
  MaxSteps: Integer;
  i: Integer;
  Ini: TMemIniFile;
  Kind: TPackageGroupKind;
begin
  MaxSteps := 4;
  if not Assigned(DeleteFiles) then
    Dec(MaxSteps);

{**}DoProgress(RsCleaningPalette, 0, MaxSteps);
  CleanJVCLPalette(True);

{**}DoProgress(RsCleaningPathLists, 1, MaxSteps);

  // remove JVCL 1 and 2 directories
  for i := Target.BrowsingPaths.Count - 1 downto 0 do
    if Pos('\jvpack\', AnsiLowerCase(Target.BrowsingPaths[i])) <> 0 then // do not localize
      Target.BrowsingPaths.Delete(i);

  for i := Target.SearchPaths.Count - 1 downto 0 do
    if Pos('\jvpack\', AnsiLowerCase(Target.SearchPaths[i])) <> 0 then // do not localize
      Target.SearchPaths.Delete(i);


  // remove JVCL 3 directories
  AddPaths(Target.BrowsingPaths, {Add:=}False, Owner.JVCLDir,
    ['common', 'design', 'run', 'qcommon', 'qdesign', 'qrun']); // do not localize
  AddPaths(Target.SearchPaths, {Add:=}False, Owner.JVCLDir,
    ['common', 'design', 'run', 'qcommon', 'qdesign', 'qrun', // do not localize
    Target.InsertDirMacros(UnitOutDir), UnitOutDir]);
  AddPaths(Target.DebugDcuPaths, {Add:=}False, Owner.JVCLDir,
    [Target.InsertDirMacros(UnitOutDir + '\debug'), UnitOutDir + '\debug']); // do not localize
  Target.SavePaths;

{**}DoProgress(RsUnregisteringPackages, 2, MaxSteps);
  // remove JVCL packages
  with Target do
  begin
    for i := DisabledPackages.Count - 1 downto 0 do
      if StartsWith(DisabledPackages.Items[i].Name, 'Jv', True) then // do not localize
        DisabledPackages.Delete(i);

    for i := KnownPackages.Count - 1 downto 0 do
      if StartsWith(KnownPackages.Items[i].Name, 'Jv', True) then // do not localize
        KnownPackages.Delete(i);
  end;
  Target.SavePackagesLists;

  // clean ini file
  Ini := TMemIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')); // do not localize
  try
    Ini.EraseSection(Target.DisplayName);
    for Kind := pkFirst to pkLast do
    begin
      if Frameworks.Items[False, Kind] <> nil then
        Ini.EraseSection(Frameworks.Items[False, Kind].BpgName);
      if Frameworks.Items[True, Kind] <> nil then
        Ini.EraseSection(Frameworks.Items[True, Kind].BpgName);
    end;
    Ini.UpdateFile;
  finally
    Ini.Free;
  end;

  if Assigned(DeleteFiles) then
  begin
{**}DoProgress(RsDeletingFiles, 3, MaxSteps);
    DeleteFiles(Self);
  end;

{**}DoProgress(RsComplete, MaxSteps, MaxSteps);
end;

{$I InstalledPackages.inc}

end.