with Claw;
package Claw.Fonts is
--
-- CLAW - Class Library for Ada and Windows.
--
-- This package contains font objects and operations.
--
-- Copyright 1996, 1997 R.R. Software, Inc.
-- P.O. Box 1512, Madison WI 53701
-- All rights reserved.
--
type Font_Type is new Claw.Root_Tool_Type with private;
-- Normally one would declare objects like
-- Scribble : constant Font_Type := Create(...);
type Stock_Type is private;
OEM_Fixed_Font : constant Stock_Type;
Ansi_Fixed_Font : constant Stock_Type;
Ansi_Var_Font : constant Stock_Type;
System_Font : constant Stock_Type;
Device_Default_Font : constant Stock_Type; -- Windows NT only.
System_Fixed_Font : constant Stock_Type;
Default_GUI_Font : constant Stock_Type; -- Windows >= 4.0 only.
function Create (Stock : Stock_Type) return Font_Type;
-- Create a Font Object for the specified stock font.
-- Raises:
-- Windows_Error if Windows returns an error.
-- Not_Supported_Error if an unsupported font type is used.
type Degree_Type is delta 0.1 range 0.0 .. 360.0;
for Degree_Type'small use 0.1;
type Weight_Type is (Dontcare, Thin, Extra_Light, Light, Normal,
Medium, Semi_Bold, Bold, Extra_Bold, Heavy);
type Character_Set_Type is private;
ANSI :constant Character_Set_Type;
Default_Character_Set :constant Character_Set_Type;
-- This value is essentially don't care. Unexpected results may
-- occur when using this value (symbol fonts may be selected, for
-- example).
Symbol :constant Character_Set_Type;
ShiftJIS :constant Character_Set_Type;
Hangeul :constant Character_Set_Type;
ChineseBig5 :constant Character_Set_Type;
OEM :constant Character_Set_Type;
type Precision_Type is
(Default_Precision,
String_Precision,
Character_Precision,
Stroke_Precision,
TT_Precision,
Device_Precision,
Raster_Precision,
TT_Only_Precision,
Outline_Precision);
type Clip_Precision_Type is private;
Clip_Default : constant Clip_Precision_Type;
Clip_Character : constant Clip_Precision_Type;
Clip_Stroke : constant Clip_Precision_Type;
Clip_Mask : constant Clip_Precision_Type;
Clip_LH_Angles : constant Clip_Precision_Type;
Clip_TT_Always : constant Clip_Precision_Type;
Clip_Embedded : constant Clip_Precision_Type;
type Quality_Type is (Default_Quality, Draft, Proof);
type Pitch_Type is (Default_Pitch, Fixed, Variable);
type Font_Family_Type is (Dontcare, Roman, Swiss, Modern, Script, Decorative);
FACE_SIZE : constant := 32;
type Faces_Names_Type is array (1 .. FACE_SIZE) of aliased Interfaces.C.Char;
type Logical_Font_Type is record
Height : Claw.Int;
Width : Claw.Int;
Escapement : Claw.Int;
Orientation : Claw.Int;
Weight : Claw.Int;
Italic : Boolean;
Underline : Boolean;
Strikeout : Boolean;
Character_Set : Character_Set_Type;
Precision : Precision_Type;
Clip_Precision : Clip_Precision_Type;
Quality : Quality_Type;
Pitch : Pitch_Type;
Family : Font_Family_Type;
Face_Name : Faces_Names_Type; -- Fill empty characters with Nulls.
end record;
-- Note: Rep. clause in private part.
function Create (Height : in Integer := 0; -- >0 char cell height, <0 ascent height
Width : in Natural := 0;
Escapement : in Degree_Type := 0.0;
Orientation : in Degree_Type := 0.0;
Weight : in Weight_Type := Dontcare;
Is_Italic : in Boolean := False;
Is_Underline : in Boolean := False;
Is_Strikeout : in Boolean := False;
Character_Set : in Character_Set_Type := ANSI;
Precision : in Precision_Type := Default_Precision;
Clip_Precision: in Clip_Precision_Type := Clip_Default;
Quality : in Quality_Type := Default_Quality;
Pitch : in Pitch_Type := Default_Pitch;
Font_Family : in Font_Family_Type := Dontcare;
Typeface_Name : in String := "") return Font_Type;
-- Create a Font Object for a font with the specified characteristics.
-- Raises:
-- Windows_Error if Windows returns an error.
function Create (Characteristics : in Logical_Font_Type)
return Font_Type;
-- Create a Font Object for a font with the specified characteristics.
-- This routine is generally used to open an instance of the result of
-- Claw.Font_Dialog.Choose_Font.
-- Raises:
-- Windows_Error if Windows returns an error.
procedure Destroy (Font : in out Font_Type);
-- Destroy a Font object, deselecting it from any Canvases it is
-- in use in. The Font object will be invalid after this call.
-- Raises:
-- Not_Valid_Error if the Font is not valid.
-- Windows_Error if Windows returns an error.
procedure Initialize (Font : in out Font_Type);
-- Initialize Font (for Controlled types; this routine need not
-- be called explicitly).
procedure Adjust (Font : in out Font_Type);
-- Adjust Font (for Controlled types; this routine need not
-- be called explicitly).
procedure Finalize (Font : in out Font_Type);
-- Finalize Font (for Controlled types; this routine need not
-- be called explicitly).
function Get_Handle (Font : in Font_Type) return Claw.Win32.HFont;
-- Returns the Font handle for Font.
-- Use this to get a handle in order to directly call the Win32 API.
-- Use of this routine is discouraged.
-- Raises:
-- Not_Valid_Error if Font does not have a valid (Windows) Font.
private
type Character_Set_Type is new Byte;
ANSI :constant Character_Set_Type := 0;
Default_Character_Set :constant Character_Set_Type := 1;
Symbol :constant Character_Set_Type := 2;
ShiftJIS :constant Character_Set_Type := 128;
Hangeul :constant Character_Set_Type := 129;
ChineseBig5 :constant Character_Set_Type := 136;
OEM :constant Character_Set_Type := 255;
type Clip_Precision_Type is new Byte;
Clip_Default : constant Clip_Precision_Type := 0;
Clip_Character : constant Clip_Precision_Type := 1;
Clip_Stroke : constant Clip_Precision_Type := 2;
Clip_Mask : constant Clip_Precision_Type := 15;
Clip_LH_Angles : constant Clip_Precision_Type := 16;
Clip_TT_Always : constant Clip_Precision_Type := 32;
Clip_Embedded : constant Clip_Precision_Type := 64;
type Stock_Type is new Int;
OEM_Fixed_Font : constant Stock_Type := 10;
Ansi_Fixed_Font : constant Stock_Type := 11;
Ansi_Var_Font : constant Stock_Type := 12;
System_Font : constant Stock_Type := 13;
Device_Default_Font : constant Stock_Type := 14;
System_Fixed_Font : constant Stock_Type := 16;
Default_GUI_Font : constant Stock_Type := 17;
for Logical_Font_Type use record
Height at 0 range 0 .. 31;
Width at 4 range 0 .. 31;
Escapement at 8 range 0 .. 31;
Orientation at 12 range 0.. 31;
Weight at 16 range 0 .. 31;
Italic at 20 range 0 .. 7;
Underline at 21 range 0 .. 7;
Strikeout at 22 range 0 .. 7;
Character_Set at 23 range 0 .. 7;
Precision at 24 range 0 .. 7;
Clip_Precision at 25 range 0 .. 7;
Quality at 26 range 0 .. 7;
Pitch at 27 range 0 .. 3;
Family at 27 range 4 .. 7;
Face_Name at 28 range 0 .. (8*32)-1;
end record;
type Font_Type is new Claw.Root_Tool_Type with record
Is_Stock : Boolean := False;
end record;
end Claw.Fonts;