jvqdsadialogs.pas

East make Tray Icon in delphi

    raise EJvDSADialog.CreateRes(@RsECannotEndCustomWriteIfNotInCustomWr);
  FStates.Pop;
end;

procedure TDSAStorage.EndRead(const DSAInfo: TDSARegItem);
begin
  if FStates.Peek <> ssRead then
    raise EJvDSADialog.CreateRes(@RsECannotEndReadIfNotInReadMode);
  FStates.Pop;
end;

procedure TDSAStorage.EndWrite(const DSAInfo: TDSARegItem);
begin
  if FStates.Peek <> ssWrite then
    raise EJvDSADialog.CreateRes(@RsECannotEndWriteIfNotInWriteMode);
  FStates.Pop;
end;

function TDSAStorage.IsKeyNameAllowed(const Key: string): Boolean;
begin
  if AnsiSameText(Key, cDSAStateValueName) or AnsiSameText(Key, cDSAStateLastResultName) then
    Result := Integer(FStates.Peek) in [Integer(ssRead), Integer(ssWrite)]
  else
    Result := Integer(FStates.Peek) in [Integer(ssCustomRead), Integer(ssCustomWrite)];
end;

function TDSAStorage.GetState(const DSAInfo: TDSARegItem; out LastResult: Integer;
  const OnCustomData: TDSACustomData = nil): Boolean;
begin
  BeginRead(DSAInfo);
  try
    LastResult := 0;
    Result := ReadBoolDef(DSAInfo, cDSAStateValueName, False);
    if Result then
    begin
      LastResult := ReadIntegerDef(DSAInfo, cDSAStateLastResultName, 0);
      if Assigned(OnCustomData) then
      begin
        BeginCustomRead(DSAInfo);
        try
          OnCustomData(Self, DSAInfo);
        finally
          EndCustomRead(DSAInfo);
        end;
      end;
    end;
  finally
    EndRead(DSAInfo);
  end;
end;

procedure TDSAStorage.SetState(const DSAInfo: TDSARegItem; const DontShowAgain: Boolean;
  const LastResult: Integer; const OnCustomData: TDSACustomData = nil);
begin
  BeginWrite(DSAInfo);
  try
    WriteBool(DSAInfo, cDSAStateValueName, DontShowAgain);
    if DontShowAgain then
    begin
      WriteInteger(DSAInfo, cDSAStateLastResultName, LastResult);
      if Assigned(OnCustomData) then
      begin
        BeginCustomWrite(DSAInfo);
        try
          OnCustomData(Self, DSAInfo);
        finally
          EndCustomWrite(DSAInfo);
        end;
      end;
    end;
  finally
    EndWrite(DSAInfo);
  end;
end;

//=== { TDSARegStorage } =====================================================

{$IFDEF MSWINDOWS}

constructor TDSARegStorage.Create(const ARootKey: HKEY; const AKey: string);
begin
  inherited Create;
  FRootKey := ARootKey;
  FKey := AKey;
end;

