(*
/*

CLASS {AL4_font|_Delphi_VCL}, NATIVE, UNTESTED :

IMPORT: {Font} ;

NATIVE:@"uses AL4_font "
		", Forms, Graphics "
		"{$IFnDEF LINUX} , Windows {$ENDIF}"
		";" .
		
NATIVE: "///COPY AL4_font.pas" .
*/
*)
unit AL4_font;

interface

{$I AL4_options.inc}

uses Classes, Forms, Controls, Menus,
// use AL4 to access system functions (AL4.pas inserted by the compiler into
// a project folder)
     AL4,
// use All_classes from a project folder (generated for a certain project)
     All_classes,
     AL4_form, unitC_Control {to access NoneObj_C_Control},
     	StdCtrls, ExtCtrls, ComCtrls, Dialogs, Graphics
     {$IFnDEF LINUX}
     		, Windows, Messages
     {$ENDIF}
     ;

// font Functions

function Do_Create_font(X_F: Ref_obj; const X_Face: String;
         X_Size: Double): Integer;
procedure Do_Destroy_font(X_F: Integer);


function Get_font_style(Style: DynAByte): TFontStyles;

type
    TFontEx = class(TFont)
    	public Tag: {$IFDEF CPU64} Int64 {$ELSE} Integer {$ENDIF};
    end;

implementation

{$IFDEF USE_LISTS_OF_DESCRIPTORS}
var All_fonts: TList;

function alloc_font(F: TFontEx): Integer;
begin
	if All_fonts = nil then All_fonts := TList.Create;
	Result := All_fonts.IndexOf(nil);
	if Result < 0 then begin
		Result := All_fonts.Count;
		All_fonts.Add(F);
	end
		else
	All_fonts[Result] := F;
end;
{$ENDIF}

//---------------------------------------------------------------------- F O N T

(*
/*
// Create TFontEx object, return descriptor
//---------------------------------------
FUN Create_font({Font} F|ont_object, STR Face|_font,
    REAL Size|_font) ==> INT, NATIVE :
    "RESULT := Do_Create_font(X_F, X_Face{$IFDEF FPC}.Value{$ENDIF}, X_Size);" .
*/
*)
function Do_Create_font(X_F: Ref_obj; const X_Face: String;
         X_Size: Double): Integer;
var Font: TFontEx;
begin
    Font := TFontEx.Create;
	    Font.Name := X_Face;
	    Font.Height := -AL4_form.Points(X_Size);
    {$IFDEF CPU64}
    	Font.Tag := Int64(X_F);
    {$ELSE}
    	Font.Tag := Integer(X_F);
    {$ENDIF}
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := alloc_font(Font);
    {$ELSE}
    	Result := Integer(Font);
    {$ENDIF}
end;

(*
/*
// Destroy TFontEx object
//----------------------
FUN Destroy_font(INT F|ont_handle), NATIVE :
    "     Do_Destroy_font(X_F);" .
*/
*)
procedure Do_Destroy_font(X_F: Integer);
var Font: TFontEx;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Font := TFontEx(All_fonts[X_F]);
		All_fonts[X_F] := nil;
	{$ELSE}
    	Font := TFontEx(Pointer(X_F));
	{$ENDIF}
    TRY
    	Font.Free;
    EXCEPT
    END;
end;

function Get_font_style(Style: DynAByte): TFontStyles;
begin
    Result := [];
    if  Boolean(Style.GetBytes(0)) then
    	Result := Result + [fsBold];
    if  Boolean(Style.GetBytes(1)) then
    	Result := Result + [fsItalic];
    if  Boolean(Style.GetBytes(2)) then
    	Result := Result + [fsUnderline];
    if  Boolean(Style.GetBytes(3)) then
    	Result := Result + [fsStrikeOut];
end;

(*
/*
END
*/
*)
end.



