jvqappstorage.pas

East make Tray Icon in delphi

  FRoot := OptimizePaths([Value]);
end;

function TJvCustomAppStorage.GetCurrentPath: string;
begin
  Result := GetAbsPath('');
end;

function TJvCustomAppStorage.GetAbsPath(const Path: string): string;
begin
  Result := GetRoot + PathDelim + OptimizePaths([GetPath, Path]);
  while (Result <> '') and (Result[1] = PathDelim) do
    Delete(Result, 1, 1);
end;

procedure TJvCustomAppStorage.ReadStringListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
begin
  if List is TStrings then
    TStrings(List).Add(Sender.ReadString(ConcatPaths([Path, ItemName + IntToStr(Index)])));
end;

procedure TJvCustomAppStorage.WriteStringListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
begin
  if List is TStrings then
    Sender.WriteString(ConcatPaths([Path, ItemName + IntToStr(Index)]), TStrings(List)[Index]);
end;

procedure TJvCustomAppStorage.DeleteStringListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const First, Last: Integer; const ItemName: string);
var
  I: Integer;
begin
  if List is TStrings then
    for I := First to Last do
      Sender.DeleteValue(ConcatPaths([Path, ItemName + IntToStr(I)]));
end;

function TJvCustomAppStorage.DefaultObjectListItemCreateEvent(Sender: TJvCustomAppStorage; const Path: string; Index: Integer): TPersistent;
var
  NewClassName: string;
begin
  NewClassName := Sender.ReadString(ConcatPaths([Path, cClassName]));
  Result := TPersistent(GetClass(NewClassName).Create);
end;

procedure TJvCustomAppStorage.ReadObjectListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
var
  NewItem: TPersistent;
  NewPath: string;
begin
  if List is TList then
  begin
    try
      NewPath := ConcatPaths([Path, ItemName + IntToStr(Index)]);
      NewItem := FCurrentInstanceCreateEvent(Sender, NewPath, Index);
      TList(List).Add(NewItem);
      Sender.ReadPersistent(NewPath, NewItem);
    except
    end;
  end;
end;

procedure TJvCustomAppStorage.WriteObjectListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
begin
  if List is TList then
    if Assigned(TList(List)[Index]) then
      Sender.WritePersistent(ConcatPaths([Path, ItemName + IntToStr(Index)]), TPersistent(TList(List)[Index]));
end;

procedure TJvCustomAppStorage.DeleteObjectListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const First, Last: Integer; const ItemName: string);
var
  I: Integer;
begin
  if List is TList then
    for I := First to Last do
      Sender.DeleteValue(ConcatPaths([Path, ItemName + IntToStr(I)]));
end;

procedure TJvCustomAppStorage.ReadStringObjectListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
var
  NewItem: TPersistent;
  NewPath: string;
  NewName: string;
begin
  if List is TStrings then
  begin
    try
      NewPath := ConcatPaths([Path, ItemName + IntToStr(Index)]);
      NewItem := FCurrentInstanceCreateEvent(Sender, ConcatPaths([NewPath, cObject]), Index);
      NewName := Sender.ReadString(ConcatPaths([NewPath, cItemName]));
      TStrings(List).AddObject(NewName, NewItem);
      if NewItem is TJvCustomPropertyStore then
        Sender.ReadPersistent(ConcatPaths ([NewPath, cObject]), NewItem,
          True, True, TJvCustomPropertyStore(NewItem).CombinedIgnoreProperties)
      else
        Sender.ReadPersistent(ConcatPaths([NewPath, cObject]), NewItem);
    except
    end;
  end;
end;

procedure TJvCustomAppStorage.WriteStringObjectListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
var
  Obj: TObject;
begin
  if List is TStrings then
  begin
    Sender.WriteString(ConcatPaths([Path, ItemName + IntToStr(Index), cItemName]), TStrings(List)[Index]);
    Obj := TStrings(List).Objects[Index];
    if Assigned(Obj) then
      if (Obj is TJvCustomPropertyStore) then
        if not TJvCustomPropertyStore(Obj).ReadOnly then
          Sender.WritePersistent(ConcatPaths([Path, ItemName + IntToStr(Index), cObject]), TPersistent(Obj),
              True, TJvCustomPropertyStore(Obj).CombinedIgnoreProperties)
        else
      else
        Sender.WritePersistent(ConcatPaths([Path, ItemName + IntToStr(Index), cObject]), TPersistent(Obj));
  end;
end;

procedure TJvCustomAppStorage.DeleteStringObjectListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const First, Last: Integer; const ItemName: string);
var
  I: Integer;
begin
  if List is TStrings then
    for I := First to Last do
      Sender.DeleteValue(ConcatPaths([Path, ItemName + IntToStr(I)]));
end;

