jvstringholder.pas

East make Tray Icon in delphi

function TJvMacros.FindMacro(const Value: string): TJvMacro;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
  begin
    Result := TJvMacro(inherited Items[I]);
    if AnsiSameText(Result.Name, Value) then
      Exit;
  end;
  Result := nil;
end;

procedure TJvMacros.AssignValues(Value: TJvMacros);
var
  I: Integer;
  P: TJvMacro;
begin
  BeginUpdate;
  try
    for I := 0 to Value.Count - 1 do
    begin
      P := FindMacro(Value[I].Name);
      if P <> nil then
        P.Assign(Value[I]);
    end;
  finally
    EndUpdate;
  end;
end;

function TJvMacros.ParseString(const Value: string; DoCreate: Boolean;
  SpecialChar: Char): string;
var
  Macros: TJvMacros;
begin
  Result := Value;
  Macros := TJvMacros.Create(Self.GetOwner);
  try
    CreateMacros(Macros, PChar(Result), SpecialChar, ['.']);
    if DoCreate then
    begin
      Macros.AssignValues(Self);
      Self.Assign(Macros);
    end;
  finally
    Macros.Free;
  end;
end;

function TJvMacros.GetMacroValue(const MacroName: string): Variant;
var
  I: Integer;
  Macros: TList;
begin
  if Pos(';', MacroName) <> 0 then
  begin
    Macros := TList.Create;
    try
      GetMacroList(Macros, MacroName);
      Result := VarArrayCreate([0, Macros.Count - 1], varVariant);
      for I := 0 to Macros.Count - 1 do
        Result[I] := TJvMacro(Macros[I]).Value;
    finally
      Macros.Free;
    end;
  end
  else
    Result := MacroByName(MacroName).Value;
end;

procedure TJvMacros.SetMacroValue(const MacroName: string;
  const Value: Variant);
var
  I: Integer;
  Macros: TList;
begin
  if Pos(';', MacroName) <> 0 then
  begin
    Macros := TList.Create;
    try
      GetMacroList(Macros, MacroName);
      for I := 0 to Macros.Count - 1 do
        TJvMacro(Macros[I]).Value := Value[I];
    finally
      Macros.Free;
    end;
  end
  else
    MacroByName(MacroName).Value := Value;
end;

procedure TJvMacros.GetMacroList(List: TList; const MacroNames: string);
var
  Pos: Integer;
begin
  Pos := 1;
  while Pos <= Length(MacroNames) do
    List.Add(MacroByName(ExtractName(MacroNames, Pos)));
end;

//=== { TJvStrHolder } =======================================================

constructor TJvStrHolder.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStrings := TStringList.Create;
  FMacros := TJvMacros.Create(Self);
  FMacroChar := '%';
  FStrings.OnChange := StringsChanged;
  FStrings.OnChanging := StringsChanging;
end;

destructor TJvStrHolder.Destroy;
begin
  FOnChange := nil;
  FOnChanging := nil;
  FMacros.Free;
  FStrings.OnChange := nil;
  FStrings.OnChanging := nil;
  FStrings.Free;
  inherited Destroy;
end;

procedure TJvStrHolder.Assign(Source: TPersistent);
begin
  if Source is TStrings then
    FStrings.Assign(Source)
  else
  if Source is TJvStrHolder then
    FStrings.Assign(TJvStrHolder(Source).Strings)
  else
    inherited Assign(Source);
end;

procedure TJvStrHolder.AssignTo(Dest: TPersistent);
begin
  if Dest is TStrings then
    Dest.Assign(Strings)
  else
    inherited AssignTo(Dest);
end;

procedure TJvStrHolder.Changed;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvStrHolder.Changing;
begin
  if Assigned(FOnChanging) then
    FOnChanging(Self);
end;

procedure TJvStrHolder.Clear;
begin
  Strings.Clear;
end;

function TJvStrHolder.GetCommaText: string;
begin
  Result := Strings.CommaText;
end;

procedure TJvStrHolder.SetCommaText(const Value: string);
begin
  Strings.CommaText := Value;
end;

function TJvStrHolder.GetCapacity: Integer;
begin
  Result := Strings.Capacity;
