with Ada.Finalization;
with Claw.Radio_Button;
with Claw.Groupbox;
with Claw.Fonts;
generic
type Radio_Button_Index_Type is (<>);
package Claw.Radio_Button_Set is
--
-- CLAW - Class Library for Ada and Windows.
--
-- This package contains support for sets of Radio Buttons.
-- Radio Buttons are buttons of which only one can be selected at a time.
-- Note: This package only supports text Radio Buttons. Bitmap or
-- Icon buttons must be created individually with Claw.Radio_Button.
-- Similarly, all of the buttons must have the same style, font, and color;
-- to do otherwise, individual buttons must be used.
-- The radio buttons are indexed by Radio_Button_Index_Type. There will
-- be one button for each value in the type. This typically will be
-- an enumeration type.
--
-- Copyright 1997 R.R. Software, Inc.
-- P.O. Box 1512, Madison WI 53701
-- All rights reserved.
--
type Radio_Button_Set_Type is
new Ada.Finalization.Controlled with private;
-- The set also may contain an optional groupbox, which surrounds
-- and delinates the set. CLAW will manage the set as a single
-- entity; this simplifies the use of radio buttons.
-- The individual buttons are numbered from 1 to Number; the currently
-- selected button can be retrieved or changed using this index.
-- Note that a set of radio buttons is NOT a window; if window functions
-- need to be performed on the set of buttons, a set should not be used.
procedure Create (
Button_Set : in out Radio_Button_Set_Type;
Parent : in out CLAW.Root_Window_Type'Class;
Initial_Selection:in Radio_Button_Index_Type := Radio_Button_Index_Type'First;
Make_Groupbox : in Boolean := True;
Set_Text : in String := "";
Visible : in Boolean := True;
Left_Text : in Boolean := False;
Flat_Appearance : in Boolean := False;
Push_Button_Appearance: in Boolean := False;
Position : in Point_Type := Use_Default_Control_Position;
Size : in Size_Type := Use_Default_Control_Size;
In_Dialog_Units : in Boolean := False;
Id : in Identifier_Type);
-- Create a set of Radio Button Controls of parent.
-- The buttons will have as labels the image of each enumeration value;
-- any underscores ("_") in the image will be converted to spaces; all
-- characters except the first will be in lower case.
-- If Visible is true, the set is created as visible; otherwise it
-- is not initially visible. Use Show to change the visibility state.
-- If Left_Text is true, the text will be on the left side of the
-- control; otherwise (the default), it will be on the right.
-- If Flat_Appearance is true, the buttons will look flat; otherwise
-- the default 3d look will be used. (Note that this value is ignored
-- on Windows 3.x; all items have a flat appearance).
-- If Push_Button_Appearance is True, the buttons will look like
-- push-buttons. Otherwise, they will look like radio buttons. This
-- value is only supported on Windows 4.0 and newer.
-- The first button in the set will have the Group and Tabstop styles
-- specified, in order to insure that the proper dialog keyboard
-- interface is supported.
-- Initial_Selection sets the button which is selected originally.
-- If Make_Groupbox is true, a surrounding Groupbox with text Set_Text
-- will be created. Otherwise, no groupbox is created, and Set_Text
-- must be empty.
-- Position specifies the location of the entire set.
-- If Size is Use_Default_Size, it will be set to the size of the
-- entire set, where each control will be spaced evenly.
-- Otherwise, the controls will be spaced evenly vertically within
-- the Set.
-- If In_Dialog_Units is True, then Size and Position are in
-- dialog units for Parent. Otherwise, they are in pixels.
-- Id will be the identifier of the first radio button in the set.
-- Each following button will be given successive identifier values.
-- The groupbox will not be given an identifier value.
-- Note that a Radio_Button_Set must have an identifier value; it cannot
-- be 0.
-- Raises:
-- Already_Valid_Error if the window is already valid.
-- Not_Valid_Error if the parent window is not already valid; or
-- Set_Text is not empty if Make_Groupbox is False.
-- Not_Supported_Error if Push_Button_Appearance is true on
-- Windows 3.x.
-- Windows_Error if Windows returns an error.
--
-- Note: If the default labels aren't appropriate, either use a template
-- and Use_for_Controls_in_Window, or create the set with Visible = False,
-- then use Set_Text to change the labels, and finally use Show to make the
-- set visible.
procedure Create (
Button_Set : in out Radio_Button_Set_Type;
Parent : in out CLAW.Root_Window_Type'Class;
Initial_Selection:in Radio_Button_Index_Type := Radio_Button_Index_Type'First;
Make_Groupbox : in Boolean := True;
Set_Text : in String := "";
Visible : in Boolean := True;
Left_Text : in Boolean := False;
Flat_Appearance : in Boolean := False;
Push_Button_Appearance: in Boolean := False;
Font : in out Claw.Fonts.Font_Type;
Position : in Point_Type := Use_Default_Control_Position;
Size : in Size_Type := Use_Default_Control_Size;
In_Dialog_Units : in Boolean := False;
Id : in Identifier_Type);
-- Create a set of Radio Button Controls of parent.
-- Use Font for the text font for the controls.
-- Otherwise, this routine is identical to the first Create.
procedure Use_for_Controls_in_Window (Button_Set : in out Radio_Button_Set_Type;
First_Button_Id : in Identifier_Type;
Parent : in out Root_Window_Type'Class;
Groupbox_Id : in Identifier_Type := 0);
-- Use Button_Set as the control object(s) for the already created
-- buttons identified by the consectutive Ids from First_Button_Id to
-- however many are needed to cover the index range. If Groupbox_Id
-- is non-zero, then the set will also include the groupbox identified
-- by Groupbox_Id.
-- This is usually used for radio button sets created by resource
-- templates.
-- Raises:
-- Already_Valid_Error if Button_Set is already valid, or if
-- another control object is already attached to any of
-- the specified controls.
-- Not_Valid_Error if Parent is not valid.
-- Windows_Error if Windows reports an error.
function Is_Valid (Button_Set : in Radio_Button_Set_Type) return Boolean;
-- Is Button_Set Valid? This means that the internal data structures
-- and Win32 structures are initialized and valid.
procedure Initialize (Button_Set : in out Radio_Button_Set_Type);
-- Initialize Button_Set (for Controlled types; this routine need not
-- be called explicitly).
procedure Adjust (Button_Set : in out Radio_Button_Set_Type);
-- Adjust Button_Set (for Controlled types; this routine need not
-- be called explicitly).
procedure Finalize (Button_Set : in out Radio_Button_Set_Type);
-- Finalize Button_Set (for Controlled types; this routine need not
-- be called explicitly, call Destroy instead.).
procedure Destroy (Button_Set : in out Radio_Button_Set_Type);
-- Destroy Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is not valid.
function Get_Parent (Button_Set : in Radio_Button_Set_Type) return Root_Window_Type'Class;
-- Return the parent of Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
procedure Show (Button_Set : in Radio_Button_Set_Type;
How : in Claw.Codes.Show_Window_Type := Claw.Codes.Show_Normal);
-- Show Button_Set according to How. (All of the controls are shown
-- the same way.)
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
procedure Update (Button_Set : in Radio_Button_Set_Type);
-- Update Button_Set (forces an immediate re-paint).
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
procedure Move (Button_Set : in out Radio_Button_Set_Type;
Position : in Claw.Point_Type);
-- Changes the position of Button_Set. The position is
-- relative to the upper-left corner of the parent window's client
-- area.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
function Size (Button_Set : in Radio_Button_Set_Type)
return Claw.Size_Type;
--
-- Returns the current size of the Radio button set. This includes
-- the groupbox, if any.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
function Position (Button_Set : in Radio_Button_Set_Type)
return Claw.Point_Type;
--
-- Returns the current position of the Radio button set. This will be in
-- client coordinates of the parent window.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
procedure Set_Box_Text (Button_Set : in out Radio_Button_Set_Type;
Text : in String);
-- Set the groupbox text for Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid, or if Button_Set
-- doesn't have a groupbox.
-- Windows_Error if Windows returns an error.
function Get_Box_Text (Button_Set : in Radio_Button_Set_Type) return String;
-- Get the groupbox text for Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid, or if Button_Set
-- doesn't have a groupbox.
-- Windows_Error if Windows returns an error.
procedure Set_Text (Button_Set : in out Radio_Button_Set_Type;
Index : in Radio_Button_Index_Type;
Text : in String);
-- Set the radio button text for the Indexth button in Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
function Get_Text (Button_Set : in Radio_Button_Set_Type;
Index : in Radio_Button_Index_Type) return String;
-- Get the radio button text for the Indexth button in Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
procedure Set_Font (Button_Set : in out Radio_Button_Set_Type;
Font : in out Claw.Fonts.Font_Type);
-- Set the font for Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid, or if Font is
-- not valid.
-- Windows_Error if Windows returns an error.
function Get_Font (Button_Set : in Radio_Button_Set_Type) return Claw.Fonts.Font_Type;
-- Get the font for Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid, or it
-- uses the default font.
-- Windows_Error if Windows returns an error.
procedure Set_Default_Colors (Button_Set : in out Radio_Button_Set_Type);
-- Set Button_Set to use the default colors.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
procedure Set_Text_Color (Button_Set : in out Radio_Button_Set_Type;
Color : in Claw.Colors.Color_Type);
-- Set Button_Set to use Color as the text color (both for the buttons
-- and for the groupbox); it will use the background color of its
-- parent window.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
procedure Set_Colors (Button_Set : in out Radio_Button_Set_Type;
Text_Color : in Claw.Colors.Color_Type;
Background_Color : in Claw.Colors.Color_Type);
-- Set Button_Set to use Text_Color as the text color and Background_Color
-- as the background color.
-- Note: The color of the buttons themselves is fixed in Windows 4.x;
-- for Windows 3.x, the text color is used.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
procedure Set_Selection (Button_Set : in out Radio_Button_Set_Type;
Index : in Radio_Button_Index_Type);
-- Set the current selection for Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
function Get_Selection (Button_Set : in Radio_Button_Set_Type)
return Radio_Button_Index_Type;
-- Get the current selection for Button_Set.
-- Raises:
-- Not_Valid_Error if Button_Set is invalid.
-- Windows_Error if Windows returns an error.
procedure When_Selected (Button_Set : in out Radio_Button_Set_Type;
New_Index : in Radio_Button_Index_Type);
-- Called when a new button is selected.
-- By default, this does nothing.
-- Implementation note:
-- This is implemented by handling the BUTTON_CLICK notification
-- to When_Notify.
private
type Radio_Button_Set_Access_Type is access all Radio_Button_Set_Type'Class;
type Set_Radio_Button_Type is new Claw.Radio_Button.Radio_Button_Type with record
Set_of : Radio_Button_Set_Access_Type := null;
end record;
procedure When_Notify (Control : in out Set_Radio_Button_Type;
Code : in Claw.Notification_Code_Type;
Data : in Claw.Notification_Data_Type'Class;
Unknown_Command : in out Boolean);
-- This procedure is called just before a child control sends a
-- notification to its parent.
-- Notification_Codes are defined in the packages for the
-- various controls.
-- Data contains Data specific to the particular control.
-- If this routine does not recognize (or handle) the command, it
-- should return Unknown_Command = True. This will cause CLAW to
-- send the notification to its parent by calling When_Child_Notify.
-- See notes below on When_Child_Notify for more information.
-- Implementation note: This routine is called whenever a child control
-- sends a WM_COMMAND or WM_NOTIFY to its parent and the parent can
-- identify the child to call this routine.
type Radio_Button_Set_Array_Type is array (Radio_Button_Index_Type) of
Set_Radio_Button_Type;
type Radio_Button_Set_Type is
new Ada.Finalization.Controlled with record
-- Note: All of these components are either write-only-one-create or
-- already assignable; therefore assignment works without any special
-- work.
Is_Active : Boolean := False;
Buttons : Radio_Button_Set_Array_Type;
First_Button_Id : Identifier_Type;
Last_Button_Id : Identifier_Type;
Has_Groupbox : Boolean := False;
Groupbox : Claw.Groupbox.Groupbox_Type;
-- Size calculation components (we use this to move the set).
Button_Indent : Int := 0; -- Indent (Horiz. offset) amount for buttons.
Button_Vert_Start:Int := 0; -- Vert. offset amount for buttons.
Button_Spacing : Int := 0; -- Button spacing.
Size : Claw.Size_Type; -- Size of entire set.
end record;
-- Note:
-- We could allow Modify for styles; turning the groupbox on and off;
-- and Resizing. However, doing so would make the semantics of assignment
-- much more complex. We don't do this for now; however, if we ever write
-- a builder in Claw, we would need to add those.
end Claw.Radio_Button_Set;