jvdsadialogs.pas

East make Tray Icon in delphi

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;

function TDSAQueueStorage.ReadInt64(const DSAInfo: TDSARegItem; const Key: string): Int64;
begin
  Result := StrToInt64(GetDSAValue(DSAInfo, Key, DSAInt64));
end;

function TDSAQueueStorage.ReadInt64Def(const DSAInfo: TDSARegItem; const Key: string;
  const Default: Int64): Int64;
begin
  if HasDSAKey(DSAInfo, Key) then
    Result := ReadInt64(DSAInfo, Key)
  else
    Result := Default;
end;

function TDSAQueueStorage.ReadInteger(const DSAInfo: TDSARegItem; const Key: string): Integer;
begin
  Result := StrToInt(GetDSAValue(DSAInfo, Key, DSAInt));
end;

function TDSAQueueStorage.ReadIntegerDef(const DSAInfo: TDSARegItem; const Key: string;
  const Default: Integer): Integer;
begin
  if HasDSAKey(DSAInfo, Key) then
    Result := ReadInteger(DSAInfo, Key)
  else
    Result := Default;
end;

function TDSAQueueStorage.ReadString(const DSAInfo: TDSARegItem; const Key: string): string;
begin
  Result := GetDSAValue(DSAInfo, Key, DSAString);
end;

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

procedure TDSAQueueStorage.WriteBool(const DSAInfo: TDSARegItem; const Key: string;
  const Value: Boolean);
begin
  if Value then
    SetDSAValue(DSAInfo, Key, DSABool, '1')
  else
    SetDSAValue(DSAInfo, Key, DSABool, '0');
end;

procedure TDSAQueueStorage.WriteFloat(const DSAInfo: TDSARegItem; const Key: string;
  const Value: Extended);
begin
  SetDSAValue(DSAInfo, Key, DSAFloat, FloatToStr(Value));
end;

procedure TDSAQueueStorage.WriteInt64(const DSAInfo: TDSARegItem; const Key: string;
  const Value: Int64);
begin
  SetDSAValue(DSAInfo, Key, DSAInt64, IntToStr(Value));
end;

procedure TDSAQueueStorage.WriteInteger(const DSAInfo: TDSARegItem; const Key: string;
  const Value: Integer);
begin
  SetDSAValue(DSAInfo, Key, DSAInt, IntToStr(Value));
end;

procedure TDSAQueueStorage.WriteString(const DSAInfo: TDSARegItem; const Key: string;
  const Value: string);
begin
  SetDSAValue(DSAInfo, Key, DSAString, Value);
end;

//--------------------------------------------------------------------------------------------------
// Helpers
//--------------------------------------------------------------------------------------------------

const
  Captions: array [TMsgDlgType] of string =
    (SMsgDlgWarning, SMsgDlgError, SMsgDlgInformation, SMsgDlgConfirm, '');
  {$IFDEF MSWINDOWS}
  IconIDs: array [TMsgDlgType] of PChar =
    (IDI_EXCLAMATION, IDI_HAND, IDI_ASTERISK, IDI_QUESTION, nil);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  IconIDs: array [TMsgDlgType] of QMessageBoxIcon =
    (QMessageBoxIcon_Warning,  QMessageBoxIcon_Critical, QMessageBoxIcon_Information,
     QMessageBoxIcon_NoIcon, QMessageBoxIcon_NoIcon);
  {$ENDIF UNIX}

  {$IFDEF VCL}
  ButtonCaptions: array [TMsgDlgBtn] of string =
   (SMsgDlgYes, SMsgDlgNo, SMsgDlgOK, SMsgDlgCancel, SMsgDlgAbort,
    SMsgDlgRetry, SMsgDlgIgnore, SMsgDlgAll, SMsgDlgNoToAll, SMsgDlgYesToAll,
    SMsgDlgHelp);
  ModalResults: array [TMsgDlgBtn] of Integer =
   (mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
    mrYesToAll, 0);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  // TMsgDlgType = (mtCustom, mtInformation, mtWarning, mtError, mtConfirmation);
  ButtonCaptions: array [TMsgDlgBtn] of string =
   (SMsgDlgHelp, SMsgDlgOK, SMsgDlgCancel, SMsgDlgYes,
    SMsgDlgNo, SMsgDlgAbort, SMsgDlgRetry, SMsgDlgIgnore,
    SMsgDlgAll, SMsgDlgNoToAll, SMsgDlgYesToAll);
  ModalResults: array [TMsgDlgBtn] of Integer =
   (0, mrOk, mrCancel, mrYes, mrNo, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
    mrYesToAll);
  {$ENDIF VisualCLX}

