package Claw.Message_Box is
--
-- CLAW - Class Library for Ada and Windows.
--
-- This is the root package containing various global types, exceptions,
-- and routines.
--
-- Copyright 1996, R.R. Software, Inc.
-- P.O. Box 1512, Madison WI 53701
-- All rights reserved.
--
pragma Elaborate_Body; -- Insure that the body is elaborated before anyone
-- can call CLAW. (It contains the message loop!).
type Message_Box_Type is private;
type Message_Flags_Type is private;
type Message_Buttons_Type is
(OK_Only,
OK_Cancel,
Abort_Retry_Ignore,
Yes_No_Cancel,
Yes_No,
Retry_Cancel);
for Message_Buttons_Type use
(OK_Only => 0,
OK_Cancel => 1,
Abort_Retry_Ignore => 2,
Yes_No_Cancel => 3,
Yes_No => 4,
Retry_Cancel => 5);
type Message_Icon_Type is
(None,
Stop,
Question,
Exclamation,
Information);
for Message_Icon_Type use
(None => 0,
Stop => 1,
Question => 2,
Exclamation => 3,
Information => 4);
Warning : constant Message_Icon_Type := Question;
Hand : constant Message_Icon_Type := Stop;
Error : constant Message_Icon_Type := Stop;
subtype Default_Button_Type is Claw.UInt range 1 .. 4;
type Message_Modality_Type is
(App_Modal,
Task_Modal,
System_Modal);
for Message_Modality_Type use
(App_Modal => 0,
Task_Modal => 1,
System_Modal => 2);
No_Flags : constant Message_Flags_Type;
Add_Help_Button : constant Message_Flags_Type;
No_Focus : constant Message_Flags_Type;
Set_Foreground : constant Message_Flags_Type;
Default_Desktop_Only: constant Message_Flags_Type;
Topmost : constant Message_Flags_Type;
Right_Justified : constant Message_Flags_Type;
Right_Reading : constant Message_Flags_Type;
Service_Notification_NT3: constant Message_Flags_Type;
Service_Notification_NT4: constant Message_Flags_Type;
-- For those times you've really gotta have it this way
function UInt_of (S : in Message_Flags_Type) return CLAW.UInt;
-- For passing fancier things in.
function Message_Flags_Type_Of (D : in Claw.UInt)
return Message_Flags_Type;
function "+" (Left, Right : in Message_Flags_Type) return Message_Flags_Type;
function "-" (Left, Right : in Message_Flags_Type) return Message_Flags_Type;
function ">=" (Left, Right : in Message_Flags_Type) return Boolean;
-- Read A >= B as A includes B
-- I.e. each set style in B is also in A.
function Make_Flags (Buttons : Message_Buttons_Type := OK_Only;
Icon : Message_Icon_Type := None;
Default_Button : Default_Button_Type := 1;
Modality : Message_Modality_Type := App_Modal;
Flags : Message_Flags_Type := No_Flags)
return Message_Box_Type;
-- Create a Message_Box_Type object from the specified details.
type Button_Type is private;
OK : constant Button_Type;
Cancel : constant Button_Type;
Abort_Button: constant Button_Type;
Retry : constant Button_Type;
Ignore : constant Button_Type;
Yes : constant Button_Type;
No : constant Button_Type;
procedure Message_Box (Text : in String;
Caption : in String;
Flags : in Message_Box_Type);
-- Popup a message box with no owner containing Text and Caption,
-- using flags. (The procedure form should be used only for boxes
-- with a single button).
function Message_Box (Text : in String;
Caption : in String;
Flags : in Message_Box_Type) return Button_Type;
-- Popup a message box with no owner containing Text and Caption,
-- using flags; returns the button pressed to exit the box.
procedure Message_Box (Owner : in Root_Window_Type'Class;
Text : in String;
Caption : in String;
Flags : in Message_Box_Type);
-- Popup a message box with owner as the owner window containing Text
-- and Caption, using flags. (The procedure form should be used only
-- for boxes with a single button).
-- Raises:
-- Not_Valid_Error if Owner is not a valid window.
function Message_Box (Owner : in Root_Window_Type'Class;
Text : in String;
Caption : in String;
Flags : in Message_Box_Type) return Button_Type;
-- Popup a message box with owner as the owner window containing Text
-- and Caption, using flags; returns the button pressed to exit the box.
-- Raises:
-- Not_Valid_Error if Owner is not a valid window.
private
type Message_Flags_Type is new Claw.UInt;
No_Flags : constant Message_Flags_Type := 0;
Add_Help_Button : constant Message_Flags_Type := 16#004000#;
No_Focus : constant Message_Flags_Type := 16#008000#;
Set_Foreground : constant Message_Flags_Type := 16#010000#;
Default_Desktop_Only: constant Message_Flags_Type := 16#020000#;
Topmost : constant Message_Flags_Type := 16#040000#;
Right_Justified : constant Message_Flags_Type := 16#080000#;
Right_Reading : constant Message_Flags_Type := 16#100000#;
Service_Notification_NT3: constant Message_Flags_Type := 16#040000#;
Service_Notification_NT4: constant Message_Flags_Type := 16#040000#;
-- Note: NT4 documents that the value is different, but the
-- header file contains the same old value. I've left the value
-- the same, but left the objects separated, so that we can correct
-- it later.
type Message_Box_Type is new Claw.UInt;
type Button_Type is new Claw.UInt;
OK : constant Button_Type := 1;
Cancel : constant Button_Type := 2;
Abort_Button: constant Button_Type := 3;
Retry : constant Button_Type := 4;
Ignore : constant Button_Type := 5;
Yes : constant Button_Type := 6;
No : constant Button_Type := 7;
end Claw.Message_Box;