with Claw.Fonts;
package Claw.Static is
--
-- CLAW - Class Library for Ada and Windows.
--
-- This package contains the Static control box
--
-- 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.
-- Static class
type Static_Type is new CLAW.Root_Control_Type with private;
type Static_Kind_Type is private;
function DWord_of (S : in Static_Kind_Type) return CLAW.DWord;
-- Low-level access to kinds.
function Static_Kind_of (S : in DWord) return Static_Kind_Type;
-- Create a kind from a DWord for low-level use.
-- Static Control Kinds
Left : constant Static_Kind_Type; -- Text
Center : constant Static_Kind_Type; -- Text
Right : constant Static_Kind_Type; -- Text
Icon : constant Static_Kind_Type; -- Icon
Black_Rectangle : constant Static_Kind_Type; -- Empty
Gray_Rectangle : constant Static_Kind_Type; -- Empty
White_Rectangle : constant Static_Kind_Type; -- Empty
Black_Frame : constant Static_Kind_Type; -- Empty
Gray_Frame : constant Static_Kind_Type; -- Empty
White_Frame : constant Static_Kind_Type; -- Empty
Simple : constant Static_Kind_Type; -- Text
Left_No_Word_Wrap : constant Static_Kind_Type; -- Text
Owner_Draw : constant Static_Kind_Type; -- >= Win 4.0 only -- Empty
Bitmap : constant Static_Kind_Type;
Metafile : constant Static_Kind_Type; -- >= Win 4.0 only
Etched_Horizontal : constant Static_Kind_Type; -- >= Win 4.0 only -- Empty
Etched_Vertical : constant Static_Kind_Type; -- >= Win 4.0 only -- Empty
Etched_Frame : constant Static_Kind_Type; -- >= Win 4.0 only -- Empty
package Styles is
type Static_Style_Type is private;
-- Static Control Styles (note, these can be combined with most
-- Windows styles)
Normal : constant Static_Style_Type; -- No special style.
No_Prefix : constant Static_Style_Type;
Notify : constant Static_Style_Type; -- >= Win 4.0 only
Center_Image : constant Static_Style_Type;
Right_Justify : constant Static_Style_Type; -- >= Win 4.0 only
Real_Size_Image : constant Static_Style_Type; -- >= Win 4.0 only
Sunken : constant Static_Style_Type; -- >= Win 4.0 only
function DWORD_of (s : in Static_Style_Type) return CLAW.DWORD;
-- Low-level access to styles.
function "+"(Left, Right : Static_Style_Type) return Static_Style_Type;
-- Combines two styles into a single styles value.
function "+"(Left : Claw.Styles.Window_Style_Type; Right : Static_Style_Type)
return Static_Style_Type;
-- Combines two styles into a single styles value.
function "+"(Left : Static_Style_Type; Right : Claw.Styles.Window_Style_Type)
return Static_Style_Type;
-- Combines two styles into a single styles value.
function ">="(Left, Right : Static_Style_Type) return Boolean;
function ">="(Left : Static_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 Static_Style_of (S : in DWord) return Static_Style_Type;
-- Create a style from a DWord for low-level use.
private
type Static_Style_Type is new Claw.DWord;
Normal : constant Static_Style_Type := 16#00#;
No_Prefix : constant Static_Style_Type := 16#80#;
Notify : constant Static_Style_Type :=16#100#; -- >= Win 4.0 only
Center_Image : constant Static_Style_Type :=16#200#;
Right_Justify : constant Static_Style_Type :=16#400#; -- >= Win 4.0 only
Real_Size_Image : constant Static_Style_Type :=16#800#; -- >= Win 4.0 only
Sunken : constant Static_Style_Type:=16#1000#; -- >= Win 4.0 only
end Styles;
use type Claw.Static.Styles.Static_Style_Type;
-- Control notifications when the Notify style is used:
Static_Clicked : constant Notification_Code_Type;
Static_Double_Click : constant Notification_Code_Type;
Static_Enable : constant Notification_Code_Type;
Static_Disable : constant Notification_Code_Type;
-- These are delivered by calling When_Notify for the control and/or
-- When_Child_Notify for the parent window. The Data parameter will have
-- type Notification_Data_Type. See those routines for more information.
procedure Create (
Static : in out Static_Type;
Text : in String := "";
Parent : in out CLAW.Root_Window_Type'Class;
Kind : in Static_Kind_Type := Left;
Style : in Claw.Static.Styles.Static_Style_Type :=
Claw.Styles.Child + Claw.Static.Styles.Normal + Claw.Styles.Visible;
Extended_Style: in Claw.Styles.Extended_Window_Style_Type := Claw.Styles.None;
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 := 0);
-- Create a Static Control of style, kind, size, and parent.
-- The position will be set relative to the parent window.
-- If Size is Use_Default_Size, it will be set to the size of the
-- text for text controls, otherwise to (10,10).
-- If In_Dialog_Units is True, then Size and Position are in
-- dialog units for Parent. Otherwise, they are in pixels.
-- The Id for the control is the value specified.
-- This form is generally used for text-containing controls, or those
-- with no contents at all.
-- Raises:
-- Already_Valid_Error if the window is already valid.
-- Not_Valid_Error if the parent window is not already valid.
-- Windows_Error if Windows returns an error.
-- Not_Supported_Error if the Windows version is prior to
-- 4.0 and Kind is a new kind. (Note: Styles are not checked).
procedure Create (
Static : in out Static_Type;
Text : in String := "";
Parent : in out CLAW.Root_Window_Type'Class;
Font : in out Claw.Fonts.Font_Type;
Kind : in Static_Kind_Type := Left;
Style : in Claw.Static.Styles.Static_Style_Type :=
Claw.Styles.Child + Claw.Static.Styles.Normal + Claw.Styles.Visible;
Extended_Style: in Claw.Styles.Extended_Window_Style_Type := Claw.Styles.None;
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 := 0);
-- Create a Static Control of style, kind, font, size, and parent.
-- The position will be set relative to the parent window.
-- If Size is Use_Default_Size, it will be set to the size of the
-- text for text controls, otherwise to (10,10).
-- If In_Dialog_Units is True, then Size and Position are in
-- dialog units for Parent. Otherwise, they are in pixels.
-- The Id for the control is the value specified.
-- This form is used for text-containing controls.
-- Raises:
-- Already_Valid_Error if the window is already valid.
-- Not_Valid_Error if the parent window is not already valid.
-- Windows_Error if Windows returns an error.
-- Not_Supported_Error if the Windows version is prior to
-- 4.0 and Kind is a new kind. (Note: Styles are not checked).
procedure Modify (
Static : in out Static_Type;
Kind : in Static_Kind_Type := Left;
Style : in Claw.Static.Styles.Static_Style_Type := Claw.Static.Styles.Normal);
-- Modify an existing static control to have the new characteristics
-- specified.
-- Raises:
-- Not_Valid_Error if Static does not have a valid control.
-- Windows_Error if Windows returns an error.
-- Not_Supported_Error if the Windows version is prior to
-- 4.0 and Kind is a new kind. (Note: Styles are not checked).
-- Usage Note: Claw.Window_Operations.Move can be used change the size
-- and position of this control (since a control IS a [root_]window).
-- Claw.Window_Operations.Size and Position can be used to
-- determine the current size and position.
-- Set_Text or Set_Icon can be used to modify the other initial items.
function Has_Notify_Style (Static : in Static_Type) return Boolean;
-- Returns true if Static has the Notify style.
-- Note: Only controls with the Notify style call mouse action routines.
-- Raises:
-- Not_Valid_Error if Static does not have a valid control.
procedure Set_Text (Static : in out Static_Type;
Text : in String;
Resize : in Boolean := False);
-- Set the text for Static. Resize the control to match the text
-- size if Resize is True.
-- Raises:
-- Not_Valid_Error if Static does not have a valid control,
-- or is not a text control.
-- Windows_Error if Windows returns an error.
function Get_Text (Static : in Static_Type) return String;
-- Get the text for Static.
-- Raises:
-- Not_Valid_Error if Static does not have a valid control,
-- or is not a text control.
-- Windows_Error if Windows returns an error.
procedure Set_Font (Static : in out Static_Type;
Font : in out Claw.Fonts.Font_Type;
Resize : in Boolean := False);
-- Set the font for Static. Resize the control for the changed
-- font size if Resize is True.
-- Raises:
-- Not_Valid_Error if Static 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 (Static : in Static_Type) return Claw.Fonts.Font_Type;
-- Get the font for Static.
-- Raises:
-- Not_Valid_Error if Static does not have a valid control,
-- uses the default font, or is not a text control.
-- Windows_Error if Windows returns an error.
procedure Set_Default_Colors (Static : in out Static_Type);
-- Set Static to use the default colors.
-- Raises:
-- Not_Valid_Error if Static does not have a valid control.
procedure Set_Text_Color (Static : in out Static_Type;
Color : in Claw.Colors.Color_Type);
-- Set Static to use Color as the text color; it will use the
-- background color of its parent window. Color should be a solid color.
-- Raises:
-- Not_Valid_Error if Static does not have a valid control.
procedure Set_Colors (Static : in out Static_Type;
Text_Color : in Claw.Colors.Color_Type;
Background_Color : in Claw.Colors.Color_Type);
-- Set Static to use Text_Color as the text color and Background_Color
-- as the background color. Both Text_Color and Background_Color should
-- be a solid color.
-- Raises:
-- Not_Valid_Error if Static does not have a valid control.
-- Action routines:
procedure When_Initialize (Control : in out Static_Type);
-- This procedure is called when the Control object is made valid.
-- 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 Static_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.
procedure When_Draw (Control : in out Static_Type;
Canvas : in out Root_Canvas_Type'Class;
Draw_Info : in Claw.Owner_Draw.Owner_Draw_Info_Type;
Use_Default: in out Boolean);
-- This procedure is called whenever an owner draw control needs
-- to be drawn. Draw_Info contains information about what to draw;
-- Canvas is the canvas to draw on. Use_Default should be set to
-- true if this routine did the necessary drawing, and false otherwise.
-- The default version of this routine always executes the default
-- action.
-- Implementation notes: This routine is called in response to the
-- WM_DRAWITEM message for controls; this message goes to the
-- parent object, but Claw redirects it here. Windows requires
-- Canvas to be left in its default state; Claw will reset it
-- to that state when this routine exits.
-- Implementation note:
-- Unless the Notify style is specified when the control is created,
-- the mouse action routines (When_Mousemove, When_Right_Button_Down, etc.)
-- are never called for a static control. The mouse movements are passed
-- directly to the parent window.
private
type Item_Kind_Type is (None, Text, Icon_Kind, Bitmap_Kind, Metafile_Kind);
type Inner_S_Data_Type is record
Item_Kind : Item_Kind_Type := None;
end record;
type Inner_S_Access_Type is access Inner_S_Data_Type;
type Static_Type is new CLAW.Root_Control_Type with record
Data : Inner_S_Access_Type;
end record;
-- Static Kinds
type Static_Kind_Type is new Claw.DWord;
Left : constant Static_Kind_Type := 16#00#;
Center : constant Static_Kind_Type := 16#01#;
Right : constant Static_Kind_Type := 16#02#;
Icon : constant Static_Kind_Type := 16#03#;
Black_Rectangle : constant Static_Kind_Type := 16#04#;
Gray_Rectangle : constant Static_Kind_Type := 16#05#;
White_Rectangle : constant Static_Kind_Type := 16#06#;
Black_Frame : constant Static_Kind_Type := 16#07#;
Gray_Frame : constant Static_Kind_Type := 16#08#;
White_Frame : constant Static_Kind_Type := 16#09#;
--User_Item : constant Static_Kind_Type := 16#0A#; -- This is obsolete
Simple : constant Static_Kind_Type := 16#0B#;
Left_No_Word_Wrap : constant Static_Kind_Type := 16#0C#;
Owner_Draw : constant Static_Kind_Type := 16#0D#; -- >= Win 4.0 only
Bitmap : constant Static_Kind_Type := 16#0E#;
Metafile : constant Static_Kind_Type := 16#0F#; -- >= Win 4.0 only
Etched_Horizontal : constant Static_Kind_Type := 16#10#; -- >= Win 4.0 only
Etched_Vertical : constant Static_Kind_Type := 16#11#; -- >= Win 4.0 only
Etched_Frame : constant Static_Kind_Type := 16#12#; -- >= Win 4.0 only
-- Control commands when the Notify style is used:
Static_Clicked : constant Notification_Code_Type := 0;
Static_Double_Click : constant Notification_Code_Type := 1;
Static_Enable : constant Notification_Code_Type := 2;
Static_Disable : constant Notification_Code_Type := 3;
procedure Destroy (Static : in out Static_Type);
-- Destroy Static.
-- Raises:
-- Not_Valid_Error if Static does not have a valid (Windows) window.
-- Windows_Error if Windows returns an error.
procedure Finalize (Static : in out Static_Type);
-- Finalize Static.
-- (This routine is for the implicit calls made by Controlled types;
-- for explicit calls, use Destroy instead.)
end Claw.Static;