function DlgCaption(const DlgType: TMsgDlgType): string;
begin
  Result := Captions[DlgType];
end;

function DlgPic(const DlgType: TMsgDlgType): TGraphic;
begin
  if IconIDs[DlgType] <> nil then
  begin
    Result := TIcon.Create;
    try
      {$IFDEF VCL}
      TIcon(Result).Handle := LoadIcon(0, IconIDs[DlgType]);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      // TODO
      {$ENDIF VisualCLX}
    except
      Result.Free;
      raise;
    end;
  end
  else
    Result := nil;
end;

function DlgButtonCaptions(const Buttons: TMsgDlgButtons): TDynStringArray;
var
  I: Integer;
  B: TMsgDlgBtn;
begin
  SetLength(Result, Ord(High(TMsgDlgBtn)) + 1);
  I := 0;
  for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    if B in Buttons then
    begin
      Result[I] := ButtonCaptions[B];
      Inc(I);
    end;
  SetLength(Result, I);
end;

function DlgButtonResults(const Buttons: TMsgDlgButtons): TDynIntegerArray;
var
  I: Integer;
  B: TMsgDlgBtn;
begin
  SetLength(Result, Ord(High(TMsgDlgBtn)) + 1);
  I := 0;
  for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    if B in Buttons then
    begin
      Result[I] := ModalResults[B];
      Inc(I);
    end;
  SetLength(Result, I);
end;

function ButtonIndex(const Results: array of Integer; const ResCode: Integer): Integer; overload;
begin
  Result := High(Results);
  while (Result > -1) and (Results[Result] <> ResCode) do
    Dec(Result);
end;

function ButtonIndex(const Results: array of Integer; const Button: TMsgDlgBtn): Integer; overload;
begin
  Result := ButtonIndex(Results, ModalResults[Button]);
end;

//----------------------------------------------------------------------------
// MessageDlg replacements and extensions
//----------------------------------------------------------------------------

procedure ShowMessage(const Msg: string; const Center: TDlgCenterKind; const Timeout: Integer;
  const ADynControlEngine: TJvDynControlEngine);
begin
  MessageDlg(Msg, mtCustom, [mbOK], 0, Center, Timeout);
end;

procedure ShowMessageFmt(const Msg: string; const Params: array of const; const Center: TDlgCenterKind;
  const Timeout: Integer; const ADynControlEngine: TJvDynControlEngine);
begin
  MessageDlg(Format(Msg, Params), mtCustom, [mbOK], 0, Center, Timeout);
end;

function MessageDlg(const Msg: string; const DlgType: TMsgDlgType; const Buttons: TMsgDlgButtons;
  const HelpCtx: Longint; const Center: TDlgCenterKind; const Timeout: Integer;
  const DefaultButton: TMsgDlgBtn; const CancelButton: TMsgDlgBtn; const HelpButton: TMsgDlgBtn;
  const ADynControlEngine: TJvDynControlEngine): TModalResult;
var
  TmpPic: TGraphic;
begin
  TmpPic := DlgPic(DlgType);
  try
    Result := MessageDlg(DlgCaption(DlgType), Msg, TmpPic, Buttons, HelpCtx, Center, Timeout, DefaultButton,
      CancelButton, HelpButton, ADynControlEngine);
  finally
    TmpPic.Free;
  end;
