with Claw.Basic_Window,
Claw.Canvas,
Claw.Menus.Bar;
package Claw.Frame_Window is
--
-- CLAW - Class Library for Ada and Windows.
--
-- This package contains the frame 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.
Use_Default : constant Rectangle_Type := CLAW.Basic_Window.Use_Default;
-- Frame Window class
type Frame_Window_Type is new CLAW.Basic_Window.Basic_Window_Type with private;
-- Window operations:
procedure Create (Window : in out Frame_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;
Owner : in out CLAW.Root_Window_Type'Class;
Menu_Name : in String;
Exit_Id : in Menu_Identifier_Type := 0);
-- Create a window of style, extended style, and owner. The position
-- of the window will be set to Position, relative to the owner window.
-- The Menu Menu_Name will be used with the window. Exit_Id, if
-- non-zero, specifies the Id for the 'Exit' command on the menu
-- (see When_Command).
-- Raises:
-- Already_Valid_Error if the window is already open.
-- Not_Valid_Error if the owner window is not already open.
-- Windows_Error if Windows returns an error.
-- Implementation note: Windows does not allow child windows with
-- menus; do not use the Child window style with this type.
procedure Create (Window : in out Frame_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;
Menu_Name : in String;
Exit_Id : in Menu_Identifier_Type := 0);
-- Create a window of style, extended style and no owner.
-- The Menu Menu_Name will be used with the window.
-- Exit_Id, if non-zero, specifies the the Id for the 'Exit' command
-- on the menu (see When_Command).
-- Raises:
-- Already_Valid_Error if the window is already open.
-- Windows_Error if Windows returns an error.
procedure Create (Window : in out Frame_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;
Owner : in out CLAW.Root_Window_Type'Class;
Menu : in out Claw.Menus.Bar.Menu_Bar_Type'Class;
Exit_Id : in Menu_Identifier_Type := 0);
-- Create a window of style, extended style, and owner. The position
-- of the window will be set to Position, relative to the owner window.
-- The menu Menu will be used with the window. Exit_Id, if
-- non-zero, specifies the Id for the 'Exit' command on the menu
-- (see When_Command).
-- Raises:
-- Already_Valid_Error if the window is already open.
-- Not_Valid_Error if the owner window is not already open or
-- the menu is not valid.
-- Windows_Error if Windows returns an error.
-- Implementation note: Windows does not allow child windows with
-- menus; do not use the Child window style with this type.
procedure Create (Window : in out Frame_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;
Menu : in out Claw.Menus.Bar.Menu_Bar_Type'Class;
Exit_Id : in Menu_Identifier_Type := 0);
-- Create a window of style, extended style, and no owner.
-- The menu Menu will be used with the window. Exit_Id, if
-- non-zero, specifies the Id for the 'Exit' command on the menu
-- (see When_Command).
-- Raises:
-- Already_Valid_Error if the window is already open.
-- Not_Valid_Error if the menu is not valid.
-- Windows_Error if Windows returns an error.
function Has_Been_Closed (Window : in Frame_Window_Type) return Boolean;
-- Returns true when the Window has been closed, returns False otherwise.
procedure Change (Window : in out Frame_Window_Type;
Menu : in out Claw.Menus.Bar.Menu_Bar_Type'Class;
Exit_Id : in Menu_Identifier_Type := 0);
-- Change the menu for Window to Menu. Also changes the Exit_Id.
-- Raises:
-- Not_Valid_Error if the menu or window is not valid.
-- Windows_Error if Windows returns an error.
procedure Wait_for_Close (Window : in out Frame_Window_Type);
-- Wait for Window to be closed. If no processing need be done,
-- call When_Idle. When this routine returns, Window has been
-- destroyed.
-- Note: Using this routine requires Exit_Id to be set; otherwise,
-- closing the window via the menu may not cause this routine to
-- exit, and the application may hang.
-- Raises:
-- Not_Valid_Error if the window is not valid.
-- Will inherit Get_Parent, Show, Update, Destroy, Is_Valid.
-- Action routines:
-- Inherits When_Draw, When_Close, When_Other_Message,
-- 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, and When_Middle_Button_Up.
procedure When_Command (Window : in out Frame_Window_Type;
From : in Claw.Command_Source_Type;
Command_Id : in Claw.Menu_Identifier_Type;
Unknown_Command : in out Boolean);
-- This procedure is called whenever a command is received by this
-- window; the source is indicated by From, and the Id of the command
-- is indicated by Command_Id.
-- If Exit_Id is set to a non-zero value when Window is created,
-- a Command with Command_Id = Exit_Id will call When_Close rather than
-- this routine. Override When_Close for any cleanup on exit.
-- If this routine does not recognize 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 usually overridden to provide actions for the
-- commands. If it is not overridden, all commands return
-- Unknown_Command = True.
procedure When_Close (Window : in out Frame_Window_Type);
-- This procedure is called whenever a window is closed.
-- It will be called whenever the window is closed via the control
-- menu, or via the specified user Exit menu entry. Has_Been_Closed
-- returns True after this has been called.
procedure When_Idle (Window : in out Frame_Window_Type);
-- This procedure is called whenever Wait_for_Close has nothing else
-- to do. It is not called if Wait_for_Close isn't used.
-- If this routine is overridden, it should never take longer than
-- about 0.5 seconds to execute. Otherwise, the application could
-- freeze or respond sluggishly to user actions.
-- By default, this routine calls Claw.Yield.
-- Low-level access:
-- Inherits Get_Window_Handle.
private
type Inner_FW_Data_Type is record
Exited : Boolean := FALSE; -- Becomes true when When_Close is called.
Exit_Id : Claw.Menu_Identifier_Type := 0; -- Id of exit entry on menu.
end record;
type Inner_FW_Access_Type is access Inner_FW_Data_Type;
type Frame_Window_Type is new CLAW.Basic_Window.Basic_Window_Type with record
Data : Inner_FW_Access_Type;
Local_Menu_Bar : Claw.Any_Menu_Access_Type := null;
end record;
ORIGINAL_WND_PROC : 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 Destroy (Window : in out Frame_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.
procedure Finalize (Window : in out Frame_Window_Type);
-- Finalize Window and all child windows. This destroys the window,
-- but does not raise any exceptions.
-- Override inherited Creates to avoid problems:
procedure Create (Window : in out Frame_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 Frame_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.
end Claw.Frame_Window;