end;

procedure TJvStrHolder.SetCapacity(NewCapacity: Integer);
begin
  Strings.Capacity := NewCapacity;
end;

procedure TJvStrHolder.BeforeExpandMacros;
begin
  if Assigned(FOnExpandMacros) then
    FOnExpandMacros(Self);
end;

procedure TJvStrHolder.SetMacros(Value: TJvMacros);
begin
  FMacros.AssignValues(Value);
end;

procedure TJvStrHolder.RecreateMacros;
begin
  if not (csReading in ComponentState) then
    Macros.ParseString(Strings.Text, True, MacroChar);
end;

procedure TJvStrHolder.SetMacroChar(Value: Char);
begin
  if Value <> FMacroChar then
  begin
    FMacroChar := Value;
    RecreateMacros;
  end;
end;

function TJvStrHolder.MacroCount: Integer;
begin
  Result := Macros.Count;
end;

function TJvStrHolder.MacroByName(const MacroName: string): TJvMacro;
begin
  Result := Macros.MacroByName(MacroName);
end;

function TJvStrHolder.ExpandMacros: string;
var
  I, J, P, LiteralChars: Integer;
  Macro: TJvMacro;
  Found: Boolean;
begin
  BeforeExpandMacros;
  Result := Strings.Text;
  for I := Macros.Count - 1 downto 0 do
  begin
    Macro := Macros[I];
    if VarIsEmpty(Macro.FData) then
      Continue;
    repeat
      P := Pos(MacroChar + Macro.Name, Result);
      Found := (P > 0) and ((Length(Result) = P + Length(Macro.Name)) or
        NameDelimiter(Result[P + Length(Macro.Name) + 1], ['.']));
      if Found then
      begin
        LiteralChars := 0;
        for J := 1 to P - 1 do
          if IsLiteral(Result[J]) then
            Inc(LiteralChars);
        Found := LiteralChars mod 2 = 0;
        if Found then
        begin
          Result := Copy(Result, 1, P - 1) + Macro.Text + Copy(Result,
            P + Length(Macro.Name) + 1, MaxInt);
        end;
      end;
    until not Found;
  end;
end;

procedure TJvStrHolder.DefineProperties(Filer: TFiler);

  function DoWrite: Boolean;
  var
    I: Integer;
    Ancestor: TJvStrHolder;
  begin
    Ancestor := TJvStrHolder(Filer.Ancestor);
    Result := False;
    if (Ancestor <> nil) and (Ancestor.Strings.Count = Strings.Count) and
      (KeyString = Ancestor.KeyString) and (Strings.Count > 0) then
      for I := 0 to Strings.Count - 1 do
      begin
        Result := CompareText(Strings[I], Ancestor.Strings[I]) <> 0;
        if Result then
          Break;
      end
    else
      Result := (Strings.Count > 0) or (Length(KeyString) > 0);
  end;

begin
  inherited DefineProperties(Filer);
  { for backward compatibility }
  Filer.DefineProperty('InternalVer', ReadVersion, WriteVersion, Filer.Ancestor = nil);
  Filer.DefineProperty('StrData', ReadStrings, WriteStrings, DoWrite);
end;

function TJvStrHolder.GetSorted: Boolean;
begin
  Result := FStrings.Sorted;
end;

function TJvStrHolder.GetDuplicates: TDuplicates;
begin
  Result := FStrings.Duplicates;
end;

procedure TJvStrHolder.ReadStrings(Reader: TReader);
begin
  Reader.ReadListBegin;
  if not Reader.EndOfList then
    KeyString := Reader.ReadString;
  Strings.Clear;
  while not Reader.EndOfList do
    if FReserved >= XorVersion then
      Strings.Add(XorDecode(KeyString, Reader.ReadString))
    else
      Strings.Add(XorString(KeyString, Reader.ReadString));
  Reader.ReadListEnd;
end;

procedure TJvStrHolder.SetDuplicates(Value: TDuplicates);
begin
  FStrings.Duplicates := Value;
end;

procedure TJvStrHolder.SetSorted(Value: Boolean);
begin
  FStrings.Sorted := Value;
end;

function TJvStrHolder.GetStrings: TStrings;
begin
  Result := FStrings;