end;

function MessageDlg(const Caption, Msg: string; const DlgType: TMsgDlgType; const Buttons: TMsgDlgButtons;
  const HelpCtx: Longint; const Center: TDlgCenterKind; const Timeout: Integer;
  const DefaultButton: TMsgDlgBtn; const CancelButton: TMsgDlgBtn; const HelpButton: TMsgDlgBtn;
  const ADynControlEngine: TJvDynControlEngine): TModalResult;
var
  TmpPic: TGraphic;
begin
  TmpPic := DlgPic(DlgType);
  try
    Result := MessageDlg(Caption, Msg, TmpPic, Buttons, HelpCtx, Center,
      Timeout, DefaultButton, CancelButton, HelpButton, ADynControlEngine);
  finally
    TmpPic.Free;
  end;
end;

function MessageDlg(const Caption, Msg: string; const Picture: TGraphic; const Buttons: TMsgDlgButtons;
  const HelpCtx: Longint; const Center: TDlgCenterKind; const Timeout: Integer;
  const DefaultButton: TMsgDlgBtn; const CancelButton: TMsgDlgBtn; const HelpButton: TMsgDlgBtn;
  const ADynControlEngine: TJvDynControlEngine): TModalResult;
var
  DefBtn: TMsgDlgBtn;
  CanBtn: TMsgDlgBtn;
  BtnResults: TDynIntegerArray;
begin
  if DefaultButton = mbDefault then
  begin
    if mbOK in Buttons then
      DefBtn := mbOK
    else
    if mbYes in Buttons then
      DefBtn := mbYes
    else
      DefBtn := mbRetry;
  end
  else
    DefBtn := DefaultButton;
  if CancelButton = mbDefault then
  begin
    if mbCancel in Buttons then
      CanBtn := mbCancel
    else
    if mbNo in Buttons then
      CanBtn := mbNo
    else
      CanBtn := mbOK;
  end
  else
    CanBtn := CancelButton;
  BtnResults := DlgButtonResults(Buttons);
  Result := MessageDlgEx(Caption, Msg, Picture, DlgButtonCaptions(Buttons),
    BtnResults, HelpCtx, Center, Timeout, ButtonIndex(BtnResults, DefBtn),
    ButtonIndex(BtnResults, CanBtn), ButtonIndex(BtnResults, HelpButton),
    ADynControlEngine);
end;

function MessageDlgEx(const Msg: string; const DlgType: TMsgDlgType; const Buttons: array of string;
  const Results: array of Integer; const HelpCtx: Longint; const Center: TDlgCenterKind;
  const Timeout: Integer; const DefaultButton: Integer; const CancelButton: Integer;
  const HelpButton: Integer; const ADynControlEngine: TJvDynControlEngine): TModalResult;
var
  TmpPic: TGraphic;
begin
  TmpPic := DlgPic(DlgType);
  try
    Result := MessageDlgEx(DlgCaption(DlgType), Msg, TmpPic, Buttons, Results, HelpCtx, Center, Timeout, DefaultButton,
      CancelButton, HelpButton, ADynControlEngine);
  finally
    TmpPic.Free;
  end;
end;

function MessageDlgEx(const Caption, Msg: string; const DlgType: TMsgDlgType;
  const Buttons: array of string; const Results: array of Integer; const HelpCtx: Longint;
  const Center: TDlgCenterKind; const Timeout: Integer; const DefaultButton: Integer;
  const CancelButton: Integer; const HelpButton: Integer;
  const ADynControlEngine: TJvDynControlEngine): TModalResult;
var
  TmpPic: TGraphic;
begin
  TmpPic := DlgPic(DlgType);
  try
    Result := MessageDlgEx(Caption, Msg, TmpPic, Buttons, Results, HelpC