with Claw.Fonts;
package Claw.Buttons is
--
-- CLAW - Class Library for Ada and Windows.
--
-- This package contains the root Button control.
-- We implement this package so that the shared code is inherited, and
-- that the shared flags are defined only once.
--
-- Copyright 1996, 1997 R.R. Software, Inc.
-- P.O. Box 1512, Madison WI 53701
-- All rights reserved.
--
-- Simplified version for demo.
pragma Elaborate_Body; -- Insure that the body is elaborated before anyone
-- can call CLAW.
-- Button class
type Root_Button_Type is abstract new CLAW.Root_Control_Type with private;
package Styles is
type Button_Style_Type is private;
-- Button Control Styles (note, these can be combined with most
-- Windows styles)
Left_Text : constant Button_Style_Type; -- Text on left, button on right.
Right_Button : constant Button_Style_Type; -- Same style as previous.
Text : constant Button_Style_Type; -- No special style.
Icon : constant Button_Style_Type; -- Icon, not text; >= Win 4.0 only
Bitmap : constant Button_Style_Type; -- Bitmap, not text; >= Win 4.0 only
Left : constant Button_Style_Type; -- Left justify text; >= Win 4.0 only
Right : constant Button_Style_Type; -- Right justify text; >= Win 4.0 only
Center : constant Button_Style_Type; -- Center text; >= Win 4.0 only
Top : constant Button_Style_Type; -- Text on top of button; >= Win 4.0 only
Bottom : constant Button_Style_Type; -- Text on bottom of button; >= Win 4.0 only
Vertically_Center : constant Button_Style_Type; -- Vertically center text; >= Win 4.0 only
Push_Like : constant Button_Style_Type; -- Make it look like a pushbutton; >= Win 4.0 only
Multiline : constant Button_Style_Type; -- Allow text to go to multiple lines; >= Win 4.0 only
Notify : constant Button_Style_Type; -- Generate additional notifications; >= Win 4.0 only
Flat : constant Button_Style_Type; -- Flat appearance; >= Win 4.0 only
function DWORD_of (s : in Button_Style_Type) return CLAW.DWORD;
-- Low-level access to styles.
function "+"(Left, Right : Button_Style_Type) return Button_Style_Type;
-- Combines two styles into a single styles value.
function "+"(Left : Claw.Styles.Window_Style_Type; Right : Button_Style_Type)
return Button_Style_Type;
-- Combines two styles into a single styles value.
function "+"(Left : Button_Style_Type; Right : Claw.Styles.Window_Style_Type)
return Button_Style_Type;
-- Combines two styles into a single styles value.
function ">="(Left, Right : Button_Style_Type) return Boolean;
function ">="(Left : Button_Style_Type; Right : Claw.Styles.Window_Style_Type)
return Boolean;
-- Read A >= B as A includes B.
-- That is, each set style in B is also in A.
function Button_Style_of (S : in DWord) return Button_Style_Type;
-- Create a style from a DWord for low-level use.
private
type Button_Style_Type is new Claw.DWord;
Left_Text : constant Button_Style_Type := 16#0020#; -- Text on left, button on right.
Right_Button : constant Button_Style_Type := 16#0020#; -- Same style as previous.
Text : constant Button_Style_Type := 16#0000#; -- No special style.
Icon : constant Button_Style_Type := 16#0040#; -- Icon, not text; >= Win 4.0 only
Bitmap : constant Button_Style_Type := 16#0080#; -- Bitmap, not text; >= Win 4.0 only
Left : constant Button_Style_Type := 16#0100#; -- Left justify text; >= Win 4.0 only
Right : constant Button_Style_Type := 16#0200#; -- Right justify text; >= Win 4.0 only
Center : constant Button_Style_Type := 16#0300#; -- Center text; >= Win 4.0 only
Top : constant Button_Style_Type := 16#0400#; -- Text on top of button; >= Win 4.0 only
Bottom : constant Button_Style_Type := 16#0800#; -- Text on bottom of button; >= Win 4.0 only
Vertically_Center : constant Button_Style_Type := 16#0C00#; -- Vertically center text; >= Win 4.0 only
Push_Like : constant Button_Style_Type := 16#1000#; -- Make it look like a pushbutton; >= Win 4.0 only
Multiline : constant Button_Style_Type := 16#2000#; -- Allow text to go to multiple lines; >= Win 4.0 only
Notify : constant Button_Style_Type := 16#4000#; -- Generate additional notifications; >= Win 4.0 only
Flat : constant Button_Style_Type := 16#8000#; -- Flat appearance; >= Win 4.0 only
end Styles;
-- Control commands:
BUTTON_CLICKED : constant Notification_Code_Type; -- Always delivered.
BUTTON_DOUBLE_CLICK : constant Notification_Code_Type; -- Always delivered.
BUTTON_SET_FOCUS : constant Notification_Code_Type; -- Only delivered if Notify style is used.
BUTTON_KILL_FOCUS : constant Notification_Code_Type; -- Only delivered if Notify style is used.
-- Note: Other notifications are obsolete; Claw does not define them.
procedure Set_Text (Button : in out Root_Button_Type;
Text : in String);
-- Set the text for Button.
-- Raises:
-- Not_Valid_Error if Button does not have a valid control,
-- or Button is not a Text control.
-- Windows_Error if Windows returns an error.
function Get_Text (Button : in Root_Button_Type) return String;
-- Get the text for Button.
-- Raises:
-- Not_Valid_Error if Button does not have a valid control,
-- or Button is not a Text control.
-- Windows_Error if Windows returns an error.
procedure Set_Font (Button : in out Root_Button_Type;
Font : in out Claw.Fonts.Font_Type);
-- Set the font for Button.
-- Raises:
-- Not_Valid_Error if Button does not have a valid control,
-- or is not a text control, or if Font is not valid.
-- Windows_Error if Windows returns an error.
function Get_Font (Button : in Root_Button_Type) return Claw.Fonts.Font_Type;
-- Get the font for Button.
-- Raises:
-- Not_Valid_Error if Button does not have a valid control,
-- uses the default font, or is not a text control.
-- Windows_Error if Windows returns an error.
type Check_Type is (UNCHECKED, CHECKED, UNKNOWN);
procedure Set_Check (Button : in Root_Button_Type;
Check : in Check_Type);
-- Set the check state for Button.
-- Raises:
-- Not_Valid_Error if Button does not have a valid control.
-- Windows_Error if Windows returns an error.
function Get_Check (Button : in Root_Button_Type) return Check_Type;
-- Get the check state for Button.
-- Raises:
-- Not_Valid_Error if Button does not have a valid control.
-- Windows_Error if Windows returns an error.
procedure Set_Push_State (Button : in Root_Button_Type;
Pushed : in Boolean);
-- Set the push state for Button.
-- Raises:
-- Not_Valid_Error if Button does not have a valid control.
-- Windows_Error if Windows returns an error.
function Is_Pushed (Button : in Root_Button_Type) return Boolean;
-- Is Button pushed?
-- Raises:
-- Not_Valid_Error if Button does not have a valid control.
-- Windows_Error if Windows returns an error.
function Is_Dialog_Button_Checked (Window : in CLAW.Root_Window_Type'Class;
Button_Id : in Identifier_Type) return Check_Type;
-- Return the button state of Button_Id.
-- Raises:
-- Not_Valid_Error if Window does not have a valid window.
-- Windows_Error if Windows returns an error.
procedure Check_Dialog_Button (Window : in CLAW.Root_Window_Type'Class;
Button_Id : in Identifier_Type;
Check : in Check_Type);
-- Check the dialog item Button_Id to the indicated check state.
-- Unknown can only be set on 3State buttons.
-- Raises:
-- Not_Valid_Error if Window does not have a valid window.
-- Windows_Error if Windows returns an error.
-- Action routines:
procedure When_Initialize (Control : in out Root_Button_Type);
-- This procedure is called when the Control object is made valid.
-- This routine can be used to initialize the object for types derived
-- from Root_Button_Type.
-- Any overriding When_Initialize should call the parent routine
-- (as with most OOP overriding routines) before they do any other
-- initialization for types derived from Root_Button_Type.
-- Implementation note: This routine is called directly by Claw when
-- Claw is creating control objects; it is not called in response to
-- any Windows message.
-- Note: Various other When_xxx routines are inherited.
-- The follow routines are mainly for Claw's use.
type Item_Kind_Type is (None, Text_Kind, Icon_Kind, Bitmap_Kind);
procedure Set_Kind (Button : in out Root_Button_Type;
Kind : in Item_Kind_Type);
-- Set the kind for Button.
function Get_Kind (Button : in Root_Button_Type) return Item_Kind_Type;
-- Get the kind for Button.
private
type Inner_RB_Data_Type is record
Item_Kind : Item_Kind_Type := None;
end record;
type Inner_RB_Access_Type is access Inner_RB_Data_Type;
type Root_Button_Type is new CLAW.Root_Control_Type with record
Data : Inner_RB_Access_Type;
end record;
-- Button Kinds
type Button_Kind_Type is new Claw.DWord;
BUTTON_CLICKED : constant Notification_Code_Type := 0; -- Always delivered.
BUTTON_DOUBLE_CLICK : constant Notification_Code_Type := 5; -- Always delivered.
BUTTON_SET_FOCUS : constant Notification_Code_Type := 6; -- Only delivered if BS_Notify style is used.
BUTTON_KILL_FOCUS : constant Notification_Code_Type := 7; -- Only delivered if BS_Notify style is used.
procedure Destroy (Button : in out Root_Button_Type);
-- Destroy Button.
-- Raises:
-- Not_Valid_Error if Button does not have a valid (Windows) window.
-- Windows_Error if Windows returns an error.
procedure Finalize (Button : in out Root_Button_Type);
-- Finalize Button.
-- (This routine is for the implicit calls made by Controlled types;
-- for explicit calls, use Destroy instead.)
end Claw.Buttons;