procedure TJvCustomAppStorage.ReadCollectionItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
var
  NewItem: TPersistent;
  NewPath: string;
begin
  if List is TCollection then
  begin
    try
      NewPath := ConcatPaths([Path, ItemName + IntToStr(Index)]);
      NewItem := TCollection(List).Add;
      if NewItem is TJvCustomPropertyStore then
        Sender.ReadPersistent(NewPath, NewItem, True, True,
          TJvCustomPropertyStore(NewItem).CombinedIgnoreProperties)
      else
        Sender.ReadPersistent(NewPath, NewItem);
    except
    end;
  end;
end;

procedure TJvCustomAppStorage.WriteCollectionItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
var
  Item: TObject;
begin
  if List is TCollection then
  begin
    Item := TCollection(List).Items[Index];
    if Assigned(Item) then
      if Item is TJvCustomPropertyStore then
        if not TJvCustomPropertyStore(Item).ReadOnly then
          Sender.WritePersistent(ConcatPaths([Path, ItemName + IntToStr(Index)]), TPersistent(Item),
            True, TJvCustomPropertyStore(Item).CombinedIgnoreProperties)
        else
      else
        Sender.WritePersistent(ConcatPaths([Path, ItemName + IntToStr(Index)]), TPersistent(Item));
  end;
end;

procedure TJvCustomAppStorage.DeleteCollectionItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const First, Last: Integer; const ItemName: string);
var
  I: Integer;
begin
  if List is TCollection then
    for I := First to Last do
      Sender.DeleteValue(ConcatPaths([Path, ItemName + IntToStr(I)]));
end;


procedure TJvCustomAppStorage.InternalGetStoredValues(const PrefixPath, SearchPath: string;
  const Strings: TStrings; const Options: TJvAppStorageEnumOptions);
var
  TempList: TStrings;
  I: Integer;
  S: string;
  PrevIdx: Integer;
begin
  TempList := TStringList.Create;
  try
    if aeoValues in Options then
    begin
      EnumValues(SearchPath, TempList, aeoReportListAsValue in Options);
      for I := 0 to TempList.Count - 1 do
      begin
        if TempList[I] = '' then
          S := Copy(PrefixPath, 1, Length(PrefixPath) - 1)
        else
          S := PrefixPath + TempList[I];
        if S <> '' then
        begin
          PrevIdx := Strings.IndexOf(S);
          if PrevIdx > -1 then
            Strings.Objects[PrevIdx] :=
              TObject(Integer(Strings.Objects[PrevIdx]) or aptValue)
          else
            Strings.AddObject(S, TObject(aptValue));
        end;
      end;
    end;
    if (aeoFolders in Options) or (aeoRecursive in Options) then
    begin
      TempList.Clear;
      EnumFolders(SearchPath, TempList, False);
      for I := 0 to TempList.Count - 1 do
      begin
        if (aeoFolders in Options) and IsFolder(SearchPath + PathDelim +
          TempList[I], aeoReportListAsValue in Options) then
        begin
          PrevIdx := Strings.IndexOf(PrefixPath + TempList[I]);
          if PrevIdx > -1 then
            Strings.Objects[PrevIdx] :=
              TObject(Integer(Strings.Objects[PrevIdx]) or aptFolder)
          else
            Strings.AddObject(PrefixPath + TempList[I], TObject(aptFolder));
        end;
        if aeoRecursive in Options then
          InternalGetStoredValues(PrefixPath + TempList[I] + PathDelim,
            SearchPath + PathDelim + TempList[I],
            Strings, Options);
      end;
    end;
  finally
    TempList.Free;
  end;
end;

function TJvCustomAppStorage.GetPath: string;
begin
  Result := FCurPath;
end;

procedure TJvCustomAppStorage.SetPath(const Path: string);
begin
  FCurPath := OptimizePaths([Path]);
end;

procedure TJvCustomAppStorage.SetStorageOptions(Value: TJvCustomAppStorageOptions);
begin
  if (Value <> nil) and (Value <> FStorageOptions) then
    FStorageOptions.Assign(Value);
end;

procedure TJvCustomAppStorage.DoTranslatePropertyName(Instance: TPersistent; var Name: string;
  const Reading: Boolean);
begin
  if Assigned(FOnTranslatePropertyName) then
    FOnTranslatePropertyName(Self, Instance, Name, Reading);
end;

function TJvCustomAppStorage.HasSubStorage(AStore: TJvCustomAppStorage): Boolean;
var
  I: Integer;
begin
  I := SubStorages.Count - 1;
  Result := False;
  while not Result and (I >= 0) do
  begin
    Result := (SubStorages[I].AppStorage = AStore) or
      ((SubStorages[I].AppStorage <> nil) and SubStorages[I].AppStorage.HasSubStorage(AStore));
    Dec(I);
  end;
end;