end;

procedure TJvStrHolder.SetStrings(Value: TStrings);
begin
  FStrings.Assign(Value);
end;

procedure TJvStrHolder.StringsChanged(Sender: TObject);
begin
  RecreateMacros;
  if not (csReading in ComponentState) then
    Changed;
end;

procedure TJvStrHolder.StringsChanging(Sender: TObject);
begin
  if not (csReading in ComponentState) then
    Changing;
end;

procedure TJvStrHolder.WriteStrings(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  Writer.WriteString(KeyString);
  for I := 0 to Strings.Count - 1 do
    Writer.WriteString(XorEncode(KeyString, Strings[I]));
  Writer.WriteListEnd;
end;

procedure TJvStrHolder.ReadVersion(Reader: TReader);
begin
  FReserved := Reader.ReadInteger;
end;

procedure TJvStrHolder.WriteVersion(Writer: TWriter);
begin
  Writer.WriteInteger(XorVersion);
end;

//=== { TJvMultiStringHolderCollectionItem } =================================

procedure TJvMultiStringHolderCollectionItem.SetName(Value: string);
begin
  Value := Trim(Value);
  if Value = '' then
    FName := ''
  else
  begin
    if not TJvMultiStringHolderCollection(Collection).DoesNameExist(Value) then
      FName := Value
    else
      raise EJVCLException.CreateRes(@SDuplicateString);
  end;
end;

procedure TJvMultiStringHolderCollectionItem.SetStrings(const Value: TStrings);
begin
  FStrings.Assign(Value);
end;

function TJvMultiStringHolderCollectionItem.GetDisplayName: string;
begin
  if FName <> '' then
    Result := FName
  else
    Result := RsNoName;
end;

constructor TJvMultiStringHolderCollectionItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FStrings := TStringList.Create;
end;

destructor TJvMultiStringHolderCollectionItem.Destroy;
begin
  FStrings.Free;
  inherited Destroy;
end;

//=== { TJvMultiStringHolderCollection } =====================================

function TJvMultiStringHolderCollection.GetItem(Index: Integer): TJvMultiStringHolderCollectionItem;
begin
  Result := TJvMultiStringHolderCollectionItem(inherited GetItem(Index));
end;

procedure TJvMultiStringHolderCollection.SetItem(Index: Integer; Value: TJvMultiStringHolderCollectionItem);
begin
  inherited SetItem(Index, Value);
end;

function TJvMultiStringHolderCollection.DoesNameExist(const Name: string): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to Count - 1 do
    if CompareText(Items[I].Name, Name) = 0 then
      Exit;
  Result := False;
end;

function TJvMultiStringHolderCollection.Add: TJvMultiStringHolderCollectionItem;
begin
  Result := TJvMultiStringHolderCollectionItem(inherited Add);
end;

function TJvMultiStringHolderCollection.Insert(Index: Integer): TJvMultiStringHolderCollectionItem;
begin
  Result := Add;
  Result.Index := Index;
end;

//=== { TJvMultiStringHolder } ===============================================

constructor TJvMultiStringHolder.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMultipleStrings := TJvMultiStringHolderCollection.Create(Self, TJvMultiStringHolderCollectionItem);
end;

destructor TJvMultiStringHolder.Destroy;
begin
  FMultipleStrings.Free;
  inherited Destroy;
end;

procedure TJvMultiStringHolder.SetMultipleStrings(Value: TJvMultiStringHolderCollection);
begin
  FMultipleStrings.Assign(Value);
end;

function TJvMultiStringHolder.GetItemByName(const Name: string): TJvMultiStringHolderCollectionItem;
var
  I: Integer;
begin
  for I := 0 to MultipleStrings.Count - 1 do
    if CompareText(MultipleStrings.Items[I].Name, Name) = 0 then
    begin
      Result := MultipleStrings.Items[I];
      Exit;
    end;
  raise EJvMultiStringHolderException.CreateResFmt(@RsENoItemFoundWithName, [Name]);
end;

function TJvMultiStringHolder.GetStringsByName(const Name: string): TStrings;
begin
  Result := GetItemByName(Name).Strings;
end;

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.