with Ada.Unchecked_Conversion, Claw.Canvas, Claw.Brushes;
package Claw.Basic_Window is
--
-- CLAW - Class Library for Ada and Windows.
--
-- This package contains the basic window class.
--
-- Copyright 1996, 1997 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 main callback routine).
Window_use_Default : constant Int := -16#8000_0000#;
Use_Default : constant Rectangle_Type := (Left | Right | Top | Bottom =>
Window_use_Default);
-- Basic Window class
type Basic_Window_Type is new Root_Window_Type with private;
-- Window operations:
procedure Create (Window : in out Basic_Window_Type;
Window_Name : in String;
Style : in Claw.Styles.Window_Style_Type := Claw.Styles.Overlapped_Window;
Extended_Style : in Claw.Styles.Extended_Window_Style_Type := Claw.Styles.None;
Position : in Rectangle_Type := Use_Default;
Parent : in out Root_Window_Type'Class);
-- Create a window of style, extended style, and parent.
-- The position of the window will be set to Position, relative to the
-- parent window.
-- Raises:
-- Already_Valid_Error if the window is already open.
-- Not_Valid_Error if the parent window is not already open.
-- Windows_Error if Windows returns an error.
procedure Create (Window : in out Basic_Window_Type;
Window_Name : in String;
Style : in Claw.Styles.Window_Style_Type := Claw.Styles.Overlapped_Window;
Extended_Style : in Claw.Styles.Extended_Window_Style_Type := Claw.Styles.None;
Position : in Rectangle_Type := Use_Default);
-- Create a window of style and extended style with no parent
-- (an 'orphan' window). The position of the window will be set
-- to Position.
-- Raises:
-- Already_Valid_Error if the window is already open.
-- Windows_Error if Windows returns an error.
-- Inherits Get_Parent, and Update.
procedure Show (Window : in Basic_Window_Type;
How : in Claw.Codes.Show_Window_Type := Claw.Codes.Show_Normal);
-- Show Window according to How. Use How = Show_Startup on the
-- first call to this routine for the main application window.
-- Raises:
-- Not_Valid_Error if Window does not have an open (Windows) window.
-- Windows_Error if Windows returns an error.
procedure Destroy (Window : in out Basic_Window_Type);
-- Destroy Window and all child windows.
-- Raises:
-- Not_Valid_Error if Window does not have an open (Windows) window.
-- Windows_Error if Windows returns an error.
-- Operations:
procedure Set_Name (Window : in Basic_Window_Type;
Name : in String);
-- Set the current window name.
-- Raises:
-- Not_Valid_Error if Window does not have an open (Windows) window.
-- Windows_Error if Windows returns an error.
function Get_Name (Window : in Basic_Window_Type) return String;
-- Returns the current window name.
-- Raises:
-- Not_Valid_Error if Window does not have an open (Windows) window.
-- Windows_Error if Windows returns an error.
procedure Set_Background_Brush (Window : in out Basic_Window_Type;
Brush : in out Claw.Brushes.Brush_Type);
-- Set the Background brush for Window.
-- Raises:
-- Not_Valid_Error if Window does not have an open (Windows) window,
-- or if Brush is not valid.
procedure Set_Default_Background (Window : in out Basic_Window_Type);
-- Set the background to the default color.
-- Raises:
-- Not_Valid_Error if Window does not have an open (Windows) window.
function Get_Background_Brush (Window : in Basic_Window_Type) return
Claw.Brushes.Brush_Type;
-- Get the Background brush for Window.
-- Raises:
-- Not_Valid_Error if Window does not have an open (Windows) window,
-- or if the window is using the default background.
-- Window information:
function Is_Valid (Window : in Basic_Window_Type) return Boolean;
-- Is Window Valid? This means that the internal data structures
-- and Win32 structures are initialized and valid.
-- Action routines:
procedure When_Draw (Window : in out Basic_Window_Type;
Easel : in out Claw.Canvas.Basic_Canvas_Type'Class;
Erase_Background : in Boolean;
Area : in Claw.Rectangle_Type);
-- This procedure is called whenever a section of the current
-- window needs to be (re)drawn. Easel is an open canvas object
-- for the appropriate window area. Erase_Background is true if the
-- background needs to be erased. Area is the area to redraw.
-- If not overridden, this routine does nothing.
-- Implementation notes: This routine handles WM_PAINT.
-- We have to use Basic_Canvas_Type here, so that the user has
-- access to the various selection routines.
procedure When_Close (Window : in out Basic_Window_Type);
-- This procedure is called whenever a window is closed.
-- By default, this routine calls Destroy_Window.
-- Implementation note: This routine handles WM_CLOSE.
procedure When_Child_Notify (Window : in out Basic_Window_Type;
Code : in Notification_Code_Type;
Data : in Notification_Data_Type'Class;
Control : in out Root_Control_Type'Class;
Unknown_Command : in out Boolean);
-- This procedure is called whenever a child control sends a notification
-- to Window. The specification notification is specified by Code,
-- and Control is the control's Claw object.
-- Notification_Codes are defined in the packages for the
-- various controls.
-- If this routine does not recognize (or handle) the command, it
-- should return Unknown_Command = True. This will cause CLAW to
-- exceute the default action for the command, usually nothing
-- (but some system commands do have default actions).
-- This routine is often overridden to provide actions for the
-- notifications. If it is not overridden, all commands return
-- Unknown_Command = True.
-- Implementation notes: This routine handles some cases of the
-- WM_COMMAND message and the WM_NOTIFY message. If the
-- WM_COMMAND or WM_NOTIFY message is from a
-- control, but Claw cannot identify a control object for the
-- message, it will execute the default action. This can happen
-- only if some action is taken outside of Claw: a control is
-- created in a Claw window by some non-Claw means, or if a
-- control command is sent from a non-control.
-- We don't pass the Id parameter; this can be retrived by
-- calling Get_Identifier(Control) or by retriving it from Data.
procedure When_Other_Message (Window : in out Basic_Window_Type;
The_Message : in Claw.Win32.Short_Message_Record;
Do_Default : in out Boolean;
Result : out Claw.Win32.LResult);
-- This procedure is called when any unhandled message is passed to
-- a window. If Do_Default is returned False, it returns Result
-- from the wnd_proc, otherwise the default action is performed.
-- When_Create, When_Resize, When_Character, When_Key_Down,
-- When_System_Character, When_System_Key_Down, When_Left_Button_Double_Click,
-- When_Right_Button_Double_Click, When_Middle_Button_Double_Click,
-- When_Left_Button_Down, When_Right_Button_Down, When_Middle_Button_Down,
-- When_Left_Button_Up, When_Right_Button_Up, When_Middle_Button_Up,
-- When_Horizontal_Scroll, and When_Vertical_Scroll
-- are inherited from Root_Window_Type.
private
type Basic_Window_Type is new Root_Window_Type with null record;
CHILD_DATA : constant Int := 0;
-- An available long in the Window extra memory for use by children.
-- Pass this to Get_Window_Long and Set_Window_Long.
procedure Finalize (Window : in out Basic_Window_Type);
-- Finalize Window and all child windows.
end Claw.Basic_Window;