(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTMsgBoxes;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AHMSystemClass;
type
  TAHMMsgBoxes = class;
  TAHMMessages = class;
  TAHMMessageEvent = procedure (Sender:TObject;Var Message : String) of object;
  TAHMMessage = class(TCollectionItem)
  private
    MsgText : String;
    FAHMMsgBoxes : TAHMMsgBoxes;
    FXPosition: Integer;
    FYPosition: Integer;
    FHelpcontext: Longint;
    FButtons: TMsgDlgbuttons;
    FMsgType: TMsgDlgType;
    FOnAbort: TNotifyevent;
    FOnRetry: TNotifyevent;
    FOnAll: TNotifyevent;
    FOnCancel: TNotifyevent;
    FOnIgnore: TNotifyevent;
    FOnNo: TNotifyevent;
    FOnYes: TNotifyevent;
    FOnOk: TNotifyevent;
    FCaption: String;
    FBeepType: TAHMBeeptype;
    FReturn: Word;
    FBeforePopup: TAHMMessageEvent;
    procedure SetCaption(const Value: String);
    procedure SetXPosition(const Value: Integer);
    procedure SetYPosition(const Value: Integer);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
    property Owner : TAHMMsgBoxes read FAHMMsgBoxes;
    property DisplayName : String read GetDisplayName;
    Function Execute : TModalResult;
    Property Return : Word read FReturn;
  published
    Property Caption : String read FCaption write SetCaption;
    Property Sound : TAHMBeeptype read FBeepType write FBeepType default bNone;
    Property MsgType : TMsgDlgType read FMsgType write FMsgType default mtinformation;
    Property Buttons : TMsgDlgbuttons read FButtons write FButtons default [mbOk,mbCancel];
    Property HelpContext : Longint read FHelpcontext write FHelpContext default 0;
    Property XPosition   : Integer read FXPosition write SetXPosition default -1;
    Property YPosition   : Integer read FYPosition write SetYPosition default -1;
    Property BeforePopup : TAHMMessageEvent read FBeforePopup write FBeforePopup;
    Property OnYes       : TNotifyevent read FOnYes write FOnYes;
    Property OnNo        : TNotifyevent read FOnNo write FOnNo;
    Property OnOk        : TNotifyevent read FOnOk write FOnOk;
    Property OnCancel    : TNotifyevent read FOnCancel write FOnCancel;
    Property OnAbort     : TNotifyevent read FOnAbort write FOnAbort;
    Property OnIgnore    : TNotifyevent read FOnIgnore write FOnIgnore;
    Property OnRetry     : TNotifyevent read FOnRetry write FOnRetry;
    Property OnAll       : TNotifyevent read FOnAll write FOnAll;
  end;
  TAHMMessages = class(TCollection)
  private
    FAHMMsgBoxes : TAHMMsgBoxes;
    function GetAHMMessage(Index: Integer): TAHMMessage;
    procedure SetAHMMessage(Index: Integer; Value: TAHMMessage);
  protected
    function GetOwner : TPersistent; override;
  public
    constructor Create(AOwner: TAHMMsgBoxes);
    function Add : TAHMMessage;
   Function Delete(Index :Integer) :Boolean;
    property Owner : TAHMMsgBoxes read FAHMMsgBoxes;
    property Items[Index: Integer]: TAHMMessage read GetAHMMessage write SetAHMMessage; default;
  end;
  TAHMMsgBoxes = class(TAHMSystemsComponent)
  private
    FAHMMessages : TAHMMessages;
    FBeforePopup: TAHMMessageEvent;
    procedure SetAHMMessages(Value: TAHMMessages);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    Function Execute(Index : Integer) : TModalResult;
  published
    property Messages: TAHMMessages read FAHMMessages write SetAHMMessages;
    Property BeforePopup : TAHMMessageEvent read FBeforePopup write FBeforePopup;
  end;

implementation

constructor TAHMMessage.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FAHMMsgBoxes :=(((Collection as TAHMMessages).GetOwner) as TAHMMsgBoxes);
  FHelpContext   := 0;
  FMsgType := mtinformation;
  FButtons   := [mbOk,mbCancel];
  freturn := 0;
  FXPosition:= -1;
  FYPosition:= -1;
  FCaption:='Place your Message here';
end;

function TAHMMessage.GetDisplayName: string;
begin
  if FCaption<>'' then Result := FCaption else Result:='No message defined';
end;

function TAHMMessages.GetOwner: TPersistent;
begin
  Result := FAHMMsgBoxes;
end;

procedure TAHMMessage.Assign(Source: TPersistent);
begin
  if Source is TAHMMessage then
  begin
    Caption :=TAHMMessage(Source).Caption;
    Sound :=TAHMMessage(Source).Sound;
    MsgType :=TAHMMessage(Source).MsgType;
    Buttons :=TAHMMessage(Source).Buttons;
    HelpContext :=TAHMMessage(Source).HelpContext;
    XPosition   :=TAHMMessage(Source).XPosition;
    YPosition   :=TAHMMessage(Source).YPosition;
    BeforePopup :=TAHMMessage(Source).BeforePopup;
    OnYes       :=TAHMMessage(Source).OnYes;
    OnNo        :=TAHMMessage(Source).OnNo;
    OnOk        :=TAHMMessage(Source).OnOk;
    OnCancel    :=TAHMMessage(Source).OnCancel;
    OnAbort     :=TAHMMessage(Source).OnAbort;
    OnIgnore    :=TAHMMessage(Source).OnIgnore;
    OnRetry     :=TAHMMessage(Source).OnRetry;
    OnAll       :=TAHMMessage(Source).OnAll;
    Exit;
  end;
  inherited Assign(Source);
end;

constructor TAHMMessages.Create(AOwner: TAHMMsgBoxes);
begin
  inherited Create(TAHMMessage);
  FAHMMsgBoxes := AOwner;
end;

function TAHMMessages.Add: TAHMMessage;
begin
  Result := TAHMMessage(inherited Add);
end;

function TAHMMessages.GetAHMMessage(Index: Integer): TAHMMessage;
begin
  Result := TAHMMessage(inherited GetItem(Index));
end;

procedure TAHMMessages.SetAHMMessage(Index: Integer; Value: TAHMMessage);
begin
  inherited SetItem(Index, Value);
end;

constructor TAHMMsgBoxes.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  FAHMMessages:=TAHMMessages.Create(self);
end;

destructor TAHMMsgBoxes.Destroy;
begin
  FAHMMessages.Free;
  inherited Destroy;
end;

function TAHMMsgBoxes.Execute(Index: Integer): TModalResult;
begin
  if (Index>-1) and (Index<FAHMMessages.Count) then
   result:=FAHMmessages[Index].Execute else result:=mrNone;
end;

procedure TAHMMsgBoxes.SetAHMMessages(Value: TAHMMessages);
begin
  FAHMMessages.Assign(Value);
end;


function TAHMMessages.Delete(Index: Integer): Boolean;
begin
  result := true;
  Try
    Items[Index].free;
  Except
    result := false;
    Application.handleexception(self);
  End;
end;

function TAHMMessage.Execute: TModalResult;
begin
  MsgText:=FCaption;
  if assigned(FBeforePopup) then FBeforePopup(self,MsgText);
  if assigned(FAHMMsgBoxes.FBeforePopup) then FAHMMsgBoxes.FBeforePopup(self,MsgText);
  case FBeepType of
    bDefault      : MessageBeep(MB_OK);
    bAsterix      : MessageBeep(MB_ICONAsterisk);
    bExclamation  : MessageBeep(MB_ICONEXCLAMATION);
    bQuestion     : MessageBeep(MB_ICONQUESTION);
    bCriticalStop : MessageBeep(MB_ICONHAND);
  end;
  if FYPosition=-1  then FReturn := Messagedlg(MsgText,FMsgType,FButtons,FHelpContext)
                    else FReturn := Messagedlgpos(MsgText,FMsgType,FButtons,FHelpContext,FXPosition,FYPosition);
  Case FReturn of
    mrYes : if assigned(FOnYes) then FOnYes(self);
    mrNo  : if assigned(FOnNo) then FOnNo(self);
    mrOk  : if assigned(FOnOk) then FOnOk(self);
    mrCancel : if assigned(FOnCancel) then FOnCancel(self);
    mrAbort : if assigned(FOnAbort) then FOnAbort(self);
    mrRetry : if assigned(FOnRetry) then FOnRetry(self);
    mrIgnore : if assigned(FOnIgnore) then FOnIgnore(self);
    mrAll : if assigned(FOnAll) then FOnAll(self);
  end;
  result:=FReturn;
end;

procedure TAHMMessage.SetCaption(const Value: String);
begin
  FCaption := Value;
end;

procedure TAHMMessage.SetXPosition(const Value: Integer);
begin
  if Value>=-1 then FXPosition := Value;
  if Value=-1 then FYPosition:=value;
end;

procedure TAHMMessage.SetYPosition(const Value: Integer);
begin
  if Value>=-1 then FYPosition := Value;
  if Value=-1 then FXPosition:=value;
end;

end.