procedure TDSARegStorage.CreateKey(const DSAInfo: TDSARegItem);
begin
  if not (RegKeyExists(RootKey, Key + '\' + DSAInfo.Name) or
    (RegCreateKey(RootKey, Key + '\' + DSAInfo.Name, '') = ERROR_SUCCESS)) then
    raise EJvDSADialog.CreateResFmt(@RsEDSARegKeyCreateError, [Key + '\' + DSAInfo.Name]);
end;

function TDSARegStorage.GetCheckMarkTextSuffix: string;
begin
  Result := '';
end;

procedure TDSARegStorage.SetCheckMarkTextSuffix(const Value: string);
begin
end;

function TDSARegStorage.ReadBool(const DSAInfo: TDSARegItem; const Key: string): Boolean;
begin
  Result := RegReadBool(RootKey, Self.Key + '\' + DSAInfo.Name, Key);
end;

function TDSARegStorage.ReadBoolDef(const DSAInfo: TDSARegItem; const Key: string;
  const Default: Boolean): Boolean;
begin
  Result := RegReadBoolDef(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Default);
end;

function TDSARegStorage.ReadFloat(const DSAInfo: TDSARegItem; const Key: string): Extended;
begin
  RegReadBinary(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Result, SizeOf(Extended));
end;

function TDSARegStorage.ReadFloatDef(const DSAInfo: TDSARegItem; const Key: string;
  const Default: Extended): Extended;
begin
  if RegReadBinaryDef(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Result, SizeOf(Extended), 0) = 0 then
    Result := Default;
end;

function TDSARegStorage.ReadInt64(const DSAInfo: TDSARegItem; const Key: string): Int64;
begin
  Result := RegReadInt64(RootKey, Self.Key + '\' + DSAInfo.Name, Key);
end;

function TDSARegStorage.ReadInt64Def(const DSAInfo: TDSARegItem; const Key: string; const Default: Int64): Int64;
begin
  Result := RegReadInt64Def(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Default);
end;

function TDSARegStorage.ReadInteger(const DSAInfo: TDSARegItem; const Key: string): Integer;
begin
  Result := RegReadInteger(RootKey, Self.Key + '\' + DSAInfo.Name, Key);
end;

function TDSARegStorage.ReadIntegerDef(const DSAInfo: TDSARegItem; const Key: string;
  const Default: Integer): Integer;
begin
  Result := RegReadIntegerDef(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Default);
end;

function TDSARegStorage.ReadString(const DSAInfo: TDSARegItem; const Key: string): string;
begin
  Result := RegReadString(RootKey, Self.Key + '\' + DSAInfo.Name, Key);
end;

function TDSARegStorage.ReadStringDef(const DSAInfo: TDSARegItem; const Key: string;
  const Default: string): string;
begin
  Result := RegReadStringDef(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Default);
end;

procedure TDSARegStorage.WriteBool(const DSAInfo: TDSARegItem; const Key: string;
  const Value: Boolean);
begin
  CreateKey(DSAInfo);
  RegWriteBool(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Value);
end;

procedure TDSARegStorage.WriteFloat(const DSAInfo: TDSARegItem; const Key: string;
  const Value: Extended);
var
  Temp: Extended;
begin
  CreateKey(DSAInfo);
  Temp := Value;
  RegWriteBinary(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Temp, SizeOf(Extended));
end;

procedure TDSARegStorage.WriteInt64(const DSAInfo: TDSARegItem; const Key: string;
  const Value: Int64);
begin
  CreateKey(DSAInfo);
  RegWriteInt64(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Value);
end;

procedure TDSARegStorage.WriteInteger(const DSAInfo: TDSARegItem; const Key: string;
  const Value: Integer);
begin
  CreateKey(DSAInfo);
  RegWriteInteger(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Value);
end;

procedure TDSARegStorage.WriteString(const DSAInfo: TDSARegItem; const Key: string;
  const Value: string);
begin
  CreateKey(DSAInfo);
  RegWriteString(RootKey, Self.Key + '\' + DSAInfo.Name, Key, Value);
end;

{$ENDIF MSWINDOWS}

//=== { TDSAValues } =========================================================

const
  DSABool = 1;
  DSAFloat = 2;
  DSAInt64 = 3;
  DSAInt = 4;
  DSAString = 5;

  DSAKindTexts: array [DSABool..DSAString] of string =
    (RsEDSAAccessBool, RsEDSAAccessFloat, RsEDSAAccessInt64, RsEDSAAccessInt, RsEDSAAccessString);

type
  TDSAValues = class(TStringList)
  public
    constructor Create;
  end;

constructor TDSAValues.Create;
begin
  inherited Create;
  Sorted := True;
end;

//=== { TDSAQueueStorage } ===================================================

constructor TDSAQueueStorage.Create;
begin
  inherited Create;
  FList := TStringList.Create;
  FList.Sorted := True;
  FCheckMarkSuffix := RsInTheCurrentQueue;
end;

destructor TDSAQueueStorage.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

procedure TDSAQueueStorage.AddDSA(const DSAInfo: TDSARegItem);
begin
  if FindDSA(DSAInfo) < 0 then
    FList.AddObject(DSAInfo.Name, TDSAValues.Create);
end;

procedure TDSAQueueStorage.DeleteDSA(const Index: Integer);
begin
  FList.Objects[Index].Free;
  FList.Delete(Index);
end;

function TDSAQueueStorage.FindDSA(const DSAInfo: TDSARegItem): Integer;
begin
  Result := FList.IndexOf(DSAInfo.Name);
end;

function TDSAQueueStorage.GetCheckMarkTextSuffix: string;
begin
  Result := FCheckMarkSuffix;
end;

function TDSAQueueStorage.GetDSAValue(const DSAInfo: TDSARegItem; const Key: string;
  const Kind: Integer): string;
var
  I: Integer;
  DSAKeys: TStrings;
begin
  I := FindDSA(DSAInfo);
  if I < 0 then
    raise EJvDSADialog.CreateResFmt(@RsEDSADialogIDNotStored, [DSAInfo.ID]);
  DSAKeys := TStrings(FList.Objects[I]);
  I := DSAKeys.IndexOfName(Key);
  if I < 0 then
    raise EJvDSADialog.CreateResFmt(@RsEDSAKeyNotFound, [Key]);
  if Integer(DSAKeys.Objects[I]) <> Kind then
    raise EJvDSADialog.CreateResFmt(@RsEDSAKeyNoAccessAs, [Key, DSAKindTexts[Kind]]);
  Result := DSAKeys.Values[Key];
end;

function TDSAQueueStorage.HasDSAKey(const DSAInfo: TDSARegItem; const Key: string): Boolean;
var
  I: Integer;
  DSAKeys: TStrings;
begin
  I := FindDSA(DSAInfo);
  Result := I > -1;
  if Result then
  begin
    DSAKeys := TStrings(FList.Objects[I]);
    Result := DSAKeys.IndexOfName(Key) > -1;
  end;
end;

procedure TDSAQueueStorage.SetCheckMarkTextSuffix(const Value: string);
begin
  if Value <> CheckMarkTextSuffix then
    FCheckMarkSuffix := Value;
end;

procedure TDSAQueueStorage.SetDSAValue(const DSAInfo: TDSARegItem; const Key: string;
  const Kind: Integer; const Value: string);
var
  I: Integer;
  DSAKeys: TStrings;
begin
  AddDSA(DSAInfo);
  I := FindDSA(DSAInfo);
  if I < 0 then
    raise EJvDSADialog.CreateResFmt(@RsEDSADialogIDNotStored, [DSAInfo.ID]);
  DSAKeys := TStrings(FList.Objects[I]);
  I := DSAKeys.IndexOfName(Key);
  if I < 0 then
    DSAKeys.AddObject(Key + '=' + Value, TObject(Kind))
  else
  begin
    if Integer(DSAKeys.Objects[I]) <> Kind then
      raise EJvDSADialog.CreateResFmt(@RsEDSAKeyNoAccessAs, [Key, DSAKindTexts[Kind]]);
    DSAKeys.Values[Key] := Value;
  end;
end;

procedure TDSAQueueStorage.Clear;
begin
  while FList.Count > 0 do
    DeleteDSA(FList.Count - 1);
end;

function TDSAQueueStorage.ReadBool(const DSAInfo: TDSARegItem; const Key: string): Boolean;
var
  S: string;
begin
  S := GetDSAValue(DSAInfo, Key, DSABool);
  Result := AnsiSameText(S, 'True') or AnsiSameText(S, '1');
end;

function TDSAQueueStorage.ReadBoolDef(const DSAInfo: TDSARegItem; const Key: string;
  const Default: Boolean): Boolean;
begin
  if HasDSAKey(DSAInfo, Key) then
    Result := ReadBool(DSAInfo, Key)
  else
    Result := Default;
end;

function TDSAQueueStorage.ReadFloat(const DSAInfo: TDSARegItem; const Key: string): Extended;
begin
  Result := StrToFloat(StringReplace(GetDSAValue(DSAInfo, Key, DSAFloat),
    ThousandSeparator, DecimalSeparator, [rfReplaceAll, rfIgnoreCase]));
end;

function TDSAQueueStorage.ReadFloatDef(const DSAInfo: TDSARegItem; const Key: string;
  const Default: Extended): Extended;
begin
  if HasDSAKey(DSAInfo, Key) then
    Result := ReadFloat(DSAInfo, Key)
  else
    Result := Default;
end;