(*
/*

//-------------- {Windows} - wrapper for {Control} and {Form}

CLASS {AL4_form|s_Delphi_VCL}, NATIVE, UNTESTED :
IMPORT: {Screen}, {Form}, {Control}, {Listbox}, {Geometry}, {Dialog} .     
IMPORT, ANYWAY: {String_functions}, {System_functions} .
IMPORT, ANYWAY: {Long_operation}, {Fake_parameters} .

NATIVE:@"uses "
		"		Forms, Controls, Graphics, StdCtrls, ExtCtrls, "
		"		{$IFDEF LINUX}"
		"			LCLIntf,"
		"		{$ELSE} "
		"			Windows, Messages,"
		"			{$IFDEF FPC} Win32Int, InterfaceBase, {$ENDIF}"
		"		{$ENDIF} "
		"	  AL4_form, AL4_drawing"
		";" .
		
NATIVE: "{$I AL4_options.inc}" .
NATIVE: "///COPY AL4_options.inc" .

FUN out_system_stack, UNCOOKED, DEBUG :.

*/
*)
unit AL4_form;

//{$DEFINE DEBUG}

//{$DEFINE SWIPE_FORMS} // uncomment to test on desktops
//{$DEFINE BOTTOM_LAST}
//{$DEFINE SCROLLED_COLUMNS}

{$I AL4_options.inc}

interface

{$I AL4_options.inc} ////////////////////////////////

uses
	SysUtils, Classes, Forms, Controls, Menus, Graphics,
// use AL4 to access system functions (AL4.pas inserted by the compiler into
// a project folder)
     AL4, System_functions, UnitC_System_functions,
// use All_classes from a project folder (generated for a certain project)
     All_classes,
     StdCtrls, ExtCtrls, ComCtrls, Dialogs 
     {$IFDEF FPC} , LCLType
     	{$IFDEF LINUX}
     			, LCLIntf
     	{$ELSE} , win32int, interfacebase
     	{$ENDIF} 
     {$ENDIF}
     {$IFDEF LINUX} , NATIVE_String_functions, StrUtils
     {$ELSE} 
     	, Windows, Messages, ShellAPI
     {$ENDIF}
     , unitC_Form
//?{Long_operation}
    , unitC_Long_operation
//.
//?{Fake_parameters}
	, unitC_Fake_parameters
//.
     ;


function InchesToPixels(C: TCanvas; inches: Double): Double;

{$IFDEF SWIPE_FORMS}
type
	TVerticalConfiguration = (vcTop_Center_Bottom, vcTop_Center, vcCenter_Bottom,
		vcCenter);
{$ENDIF}


function Is_mobile_screen: Boolean;

function Form_native_handle(
H: Integer): Integer;

type
	TRectF = record
		f_X, f_Y: Double;
		f_Width: Double;
		f_Height: Double; 
	end;

    TAL4Column = class;
    TAnimation_timer = class;
    TTrayPanel = class;
    
// class Form to represent any designed form on the Delphi side
    TAL4Form = class( TForm )
    public
    	queried_end_session: Boolean;
    	//When_ready: TAL4Form;
    	{$IFnDEF LINUX}
    	
    	procedure WMQueryEndSession(var M: TMessage); message WM_QUERYENDSESSION;
    	
    	{$ENDIF}
        procedure Event_CloseQuery(Sender: TObject; var CanClose: Boolean);
        procedure Event_Close(Sender: TObject; var AAction: TCloseAction);
        procedure Event_OnDestroy(Sender: TObject);
        {$IFDEF FPC}
        {$IFnDEF LINUX}
        procedure ProcessResource;override;
        {$ENDIF}
        {$ENDIF}
    public
        AL4Object: Ref_obj;
		created: Boolean;

        Hidden: Boolean;
        Columns: TList;
        procedure Add_column(ACol: TAL4Column);
    public
        No_borders: Boolean;
        shown: Boolean;
        
		Borderless: Boolean;
    	//Is_httransparent: Boolean;
    public
		mouse_down_to_move: TTimer;
		mouse0: TPoint; 
				// mouse down position on form
		pos0: TPoint;
				// form position when mouse down to move
		delta0: TPoint;
		ignore_close_event: Boolean;
    	procedure timer_moving_form(Sender: TObject);
	public

        click_disabled: Boolean;
        Popup_point: TRectF;
        Mouse_point: TRectF;
        Mouse_button: Integer;
    public Last_time_wheel: DWORD;
        
        Mouse_wheel_vertical: Double;
        Mouse_wheel_horizontal: Double;
        
        MenuPanel_to_destroy: TObject;
        Default_button: TButton;
        Cancel_button: TButton;
       
        HCurrent_column_handle: Integer;
        function Get_current_column_handle: Integer;
        function Get_current_column: TAL4Column;

        constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0);
         	 override; 
    public
    	procedure Set_active_control(C: TControl);
    public
        ControlsHandlingNavigationKeys: TList;
        Controls_to_set_foreground_on_show: TList;
        Controls_foreground_on_show: TList;
        {$IFNDEF FPC}
        procedure DialogKey(var Msg: TWMKey); message CM_DIALOGKEY;
        {$ENDIF}
        destructor Destroy; override;
    public
        procedure Control_clicked(Sender: TObject);
        procedure Control_changed(Sender: TObject);
        procedure Selection_changed(Sender: TObject);
        procedure Listview_changed(Sender: TObject; Item: TListItem;
                  Change: TItemChange);
        procedure Form_clicked(Sender: TObject);
        procedure Control_resized(Sender: TObject);
        {$IFDef FPC}
        procedure Form_resized(Sender: TObject);
        procedure Form_moved(Sender: TObject);
        {$ELSE}
        procedure Form_resized(var M: TMessage); message WM_SIZE;
        procedure Form_moved(var M: TMessage); message WM_MOVE;
        {$ENDIF}
        procedure Adjust_columns;
    public
        //---------------------- 'mouse'
        LastTimeMouseUp: DWORD;
        LastMouseUp: TPoint;
        is_control_mouse_event: Boolean;
        procedure Control_mouse_move(Sender: TObject; Shift: TShiftState;
        		  X, Y: Integer);
        procedure Form_mouse_move(Sender: TObject; Shift: TShiftState;
                  X, Y: Integer);
        procedure Control_mouse_down(Sender: TObject; Button: TMouseButton;
                  Shift: TShiftState; X, Y: Integer);
        procedure Form_mouse_down(Sender: TObject; Button: TMouseButton;
                  Shift: TShiftState; 
                  X, Y: Integer);
//{$DEFINE SIMULATE_LONG_TAP_RMB}
        {$IFDEF SIMULATE_LONG_TAP_RMB}
        procedure Form_long_tap(Sender: TObject);
        {$ENDIF}
        
{$IFDEF SWIPE_FORMS}
	public
		Top_visible_column: Integer;
		Bottom_visible_col: Integer;
		Left_visible_column: Integer;
		Mobile_configuration: Integer; //0-single_top_bottom, 1-all_top_bottom
		Indicator_top_u, Indicator_top_d,
		Indicator_bottom_u, Indicator_bottom_d,
		Indicator_left, Indicator_right: TPanel;
		procedure Mouse_down_timer_tick(Sender: TObject);
		procedure handle_swipe_move(P: TPoint);
		procedure handle_swiped;
{$ENDIF}
        procedure Control_mouse_up(Sender: TObject; Button: TMouseButton;
                  Shift: TShiftState;
                  X, Y: Integer);
        procedure Form_mouse_up(Sender: TObject; Button: TMouseButton;
                  Shift: TShiftState; X, Y: Integer);
        procedure Control_mouse_double_click(Sender: TObject);
        procedure Form_mouse_double_click(Sender: TObject);
        procedure do_Form_mouse_double_click(Sender: TObject);
        procedure Form_mouse_wheel(Sender: TObject; Shift: TShiftState;
                  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
        {$IFnDEF FPC}
        procedure Column_resize(Sender: TObject);
        {$ENDIF}
        //------------------------ 'keyboard'
        procedure Control_key_down(Sender: TObject; var Key: Word;
                  Shift: TShiftState);
        procedure Control_key_up(Sender: TObject; var Key: Word;
                  Shift: TShiftState);
        procedure Control_key_press(
        		  {$IFDEF FPC}
				  Sender: TObject; var Key: TUTF8Char
				  {$ELSE}
				  Sender: TObject; var Key: Char
				  {$ENDIF}
				  );
        procedure Control_enter(Sender: TObject);
        procedure Control_leave(Sender: TObject);
        {$IFDef FPC}
        function default_cancel_button(F: C_Form; Key: TUTF8Char): Boolean;
        {$ENDIF}
        //------------------------ 'timer'
        procedure Form_timer_tick(Sender: TObject);
        procedure DefaultHandler(var Message); override;
    public
        TrayIcons: TList;
        Control_timers: TList;
        procedure DestroyWnd; override;
        //procedure Erasing_form(Sender: TObject);
    public
    	was_Shown: Boolean;
    	Called_FormClosed: Boolean;
        procedure FormClosed;
        {$IFDef FPC}
        procedure Form_Shown(Sender: TObject);
        procedure Form_activate(Sender: TObject);
        procedure Form_deactivate(Sender: TObject);
        {$ELSE}
        procedure Form_Shown(var M: TMessage); message WM_SHOWWINDOW;
        procedure Form_activate(var M: TWMActivate); message WM_ACTIVATE;
        {$ENDIF}
    public
    	Control_redirect_keys: TControl;
    protected
        procedure Form_key_down(Sender: TObject; var Key: Word;
        		  Shift: TShiftState);
        procedure Form_key_up(Sender: TObject; var Key: Word;
                  Shift: TShiftState);
        {$IFDEF FPC}
        procedure Form_UTF8key_press(Sender: TObject; var Key: TUTF8Char);
        {$ELSE}
        procedure Form_key_press(Sender: TObject; var Key: Char);
        {$ENDIF}
    public 
    	can_handle_another_instance_notify: Boolean;
    	{$IFNDEF LINUX}
    	procedure WndProc(var Message: TMessage); override;
    	{$ENDIF}
    public
    	//------------------------- 'drop files'
//?{Form}.accept
		//drag_accepted: Boolean;
        {$IFDEF FPC}
        procedure Form_DropFiles(Sender: TObject;
        	const FileNames: array of String); 
        {$ELSE}
        procedure WMDropFiles(var DropMsg: TWMDropFiles); message WM_DROPFILES;
        {$ENDIF}
	protected
        procedure CreateWnd; override;
//.
		{$IFNDEF LINUX}
        procedure CreateParams(var Params: TCreateParams); override;
		procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
		{$ENDIF}
    end;
    

// class to represent a column (which is a panel to place controls on it)
	TAL4Column = class({$IFDEF SCROLLED_COLUMNS}TScrollBox{$ELSE}TPanel{$ENDIF})
    public
    	AL4Form: TAL4Form;
    	Layout: Integer;
    	Nested_in_column: Integer;
        Alias: String;
        Label_width: Integer; // in pixels
        ListControls: TList;
        Horizontal: Boolean;
        suspend_count: Integer;
        adjusting_controls: Boolean;
        auto_arrange: Boolean;
        controls_layout: Integer;
        No_margins: Boolean;
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        //procedure Resize; override;
    {$IFDEF SWIPE_FORMS}
    public
    	save_width, save_height: Integer;
    {$ENDIF}
    end;

// class to access protected properties of TControl
    THackControl = class(TControl)
    public
        property Font; 
        		 // it seems not all styled controls have Font property in FMX
        property Color;
    end;

    THackButton = class(TButton)
    public
    	{$IFnDEF LINUX}
        procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;
        {$ENDIF}
    end;

    THackWinControl = class(TWinControl)
    end;

// class to store menu
    TMenuPanel = class(TPanel)
    public
        Form_: TAL4Form;
        MenuObject: TPopupMenu;
        AliasesList: TStringList;
        AllItemsList: TList;
        Ready: Boolean;
        Track: Boolean;
        Alias: String;
        mp_destroying: Boolean;
        procedure Item_click(Sender: TObject);
        destructor Destroy; override;
    end;
    
// class to store timer
    TTimerPanel = class(TPanel)
        TimerObject: TTimer;
    public
        destructor Destroy; override;
    end;
    
// class to store tray icon component
    TTrayPanel = class(TPanel)
    public
        Form: TAL4Form;
        {$IFDEF FPC}
        ti: TTrayIcon;
        function Active: Boolean;
    public
    	{$ELSE}
        Active: Boolean;
        ID: Integer;
        tp_Text: String;
    	{$ENDIF}
        IconObject: TIcon;
    public
    	constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure HandleTrayMessage(Button: TMouseButton; Shift: TShiftState);
    end;    
    
// class to provide animation timer in a control
    TAnimation_timer = class(TTimer)
    public
        Form: TAL4Form;
        Ref_control: Ref_obj;
        Counter: Integer;
        Last_counter: Integer;
        Control_handle: Integer;
        constructor Create(X_H, X_Count, X_Interval: Integer); reintroduce;
        procedure Tick_timer(Sender: TObject);
        procedure Stop_timer;
    end;
    
function Form_client_width(F: TAL4Form): Integer;
function Form_client_height(F: TAL4Form): Integer;

procedure Prepare_mouse_point_button(
	Form: TAL4Form; Button: TMouseButton; 
    do_Button: Boolean; CF: C_Form; Shift: TShiftState);


// convert points --> pixels (most things in AL4 are measured in points)
function Points(pts: Double): Integer;

// convert pixels into points
function Pixels{ToPoints}(pix: Double): Double;

// functions to work with Form
function Do_Form_create(X_F: Ref_obj): Integer;
procedure Do_destroy_form(H: Integer);
procedure Do_form_close(X_H: Integer);
function Do_Get_form_visible(H: Integer): Boolean;
procedure Do_show_hide(H: Integer; Show: Boolean);
procedure Do_show_noactivate(H: Integer);
procedure Do_show_modal(H, P: Integer);

function Do_Get_form_caption(H: Integer): String;
procedure Do_Set_form_caption(H: Integer; const V: String);

function Do_get_form_left(H: Integer): Double;
function Do_get_form_top(H: Integer): Double;
procedure Do_set_form_pos(H: Integer; X_L, X_T: Double);
function Do_get_form_width(H: Integer): Double;
function Do_get_form_height(H: Integer): Double;
procedure Do_set_form_size(H: Integer; X_W, X_H: Double);
procedure Do_set_form_min_size(H: Integer; X_Wmin, X_Hmin: Double);
procedure Do_Set_form_no_frame(X_F: Integer; X_No_frame: Boolean);
procedure Do_Set_form_columns_no_borders(X_F: Integer; X_No_borders: Boolean);
procedure Do_Set_form_alpha_tran(X_F: Integer; X_Tran: Double);

// functions to work with Columns
procedure Do_Set_form_current_column_handle(H, Col: Integer);

{$IFDEF USE_LISTS_OF_DESCRIPTORS}
var Column_descr: TList;
{$ENDIF}

function Do_Create_column(
		H: Integer; Layout: Integer; Width: Double; Label_w: Double; 
		Nested_in: Integer): Integer;
procedure Do_Set_column_label_width_limit(HC: Integer; const LabW: Double);
procedure Do_Set_column_width(HC: Integer; const Width: Double);
procedure Do_Set_column_height(HC: Integer; const Height: Double);

procedure Do_Set_column_alias(HC: Integer; const Alias: String);
function Do_Get_column_handler(F: Integer; Index: Integer): Integer;
function Do_Get_column_width(X_C: Integer): Double;
function Do_Get_column_height(X_C: Integer): Double;
function Do_Get_parent_column_left(X_C: Integer): Double;
function Do_Get_parent_column_visible(X_C: Integer): Boolean;
function Do_Get_parent_column_top(X_C: Integer): Double;
function ParentColumn(C: TControl): TAL4Column;

function Do_Get_column_visible(X_C: Integer): Boolean;
function Do_Get_column_hidden(X_C: Integer): Boolean;
procedure Do_Set_column_visible(X_C: Integer; X_V: Boolean);
procedure Do_Set_horizontal(H: Integer);
procedure do_destroy_control(X_Contr: Integer);

// functions handling controls
function Do_Obtain_active_control(H: Integer): Ref_obj;
procedure Do_Activate_control(H: Integer; X: Integer);
procedure Do_Make_visible(H: Integer; C: Integer);

function Do_get_control_left(H: Integer): Double;
function Do_get_control_top(H: Integer): Double;
procedure Do_Set_control_pos(H: Integer; X, Y: Double);

function Do_Is_autosized_control(H: Integer): Boolean;
function Do_get_control_width(H: Integer): Double;
function Do_Get_label_desired_width(H: Integer): Double;
function Do_get_control_height(H: Integer): Double;
procedure Do_Set_control_size(H: Integer; Width, Height: Double);
procedure Do_Set_control_caption(H: Integer; const Text: String);
function Do_Get_control_caption(H: Integer): String;

function Do_Get_disabled(H: Integer): Boolean;
procedure Do_Set_disabled(H: Integer; B: Boolean);
function Do_Get_hidden(H: Integer): Boolean;
procedure Do_Set_hidden(H: Integer; B: Boolean);


procedure Do_list_fonts(Op: Integer; X_Names: DynAStr);

procedure Do_show_message(H: Integer; const s: String);
function Do_ask_yes_no(H: Integer; const s: String): Boolean;
procedure Adjust_control_location(
	Column: TAL4Column; C_new: TControl);
procedure Set_control_events(Parent: TAL4Column; C: TControl);
procedure Set_Win_control_events(Parent: TAL4Column; C: TControl);
procedure Do_set_capture(X_H: Integer);

function form_from_handle(H: Integer): TAL4Form;

// certain controls functions
function Do_Create_label(P: Integer; X_L: Pointer): Integer;

function Do_Create_button(P: Integer; X_B: Pointer): Integer;

function Do_Create_checkbox(P: Integer; X_C: Pointer): Integer;

function Do_Create_edit(P: Integer; X_E: Pointer; X_Password: String;
    X_Readonly: Boolean): Integer;
function Do_Get_edit_selection(X_E: Integer): String;
procedure Do_Set_edit_selection(X_E: Integer; const X_Text: String);
procedure Do_Set_edit_max_len(X_E: Integer; X_V: Integer);
procedure Do_Set_edit_password_char(X_E: Integer; const X_V: String);

// memo functions
function Do_Create_memo(P: Integer; X_M: Pointer;
    X_Read, NoH, NoV, Center: Boolean): Integer;
function Do_Get_memo_item(X_M: Integer; Row: Integer): String;
procedure Do_Set_memo_item(X_M: Integer; Row: Integer; const Value: String);
function Do_Get_memo_selection(X_M: Integer): String;
procedure Do_Set_memo_selection(X_M: Integer; const X_Text: String);
function Do_Get_memo_count_lines(X_M: Integer): Integer;
procedure Do_Set_memo_max_len(X_M: Integer; X_V: Integer);

// Listbox
function Do_Create_listbox(P: Integer; X_L: Ref_obj; 
         X_Multiselect: Boolean): Integer;

// combobox functions
function Do_Create_combo(P: Integer; X_C: Pointer): Integer;
procedure Do_Set_combo_items(X_C: Integer; const X_V: String);
function Do_Get_combo_count_items(X_C: Integer): Integer;
function Do_Get_combo_item(X_C: Integer; X_Row: Integer): String;
procedure Do_Set_combo_item(X_C: Integer; X_Row: Integer; const X_V: String);
function Do_Find_combo_item(X_C: Integer; const X_F: String): Integer;
function Do_Add_combo_item(X_C: Integer; const X_A: String): Integer;
procedure Do_Insert_combo_item(X_C: Integer; X_I: Integer; const X_A: String);
function Do_Get_combo_current_index(X_C: Integer): Integer;
procedure Do_Set_combo_current_index(X_C: Integer; X_Index: Integer);
function Do_Get_combo_selection(X_C: Integer): String;
procedure Do_Set_combo_selection(X_C: Integer; const X_Text: String);
procedure Do_Set_combo_max_len(X_C: Integer; X_V: Integer);

// Progress bar functions
function Do_Create_progress_bar(P: Integer; X_P: Pointer): Integer;
function Do_Get_progress_bar_progress(X_P: Integer): Double;
procedure Do_Set_progress_bar_progress(X_P: Integer; X_V: Double);
function Do_Get_progress_bar_maximum(X_P: Integer): Double;
procedure Do_Set_progress_bar_maximum(X_P: Integer; X_V: Double);
function Do_Get_progress_bar_minimum(X_P: Integer): Double;
procedure Do_Set_progress_bar_minimum(X_P, X_V: Integer);

// menu functions
function Do_create_menu(P: Integer; X_V: DynAStr): TMenuPanel;
procedure Do_Destroy_menu(MP: TMenuPanel);
procedure Do_Popup_menu(X_F: Integer; X_M: DynAStr; X, Y: Double);

// timer functions
function Do_create_timer(P: Integer; X_T: Pointer): Integer;
procedure Do_Set_timer_interval(X_T, X_V: Integer);
procedure Do_Set_timer_active(X_T: Integer; X_A: Boolean);
procedure Do_timeBeginPeriod(p: Integer);
procedure Do_timeEndPeriod(p: Integer);

var Main_form_index: Integer;
var Main_form_handle: Integer;
{$IFnDEF LINUX}
var Main_form_window_handle: THandle;
{$ENDIF}

{$IFnDEF LINUX}

procedure Nim_operation(Wnd: HWND; ID: Integer; op: Char; Icon: HIcon;
    const Text: String);

{$ENDIF}

type
	TScreen_handler = class(AL4_handler)
		Ref_scr: Ref_obj;
		constructor Create(X_Screen: Ref_obj);
		procedure Handler; override;
		procedure Exception_handler(Sender: TObject; E: Exception);
	end;
	
var Allow_handle_events: Integer = 1;
	
// all monitor displays
procedure List_screen_monitors;
function Count_screen_monitors: Integer;

function register_instance(const X_Uniq, X_Command_line: String): Boolean;
procedure unregister_instance;
procedure main_form_running(X_M: Ref_obj);

function HackControl(Handle: Integer): THackControl;
function XPos(C: TControl): Integer;
function YPos(C: TControl): Integer;
procedure SetPos(C: TControl; X, Y: Integer);

{$IFDEF USE_LISTS_OF_DESCRIPTORS}
var All_controls: TList;
	All_forms: TList;
procedure release_control(C: TControl);
function allocate_control(C: TControl): Integer;
{$ENDIF}


procedure operation_started(
	op: Integer; f: C_Form; c: Ref_obj);

procedure operation_ended(
	op: Integer; f: C_Form);
	
function ref_obj_from_control(C: TControl): Ref_obj;



var Monitors_stored: TList;

var Last_time_active: TDateTime;

function call_do_long_operation(X_Caller: Ref_obj; X_Exist: Ref_obj): Ref_obj;
procedure do_begin_animation(X_H: Integer; X_Count: Integer; X_Interval: Integer);

var ignore_resize: Boolean;
var column_padding: Integer = {$IFDEF SCROLLED_COLUMNS} 2 {$ELSE} 0 {$ENDIF};

implementation

uses unitC_Control;

var dummy_hack_control: THackControl;

function HackControl(Handle: Integer): THackControl;
begin
	if Handle <> 0 then 
	begin
		{$IFDEF USE_LISTS_OF_DESCRIPTORS} 
			Result := THackControl(All_controls[Handle]);
		{$ELSE}
			Result := THackControl(Handle);
		{$ENDIF}
		Exit; 
	end;
	if not Assigned(dummy_hack_control) then
		dummy_hack_control := THackControl(Pointer(TButton.Create(nil)));
	Result := dummy_hack_control;	
end;

function XPos(C: TControl): Integer; 
begin
		Result := C.Left;
end;

function YPos(C: TControl): Integer;
begin
		Result := C.Top;
end;

procedure SetPos(C: TControl; X, Y: Integer);
begin
	try
		if C.Left <> X then C.Left := X;
		if C.Top <> Y then C.Top := Y;
	except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	end;
end;

procedure Set_width(C: TControl; W: Integer);
begin
	try
		{$IFnDEF FPC}
		if C.Width <> W then
		{$ENDIF} 
			C.Width := W;
	except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	end;
end;

procedure Set_height(C: TControl; H: Integer);
begin
	try
		{$IFnDEF FPC}
		if C.Height <> H then 
		{$ENDIF} 
			C.Height := H;
	except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	end;
end;

(*
/*

// running application until it is terminated
//-------------------------------------------

NATIVE: "var Screen_object_ref_: Ref_obj;" .
NATIVE: "var App_running: Boolean;" .

FUN Run_screen_forms({Screen} Screen|_object), NATIVE :
    //INT h|andle_main_form = Screen.Main_form_.Handle
    //INT w|indow_main_form = Screen.Main_form_.Window_handle
    {Form} main|_form = Screen.Main_form_
    NATIVE @
    //"var d:Integer;{$IFDEF FPC}F: TAL4Form;{$ELSE}M:TMessage;{$ENDIF}"
    "var d:Integer;{$IFDEF FPC}{$ELSE}M:TMessage;{$ENDIF}"
    "	 Object_assign_weak(Screen_object_ref_, X_Screen.Obj);"
    //"    Main_form_index := X_h;"
    "    Main_form_index := C_Form(X_main.Obj).F_Handle;"
    "	 {$IFnDEF LINUX}"
    //"	 Main_form_window_handle := X_w;"
    "	 Main_form_window_handle := "
    "		unitC_AL4_form.M_Get_window_handle(C_Form(X_main.Obj).F_Handle);"
    "	 {$ENDIF}"
    "	 App_running := true;"
    "{$IFDEF FPC}"
    //"	 F := TAL4Form(All_forms[Main_form_index]);"
    //"	 Application.MainForm := F;"
    "	 Application.Run;"
    "{$ELSE}"
    "	 Application.ProcessMessages;"
    "	 ShowWindow(Application.Handle, SW_Hide);"
    "    while not Application.Terminated do"
    "    begin"
    "          Sleep(1);"
    "          Application.ProcessMessages;"
    "    end;"
    "	 App_closed := true;"
    "    Main_form_index := 0;"
    "	 App_running := false;"
    "{$ENDIF}"
    .
    
FUN Application_terminated ==> BOOL, NATIVE : @
	"RESULT := not App_running;" .
    
FUN Get_screen|_object ==> {Screen}, NATIVE : @
	"	if Screen_object_ref_ <> nil then"
	"		RESULT := Screen_object_ref_;" .

    
FUN Set_main_form_handle(INT H|andle_of_main_form), NATIVE :
	"	Main_form_handle := X_H;" .    
	
FUN Ticks_from_power_up ==> INT, NATIVE : @
	"	RESULT := {$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF};" .
	
------------------------------------------------- 'single instance applications'

FUN Register_instance(
	STR Uniq|ue_string,
	STR Command_line|_to_pass_to_the_first_running_instance) ==> BOOL, NATIVE
	:
@	"	RESULT := register_instance(X_Uniq, X_Command_line);" .

FUN Unregister_instance, NATIVE:
@	"	unregister_instance;" .
 	*/
 	*)
	
 	{$IFnDEF LINUX}
 	
	var registered_msg: DWORD;	
	var first_inst_mutex: THandle;
	
	{$ENDIF}
		
	procedure unregister_instance;
	begin
		{$IFnDEF LINUX}
		
	 	if LongBool(first_inst_mutex) then
	 	begin
	 		CloseHandle(first_inst_mutex);
	 		first_inst_mutex := 0;
	 	end;
	 	
	 	{$ENDIF}
	end;
 	(*
 	/*

FUN Main_form_running({Form} M|ain_form), NATIVE :
@	"	main_form_running(X_M);" .

	*/
	*)

	procedure main_form_running(X_M: Ref_obj);
	{$IFnDEF LINUX}
	
	var f: TAL4Form;
	
	{$ENDIF}
	begin
		{$IFnDEF LINUX}
		
			{$IFDEF USE_LISTS_OF_DESCRIPTORS}
				f := TAL4Form(All_forms[C_Form(X_M.Obj).F_Handle]);
			{$ELSE}
				f := TAL4Form(C_Form(X_M.Obj).F_Handle);
			{$ENDIF}
	 	if registered_msg <> 0 then
	 		f.can_handle_another_instance_notify := true;
	 		
	 	{$ENDIF}	
	end;
	
	{$IFnDEF LINUX}
		
			var Unique_id: String;
		
	{$ENDIF}
	
	function register_instance(const X_Uniq, X_Command_line: String): Boolean;
	{$IFnDEF LINUX}
		
		var CritSecMutex : THandle;
	    	DW : Longint;
	    	s: String;
	    	buf: array[0..MAX_PATH] of Char;
	    	i, j: Integer;
	    	send_slot: THandle;
	    	SL: TStringList;
	    	MS: TMemoryStream;
	    	written: DWORD;
    	
	{$ENDIF}
	begin
		Result := TRUE;
		{$IFnDEF LINUX}
		
		Unique_id := X_Uniq;
		//Result := true; // it's the first instance which is returning TRUE
		registered_msg := RegisterWindowMessage(PChar('Message.' + X_Uniq));
		if registered_msg = 0 then Exit;
		
		CritSecMutex := CreateMutex( nil, True, nil );
   		if CritSecMutex = 0 then Exit;
   		first_inst_mutex := CreateMutex( nil, False, PChar(X_Uniq) );
	    if first_inst_mutex <> 0 then
	    begin
	      DW := WaitForSingleObject( first_inst_mutex, 0 );
	      Result := (DW <> WAIT_TIMEOUT);
	    end;
	    CloseHandle( CritSecMutex );
	    
		if not Result then
		begin
			GetModuleFileName( 0, buf, MAX_PATH );
			SL := TStringList.Create;
			SL.Add(buf);
			for i := 1 to ParamCount do
				SL.Add(ParamStr(i));
			MS := TMemoryStream.Create;
			j := SL.Count;
			MS.Write(j, Sizeof(Integer));
			for i := 0 to SL.Count-1 do
			begin
				s := SL[i];
				j := Length(S);
				MS.Write(j, Sizeof(Integer));
				MS.Write(PChar(s)^, j);
			end;
			SL.Free;

			send_slot := CreateFile(
				PChar('\\.\mailslot\' + Unique_id),
				GENERIC_READ or GENERIC_WRITE,
				FILE_SHARE_READ or FILE_SHARE_WRITE,
				nil,
				OPEN_EXISTING,
				FILE_ATTRIBUTE_NORMAL,
				0);

			if (send_slot <> INVALID_HANDLE_VALUE)  then
			begin
				WriteFile(send_slot, MS.Memory^, MS.Size, written, nil);
				SendMessage(HWND_BROADCAST, registered_msg, 0, 0);
				CloseHandle(send_slot);
			end;
			MS.Free;
		    TerminateProcess(GetCurrentProcess, 0);
		end;
		
		{$ENDIF}
	end;

const DPI_DEFAULT = 72.0;

function InchesToPixels(C: TCanvas; inches: Double): Double;
var r: Integer;
begin
	{$IFDEF LINUX}
    	Result := Screen.PixelsPerInch * inches;
	{$ELSE}
		if (C = nil) or (C.Handle = 0) then
	    	Result := Screen.PixelsPerInch * inches
		else
		begin
			r := GetDeviceCaps(C.Handle, LOGPIXELSX);
			Result := inches * r;
		end;
	{$ENDIF}
end;

function Is_mobile_screen: Boolean;
begin
	RESULT :=  false  ;
end;

function Form_native_handle(H: Integer): Integer;

var F: TAL4Form;

begin
	
		F := form_from_handle(H);
		RESULT := F.Handle;
	
end;

function Form_client_width(F: TAL4Form): Integer;
begin
	
		RESULT := F.ClientRect.Right - F.ClientRect.Left;
	
end;

function Form_client_height(F: TAL4Form): Integer;
begin
	
		RESULT := F.ClientRect.Bottom - F.ClientRect.Top;
	
end;


(*
/*

FUN Set_form_application_button(
INT H|andle_of_form, BOOL Value|_set), NATIVE : @
"var F: TAL4Form;"
"	F := form_from_handle(X_H);"
"	if X_Value then"
"	   SetWindowLong(F.Handle, GWL_EXSTYLE,"
"    		GetWindowLong(F.Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW)"
"	else" 
"	   SetWindowLong(F.Handle, GWL_EXSTYLE,"
"    		GetWindowLong(F.Handle, GWL_EXSTYLE) and not WS_EX_APPWINDOW);" .

FUN Is_mobile_screen ==> BOOL, NATIVE : @
	"RESULT := Is_mobile_screen;" .

//---------- points --> pixels

FUN Points|_convert_to_pixels(REAL P|oints_value) ==> INT, NATIVE :
    "    RESULT := AL4_form.Points(X_P);" .
*/
*)
function Points{ToPixels}(pts: Double): Integer;
var d: Double;
begin
	try
		if pts = -INFINITY then d := 0
		else if pts = INFINITY then d := 1000000
		else d := InchesToPixels(nil, 1) / DPI_DEFAULT * pts; 
	    Result := Trunc(d + 0.000001);
    except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
    				Result := 0;
			   end;
    end;
end;

(*
/*
//---------- pixels --> points
FUN Pixels|_convert_to_points(REAL P|ixels_value) ==> REAL, NATIVE :
    "    RESULT := Pixels(X_P);" .
*/
*)
function Pixels{ToPoints}(pix: Double): Double;
begin
    Result := pix / InchesToPixels(nil, 1) * DPI_DEFAULT;
end;

(*
/*

------------------------------------- 'List monitors'

FUN List_screen_monitors(INT H|andle_form_dummy), NATIVE :
    "    List_screen_monitors;" .
*/
*)

    {$IFnDEF LINUX}
    

function EnumMons(
	hMon: THandle;
	hdc: HDC;
	rc: PRect;
	dummy: Pointer ): BOOL; stdcall;
begin
    Monitors_stored.Add(Pointer(rc^.Left));
    Monitors_stored.Add(Pointer(rc^.Top));
    Monitors_stored.Add(Pointer(rc^.Right - rc^.Left));
    Monitors_stored.Add(Pointer(rc^.Bottom - rc^.Top));
    Result := TRUE;
end;
	
	{$ENDIF}

procedure List_screen_monitors;
    {$IFDEF LINUX}
    // always count = 1
    {$ELSE}
    
var EnumDisplayMonitors: function (
		 hdc: LongWord; lprcClip: PRect; lpfnEnum: Pointer;
         dwData: TList): LongBool; stdcall;
	Lib: THandle;
type Tedm_proc = function(a: LongWord; b: PRect; c: Pointer; d: TList): LongBool;
	{$IFDEF LINUX}{$ELSE WINDIWS} stdcall; {$ENDIF}
	
	{$ENDIF}
begin
    {$IFnDEF LINUX}
    
	if Monitors_stored = nil then
		Monitors_stored := TList.Create;
	Monitors_stored.Clear;
	
	Lib := LoadLibrary('user32.dll');
	EnumDisplayMonitors := Tedm_proc(GetProcAddress(
		Lib, 'EnumDisplayMonitors'));
	
	EnumDisplayMonitors(0, nil, @EnumMons, nil);
	
	{$ENDIF}
end;

(*
/*

FUN Fake_screen_monitor(
	INT H|andle_form_dummy,
	{Geometry}.{rect} Bounds|_of_adding_mointor,
	BOOL Clear_before|_adding)
	:
	do_Fake_screen_monitor(
		Bounds.Loc.X, Bounds.Loc.Y, Bounds.Width, Bounds.Height, Clear_before)
	.
FUN do_Fake_screen_monitor(REAL X|_position, REAL Y|_position,
	REAL W|idth_monitor, REAL H|eight_monitor, BOOL Clear_before), NATIVE :
    "if Monitors_stored = nil then"
    "	Monitors_stored := TList.Create;"
    "if X_Clear_before then Monitors_stored.Clear;"
    "Monitors_stored.Add(Pointer(Points(X_X)));"
    "Monitors_stored.Add(Pointer(Points(X_Y)));"
    "Monitors_stored.Add(Pointer(Points(X_W)));"
    "Monitors_stored.Add(Pointer(Points(X_H)));"
	.
    

FUN Count_screen_monitors(INT H|andle_form) ==> INT, NATIVE :
    "    RESULT := Count_screen_monitors;" .
*/
*)

function Count_screen_monitors: Integer;
begin
	Result := 0;
	if Monitors_stored = nil then
	begin
		{$IFDEF LINUX}
		Result := 1;
		{$ENDIF} 
		Exit;
	end;
	Result := Monitors_stored.Count div 4;
end;

(*
/*

FUN Get_screen_monitor(
INT H|andle_form_dummy,
INT Index|_of_monitor) ==> {rect}
	:
	REAL b|ounds_of_monitor[] << 0 << 0 << 0 << 0
	do_Get_screen_monitor(Index, b[])
	RESULT = {rect}(Loc = Pt(b[0], b[1]), Width = b[2], Height = b[3]) .
FUN do_Get_screen_monitor(
INT Index|_of_monitor, REAL B|ounds_of_monitor[]), NATIVE : @
    "if Monitors_stored = nil then "
    "begin"
    "	{$IFDEF LINUX}"
    "	if X_Index = 0 then"
    "		X_B.SetReals(2, Pixels(Screen.Width));"
    "		X_B.SetReals(3, Pixels(Screen.Height));"
    "	{$ENDIF}"
    "	Exit;"
    "end;"
    "if (X_Index < 0) or (X_Index >= Monitors_stored.Count) then Exit;"
    "X_B.SetReals(0, Pixels(Integer(Monitors_stored.Items[X_Index * 4])));"
    "X_B.SetReals(1, Pixels(Integer(Monitors_stored.Items[X_Index * 4 + 1])));"
    "X_B.SetReals(2, Pixels(Integer(Monitors_stored.Items[X_Index * 4 + 2])));"
    "X_B.SetReals(3, Pixels(Integer(Monitors_stored.Items[X_Index * 4 + 3])));"
    .

FUN Screen_bounds(INT H|andle_form_dummy) ==> {rect}
	:
	REAL b|ounds_of_screen[] << 0 << 0 << 0 << 0
	do_Get_screen_bounds(b[])
	RESULT = {rect}(Loc = Pt(b[0], b[1]), Width = b[2], Height = b[3]) .
FUN do_Get_screen_bounds(REAL B|ounds_of_screen[]), NATIVE : @
	"var r: TRect;"
	"	{$IFDEF FPC}"     
    "    r := Screen.DesktopRect;"
    "		{$define r_ready}"     
    "	{$ENDIF}"     
    "	{$IFnDEF r_ready}"
    "	{$IFnDEF _D6orHigher}"
    "		r := Bounds(GetSystemMetrics(76 {SM_XVIRTUALSCREEN}),"
    "			GetSystemMetrics(77 {SM_YVIRTUALSCREEN}),"
    "			GetSystemMetrics(78 {SM_CXVIRTUALSCREEN}),"
    "			GetSystemMetrics(79 {SM_CYVIRTUALSCREEN}));"
    "	{$ELSE}"
    "		r := Screen.DesktopRect;"    
    "	{$ENDIF}"     
    "	{$ENDIF}"     
 	"	 X_B.SetReals(0, Pixels(r.Left));"   
 	"	 X_B.SetReals(1, Pixels(r.Top));"   
 	"	 X_B.SetReals(2, Pixels(r.Right - r.Left));"   
 	"	 X_B.SetReals(3, Pixels(r.Bottom - r.Top));" 
	.
*/
*)

(*
/*

FUNCTION Screen_created(
	{Screen} S|creen_object_containing_all_forms_dummy), NATIVE :
@	"var sh: TScreen_handler;"
	"	 sh := TScreen_handler.Create(X_S);"
	"	 long_operation_handlers.Add(sh);"
	"	 if Screen_object_ref_ <> nil then" 
	"	  	Object_assign_weak(Screen_object_ref_, X_S.Obj)"
	"	 else Screen_object_ref_ := X_S;"
	"{$IFnDEF NOEXCEPTIONS}"     
	"	 Application.OnException := {$IFDEF FPC}@{$ENDIF}sh.Exception_handler;"
	"{$ENDIF}"     
	.
	
FUN Screen_destroyed(
{Screen} Screen|_object_dummy) : .

FUNCTION do_long_operation(
{Form} Caller|_form,
{Long_operation} Exist|ing_long_operation) ==> {Long_operation} RESULT
|created_new, NEW, NATIVE, PUBLIC :
//DEBUG: << "do_long_operation"#NL ;
NATIVE @
"RESULT := call_do_long_operation(X_Caller, X_Exist);" .

*/
*)
		
function call_do_long_operation(X_Caller: Ref_obj; X_Exist: Ref_obj): Ref_obj;
begin
//?{Long_operation}
//AL4_system.WriteLine("do_long_operation:1");
    Result := unitC_Long_operation
    	.M_do_long_operation_synchronously(X_Caller, X_Exist);
//AL4_system.WriteLine("result=" + result);
//.
end;
		
(*
/*

FUN Set_forms_autoscroll(BOOL A|utoscroll_forms) : .

// Creates form Delphi object (also the first column on it is created, too)
//-------------------------------------------------------------------------

------- 'Create_from'

FUN Form_create({Form} F|orm_object) ==> INT, NATIVE :
    "     Result := Do_Form_create(X_F);" .
*/
*)

var app_initialized: Boolean;

function Do_Form_create(
	X_F: Ref_obj): Integer;
var Form: TAL4Form;
	F: C_Form;
	S: C_Screen;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	i: Integer;
	{$ENDIF}
begin
	
 	if not app_initialized then
 	begin
 		app_initialized := TRUE;
 		
 		Application.Initialize;
 	end;
 	
	
 
 	{$IFDef FPC}
	 	try
	 		Application.CreateForm(TAL4Form, Form);
	 	except on Ex: EResNotFound do 
	 			begin 
	 			end;
	 	end;
 	{$ELSE}
    	Form := TAL4Form.CreateNew(nil);
    {$ENDIF}
    Form.Visible := FALSE;
    {$IFNDEF AUTOSCROLL_FORMS}
    Form.AutoScroll := false;
    {$ENDIF}
    Form.Height := Points(200);
    Form.Width := Points(300);
 
    Form.AL4Object := X_F;
    //X_F.Obj.OnErase := Form.Erasing_form;
    Form.Hidden := FALSE;
    {$IFDEF SWIPE_FORMS}
    	
    		
	    	Form.VertScrollbar.Visible := false;
	    	Form.HorzScrollbar.Visible := false;
	    	
    	
    {$ENDIF}
    
    F := C_Form(Form.AL4Object.Obj);
    
    S := C_Screen(F.F_Screen_.Obj);
    if S.F_Default_font_face {$IFDEF FPC}.As_string{$ENDIF} <> '' then
    	Form.Font.Name := S.F_Default_font_face {$IFDEF FPC}.As_string{$ENDIF};
    if S.F_Default_font_size <> 0 then
     	Form.Font.Size := Trunc(S.F_Default_font_size); 
    	
    Form.HandleNeeded;
    
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := -1;
    	for i := All_forms.Count-1 downto 1 do
    		if All_forms[i] = nil then
    		begin
    			Result := i;
    			break;
    		end;
    	if Result < 0 then
    	begin
    		Result := All_forms.Count;
    		All_forms.Add(nil);
    	end;
    	All_forms[Result] := Form;
    {$ELSE}
    	Result := Integer(Pointer(Form));
    {$ENDIF}
    {$IFDEF FPC}
    	{$IFDEF LINUX}
    	Form.OnChangeBounds := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_moved;
	    Form.OnResize := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_resized;
	    {$ENDIF}
	    Form.OnActivate := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_activate;
	    Form.OnDeactivate := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_deactivate;
	    
	    Form.OnShow := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_shown;
	    
    {$ENDIF}
    Form.OnMouseMove := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_mouse_move;
    Form.OnMouseDown := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_mouse_down;
    Form.OnMouseUp := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_mouse_up;
     
    	Form.OnDblClick := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_mouse_double_click;
    
    Form.OnMouseWheel := {$IFDEF OBJFPC}@{$ENDIF} Form.Form_mouse_wheel;
    
	
		 
			Form.KeyPreview := TRUE;
		 
	
	Form.OnKeyDown := {$IFDEF OBJFPC}@{$ENDIF}Form.Form_key_down;
	Form.OnKeyUp := {$IFDEF OBJFPC}@{$ENDIF}Form.Form_key_up;
	
		{$IFDEF FPC}
		Form.OnUTF8KeyPress := @ Form.Form_UTF8key_press;
		{$ELSE}
		Form.OnKeyPress := Form.Form_key_press;
		{$ENDIF}
	
	Form.created := true;
	//if true then writeln('form events set');
end;

(*
/*

FUN Form_set_icon(
{Form} F|orm_object, 
INT Bitmap_h|andle_containing_icon),
	NATIVE:
INT form_h|andle = F.Handle
	NATIVE @
	"var B: TBitmap_Ex;"
	"var f: TAL4Form;"     
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"    B := TBitmap_ex(All_bitmaps[X_Bitmap_h]);"     
    "	{$ELSE}" 
	"    B := TBitmap_ex(X_Bitmap_h);"     
    "	{$ENDIF}"
    ""     
	"    if (B = nil) or (B.Ico = nil) then Exit;" 	 
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    F := TAL4Form(All_forms[X_form_h]);"
    "	{$ELSE}" 
    "    F := TAL4Form(X_form_h);"
    "	{$ENDIF}"
    ""     
	"if (f <> nil) then"
	"	 f.Icon := B.Ico;"     
	.

// Get form window handle
//--------------------. 

FUN Get_window_handle(INT H|andle_native) ==> INT, NATIVE :
	CASE H==0 ? ==> ;
	NATIVE @   
	"var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    F := TAL4Form(All_forms[X_H]);"
    "	{$ELSE}" 
    "    F := TAL4Form(X_H);"
    "	{$ENDIF}"
    "	"
    "    RESULT := Integer(F.Handle);"
    "	" .
    
FUN Call_any_change({Form} F|orm_object), NATIVE:
		INT h|andle_form = F.Handle
		CASE h == 0 ? ==> ;
		CASE F.suspended_count > 0 ? ==> ;
		NATIVE @
    "var F: TAL4Form;"
	"var CF: C_Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_h]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_h);"
    "	{$ENDIF}"
	"	CF := C_Form(F.AL4Object.Obj);"
	"	{$IFDEF FPC}"
	"	F.DisableAutosizing();"
	"	{$ENDIF}"
	"	dec(Allow_handle_events);"     
	"	try"     
	"	    CF.M_Any_change();"
	"	finally"     
	"		inc(Allow_handle_events);"     
	"	    {$IFDEF FPC}"
	"	    F.EnableAutoSizing();" 
	"	    {$ENDIF}"
	"	end;"
	.	
*/
*)


(*
/*

// Destroy Delphi form
//--------------------

FUN Destroy_form(INT H|andle_native), NATIVE :
    "     Do_Destroy_form(X_H);" .
    
*/
*)

var destroying_main_form: Boolean;

procedure Do_destroy_form(H: Integer);
var i: Integer;
    MF, F: TAL4Form;
    cF: C_Form;
    cS: C_Screen;
begin
    if H = 0 then Exit;
    //if true then
    //    Writeln('----------------------------- Do_destroy_form(' + IntToStr(H) +
    //    '), Main_form_index=' + IntToStr(Main_form_index));
    
    if H = Main_form_index then
    begin
        destroying_main_form := TRUE;
        //App_closed := true;
        {$IFDEF USE_LISTS_OF_DESCRIPTORS}
         MF := TAL4Form(All_forms[H]);
        {$ELSE}
         MF := TAL4Form(H);
        {$ENDIF}
        cF := C_Form(MF.AL4Object.Obj);
        cS := C_Screen(cF.F_Screen_.Obj);
        for i := cS.F_All_forms.Count()-1 downto 0 do
        begin
            cF := C_Form(cS.F_All_forms.GetObjects(i).Obj);
            if cF.F_Handle = H then continue;
	        {$IFDEF USE_LISTS_OF_DESCRIPTORS}
	         F := TAL4Form(All_forms[cF.F_Handle]);
	        {$ELSE}
	         F := TAL4Form(cF.F_Handle);
	        {$ENDIF}
                    
            F.OnResize := nil;
            
            F.OnCloseQuery := nil;
            F.OnClose := nil;
            F.OnDestroy := nil;
            
            F.Free;
            
            cF.F_Handle := 0;
        end;
        cS.F_All_forms.Clear;
    end
    else
    begin
    	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
         F := TAL4Form(All_forms[H]);
        {$ELSE}
         F := TAL4Form(H);
        {$ENDIF}
        F.Free;
    end;
end;

(*
/*
// Close Delphi form
//--------------------
FUN Form_close(INT H|andle_native), NATIVE :
	"Do_form_close(X_H);" .
	
*/
*)

procedure Do_form_close(X_H: Integer);
var F: TAL4Form;
	
begin
 	if X_H = 0 then Exit;
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 		F := TAL4Form(All_forms[X_H]);
 	{$ELSE}
 		F := TAL4Form(X_H);
 	{$ENDIF}
 	
    //{$IFDEF FPC}
    ////if true then Writeln('D0_form_close');
    //F.OnMouseUp := nil;
    //F.OnMouseDown := nil;
    //{$ENDIF}
    
 	
    	F.Close;
 	
end;

(*
/*
// Return TRUE if  form is visible
//--------------------------------

FUN Form_visible(INT H|andle_native) ==> BOOL, NATIVE :
    "    RESULT := Do_Get_form_visible(X_H);" .
*/
*)
function Do_Get_form_visible(H: Integer): Boolean;
var F: TAL4Form;
begin
	Result := false;
	if H = 0 then Exit;
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
 	if F.HandleAllocated then
 	begin
    	Result := F.Visible;
 	end
 		else
 	begin
    	Result := not F.Hidden;
 	end;
end;

(*
/*
// Return TRUE if  form is visible
//--------------------------------

FUN Form_hidden(INT H|andle_native) ==> BOOL, NATIVE : @
   "var F: TAL4Form;"
   "Result := false;"
   "if X_H = 0 then Exit;"
   "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
   "	F := TAL4Form(All_forms[X_H]);"
   "{$ELSE}"
   "	F := TAL4Form(X_H);"
   "{$ENDIF}"
   "Result := F.Hidden;" .
*/
*)


(*
/*
// Show or hide form
//------------------

FUN Show_hide|_form(
INT H|andle_native, BOOL Show|_or_hide), NATIVE :
    "    Do_show_hide(X_H, X_Show);" .
    
FUN Show_form_noactivate(
INT H|andle_native), NATIVE :
    "    Do_show_noactivate(X_H);" .
    
*/
*)

procedure Do_show_noactivate(H: Integer);
var F: TAL4Form;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    F.Hidden := false;
    {$IFDEF FPC}
    if F.Visible then begin
    	Exit;
    end;
    {$ENDIF}
	if F.WindowState = wsMinimized then
	   F.WindowState := wsNormal;
	F.Visible := true;
	//ShowWindow(F.Handle, SW_SHOWNOACTIVATE);
end;

procedure Do_show_hide(
H: Integer; Show: Boolean);
var F: TAL4Form;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    if  Show then
    begin
        F.Hidden := false;
        {$IFDEF FPC}
        if F.Visible then begin
        	if F.WindowState = wsMinimized then
        	   F.WindowState := wsNormal;
        	F.SetFocus();
        	Exit;
        end;
        {$ENDIF}
        	if F.WindowState = wsMinimized then
        	   F.WindowState := wsNormal;
        	F.Show;
        	{$IFDEF FPC}
        	F.SetFocus();
        	{$ELSE}
        	SetForegroundWindow(F.Handle);
        	{$ENDIF}
        
    end
    else
    begin 
        {$IFDEF FPC}
        if F.Visible then
        {$ENDIF}
        	F.Hide;
        F.Hidden := true;
    end;
end;

(*
/*
// Show form dialog modal
//-----------------------

	FUN Show_form_modal(
	{Dialog} D|ialog_to_show , {Form} P|arent_form)
	    :
		PUSH P.menu_alias = "":
		PUSH P.level_event = 0:
		     call_do_show_modal(D, P) ; 
		; .
		     
	FUN call_do_show_modal({Dialog} D|ialog_to_show , {Form} P|arent_form),
        NATIVE :
        INT h|andle_dialog = D.Handle
        INT pa|rent_handle = P.Handle
	NATIVE @
    "    Do_show_modal(X_h, X_pa);" .
*/
*)

procedure operation_started(
	op: Integer; f: C_Form; c: Ref_obj);
begin
	if c <> nil then
		f.M_operation_started(op, c)
	else if f <> nil then f.M_operation_started(op, f.hard_link);
end;

procedure operation_ended(
	op: Integer; f: C_Form);
begin
	//if true then writeln('operation ended: ' + IntToStr(op));
	if f = nil then Exit;
	f.M_operation_ended(op);
	
end;

var key_pressing: Boolean;

procedure Do_show_modal(H, P: Integer);
//?{Dialog}
var F, FP: TAL4Form;
	PH: THandle;
	CP: C_Form;
	was_key_pressing: Boolean;
//.
begin
//?{Dialog}
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 		 F := TAL4Form(All_forms[H]);
 	{$ELSE}
	     F := TAL4Form(H);
 	{$ENDIF}
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 FP := TAL4Form(All_forms[P]);
 	{$ELSE}
     FP := TAL4Form(P);
     if FP = nil then Exit;
 	{$ENDIF}
 	PH := FP.Handle;
 	
    CP := C_Form(FP.AL4Object.Obj);
    //if CP.F_Ready then Exit; /////////////// ++++++++++++++++
    
    F.Hidden := false;	 
    										//writeln('ShowModal!->' + CP.F_Alias);
    was_key_pressing := key_pressing;
    key_pressing := false;
    try
    	F.ShowModal;
    finally
    	key_pressing := was_key_pressing;
    end;
    										//writeln('ShowModal!<-' + CP.F_Alias);
    //{$IFnDEF LINUX}
    //    //SetForegroundWindow(H);
    //    SetWindowPos(PH, 0, 0, 0, 0, 0,
    //        SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW);
    //{$ENDIF}
//.
end;

(*
/*
// Set modal result
//---------------------
FUN Set_modal_result(INT H|andle_native, STR Result|_set), NATIVE :
@   "var form: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_H]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_H);"
    "	{$ENDIF}"
    ""
    "    form.ModalResult := mrOK;"
    //"	 form.Hide;"     
    									  //"	 writeln('set modal result OK!');"     
    .
*/
*)


(*
/*
// Get form caption
//-----------------

FUN Get_form_caption(INT H|andle_native) ==> STR, NATIVE :
    "    RESULT := Do_Get_form_caption(X_H);" .
*/
*)
function Do_Get_form_caption(H: Integer): String;
var F: TAL4Form;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
 	
    Result := F.Caption;
    
end;

(*
/*
// Set form caption
//-----------------

FUN Set_form_caption(
{Form} Form|_handle, STR V|alue_caption), NATIVE :
    "    Do_Set_form_caption("
    "		C_Form(X_Form.Obj).F_Handle, X_V);" .
*/
*)
procedure Do_Set_form_caption(H: Integer; const V: String);
var F: TAL4Form;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}

    F.Caption := V;

end;


(*
/*

FUN Set_window_taskbar_button_progress(
        	{Form} F|orm_object, INT Value|_0_to_100) : .


// Get form left position in points
//---------------------------------
FUN Get_form_left(INT F|orm_native_handler) ==> REAL, NATIVE :
    "    RESULT := Do_get_form_left(X_F); " .
*/
*)
function Do_get_form_left(H: Integer): Double;
var F: TAL4Form;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    Result := Pixels(F.Left);
end;

(*
/*

FUN Set_form_bounds(INT F|orm_handle, REAL L|eft_position, REAL T|op_position,
REAL W|idth_form, REAL H|eight_form), NATIVE :
	INT p_l|eft_pixels = L.Points
	INT p_t|op_pixels = T.Points
	INT p_w|idth_pixels = W.Points
	INT p_h|eight_points = H.Points
NATIVE @
   "var F: TAL4Form;"
   "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
   "F := TAL4Form(All_forms[X_F]);"
   "{$ELSE}"
   "F := TAL4Form(X_F);"
   "{$ENDIF}"
   "F.SetBounds(X_p_l, X_p_t, X_p_w, X_p_h);" .

// Get form top position in points
//--------------------------------
FUN Get_form_top(INT F|orm_native_handler) ==> REAL, NATIVE :
    "    RESULT := Do_get_form_top(X_F); " .
*/
*)
function Do_get_form_top(H: Integer): Double;
var F: TAL4Form;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    Result := Pixels(F.Top);
end;

(*
/*
// Set form position in points
//----------------------------

FUN Set_form_position(INT F|orm_native_handler,
    REAL L|eft_position, REAL T|op_position), NATIVE :
    "    Do_set_form_pos(X_F, X_L, X_T); " .
*/
*)

procedure Do_set_form_pos(
	H: Integer; X_L, X_T: Double);

var F: TAL4Form;
//?{Form}.moved
	cF: C_Form;
//.

begin
	
	 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	 	 F := TAL4Form(All_forms[H]);
	 	{$ELSE}
	     F := TAL4Form(H);
	 	{$ENDIF}
	    F.Left := AL4_form.Points(X_L);
	    F.Top := AL4_form.Points(X_T);
	    {$IFNDEF MOBILE_SCREEN}
	    F.Position :=  poDesigned ;
	    {$ENDIF]}
//?{Form}.moved
	    	cF := C_Form(F.AL4Object.Obj);
		    operation_started(8, cF, nil);
		    try
		    	cF.M_moved;
		    finally
		    	operation_ended(8, cF);
		    end;
//.
end;

(*
/*
// Get form width in points
//-------------------------
FUN Get_form_width(INT F|orm_native_handler) ==> REAL, NATIVE :
    "    RESULT := Do_get_form_width(X_F); " .
*/
*)
{$IFDEF LINUX}
CONST mask_form_sz = 0;
{$ELSE}
CONST mask_form_sz = 3;
{$ENDIF}

function Do_get_form_width(H: Integer): Double;
var F: TAL4Form;
	w_: Integer;
	{$IFDEF FPC}
		{$IFDEF LINUX}
		x_, y_, h_: Integer;
		delta: TPoint;
		{$ELSE}
		R: TRect;
		{$ENDIF}
	{$ELSE}
	R: TRect;
	{$ENDIF}
begin
	Result := 0;
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 	F := TAL4Form(All_forms[H]);
 	{$ELSE}
     	F := TAL4Form(H);
 	{$ENDIF}
    if F = nil then Exit;
    
    w_ := F.Width;
    {$IFDEF LINUX}
		y_ := F.Top;
    	x_ := F.Left;
    	delta := F.ScreenToClient(Classes.Point(x_, y_));
    	w_ := w_ - delta.X - delta.X;    
    	Result := Pixels(w_);
    {$ELSE}
	    if F.Handle <> 0 then
	    begin
	    	GetWindowRect(F.Handle, R);
	    	w_ := R.Right - R.Left;
	    end; 
    	Result := Pixels(w_);
    {$ENDIF}
end;

(*
/*
// Get form height in points
//--------------------------
FUN Get_form_height(INT F|orm_native_handler) ==> REAL, NATIVE :
    "    RESULT := Do_get_form_height(X_F); " .
*/
*)
function Do_get_form_height(H: Integer): Double;
var F: TAL4Form;
	h_: Integer;
	{$IFDEF FPC}
		{$IFDEF LINUX}
		w_, y_, x_: Integer;
		delta: TPoint;
		{$ELSE}
		R: TRect;
		{$ENDIF}
	{$ELSE}
	R: TRect;
	{$ENDIF}
begin
	Result := 0;
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    if F = nil then Exit;
    
    h_ := F.Height;
	{$IFDEF LINUX}
    	y_ := F.Top;
    	x_ := F.Left;
    	delta := F.ScreenToClient(Classes.Point(x_, y_));
    	h_ := h_ - delta.Y - delta.X;
    	RESULT := Pixels(h_);
	{$ELSE}
	    if F.Handle <> 0 then
	    begin
	    	GetWindowRect(F.Handle, R);
	    	h_ := R.Bottom - R.Top;
	    end;
    	RESULT := Pixels(h_);
	{$ENDIF}
end;

(*
/*

FUN Get_form_state(
INT F|orm_handle) ==> {Form}.{state}, NATIVE: @
"var F: TAL4Form;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "F := TAL4Form(All_forms[X_F]);"
    "{$ELSE}"
    "F := TAL4Form(X_F);"
    "{$ENDIF}"
"	 if IsIconic(F.Handle) then RESULT := 1"
"	 else"
"	 if IsZoomed(F.Handle) then RESULT := 2;" .

FUN Set_form_state(
INT F|orm_handle, {Form}.{state} V|alue_to_set), NATIVE: @
"{$IFnDEF LINUX}"
"var R: TRect;"
"var W: HWnd;" 
"{$ENDIF}"   
"var F: TAL4Form;"
"{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
"F := TAL4Form(All_forms[X_F]);"
"{$ELSE}"
"F := TAL4Form(X_F);"
"{$ENDIF}"
"	 case X_V of"
"	 0: F.WindowState := wsNormal;" 
"	 1: F.WindowState := wsMinimized;" 
"	 2: begin"
"			{$IFDEF LINUX}"
"			F.WindowState := wsMaximized;"
"			{$ELSE}"
"			SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);"
"			F.WindowState := wsMaximized;"
"			if (F.Left >= R.Left) and (F.Top >= R.Top)"
"			and (F.Left + F.Width <= R.Right)"
"			and (F.Top + F.Height <= R.Bottom) then"
"			begin"
"				F.BoundsRect := R;"
"				Exit;"
"			end;"
"			W := FindWindow('Shell_TrayWnd', nil);"
"			GetWindowRect(W, R);"
"			if (R.Right-2 <= F.Left) or (R.Left+2 >= F.Left + F.Width)"
"			or (R.Bottom-2 <= F.Top) or (R.Top+2 >= F.Top + F.Height)"
"			then Exit;"
"			if (R.Top > F.Top) and (R.Top < F.Top + F.Height)"
"			then begin"
"				F.Height := R.Top - F.Top;"
"			end"
"			else if (R.Bottom > F.Top) and (R.Bottom < F.Top + F.Height) then"
"			begin"
"				F.Height := F.Top + F.Height - R.Bottom;"
"				F.Top := R.Bottom;"
"			end"
"			else if (R.Left > F.Left) and "
"				 (R.Left < F.Left + F.Width) then begin"
"				F.Width := R.Left - F.Left;"
"			end"
"			else if (R.Right > F.Left) and (R.Right < F.Left + F.Width) then"
"			begin"
"				F.Width := F.Left + F.Width - R.Right;"
"				F.Left := R.Right;"
"			end;"
"			{$ENDIF}"
"		end;"
"	 end;" .

// Set form size in points
//------------------------

FUN Set_form_size(INT F|orm_native_handler,
    REAL W|idth_points, REAL H|eight_points), NATIVE :
    "    Do_set_form_size(X_F, X_W, X_H); " .
*/
*)

procedure Do_set_form_size(
	H: Integer; X_W, X_H: Double);
var F: TAL4Form;
{$IFDEF LINUX}
	x_, y_: Integer;
	delta: TPoint;
{$ELSE}
	hwnd: THandle;
{$ENDIF}
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    {$IFDEF LINUX}
		y_ := F.Top;
    	x_ := F.Left;
    	delta := F.ScreenToClient(Classes.Point(x_, y_));
    	F.Height := Points(X_H); // + delta.X + delta.Y;
    	F.Width := Points(X_W); // + delta.X + delta.X;
    {$ELSE}
	    hwnd := F.Handle; 
	    if hwnd <> 0 then
	    begin
	    	SetWindowPos(hwnd, 0, 0, 0, Points(X_W), Points(X_H),
	    		SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOZORDER);
	    end
	    else
	    begin 
	    	F.Width := Points(X_W);
	    	F.Height := Points(X_H);
	    end;
    {$ENDIF}
end;

(*
/*

FUN Set_form_minimal_size(INT F|orm_native_handler,
    REAL Min_w|idth_points, REAL Min_h|eight_points), NATIVE :
    "    Do_set_form_min_size(X_F, X_Min_W, X_Min_H); " .
*/
*)

procedure Do_set_form_min_size(
	H: Integer; X_Wmin, X_Hmin: Double);
var F: TAL4Form;
{$IFnDEF LINUX}
	hwnd: THandle;
{$ENDIF}
begin	
	 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	 	 F := TAL4Form(All_forms[H]);
	 	{$ELSE}
	     F := TAL4Form(H);
	 	{$ENDIF}
	 	F.Constraints.MinWidth := AL4_form.Points(X_Wmin);
	 	F.Constraints.MinHeight := AL4_form.Points(X_Hmin);
end;

(*
/*
FUN Form_client_pos|ition_in_points(
INT F|orm_native_handler,
STR What|_X_Y) ==> REAL,
NATIVE :
	CASE "X" IN What ? BOOL x|_position = TRUE ;
	NATIVE
@	"var form: TAL4Form;"
	"var P: TPoint;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_F);"
    "	{$ENDIF}"
	"	 if (form = nil) then EXIT;"
	"	P := form.ClientToScreen(Classes.Point(0,0));"
    "   if (X_x) then "
    "		RESULT := AL4_form.Pixels(P.X)"
    "	else RESULT := AL4_form.Pixels(P.Y);"
    .
    


FUN Form_client_size(
INT F|orm_native_handler,
STR What|_side_W_H) ==> REAL,
NATIVE :
	CASE "W" IN What ? BOOL w|idth_to_get = TRUE ;
	NATIVE
@	"var form: TAL4Form;"
	"var cF: C_Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_F);"
    "	{$ENDIF}"
	"	 if (form = nil) then EXIT;"
    "   if (X_w) then "
    "		RESULT := AL4_form.Pixels(form.ClientRect.Right)"
    "	else begin"
    "		 RESULT := AL4_form.Pixels(form.ClientRect.Bottom);"
    "		 {$IFDEF FPC}"
    "			cF := C_Form(form.AL4Object.Obj);"     
    "			if cF.F_No_frame then"
    "			begin"
    "				RESULT := AL4_form.Pixels(form.Height) - 4;"
    "			end;"     
    "		 {$ENDIF}"     
    "		 end;"     
    ";"
    .
    
FUN Set_form_client_size(
INT F|orm_native_handler,
REAL W|idth_points, REAL H|eight_points) ==> BOOL,
NATIVE :
@	"var form: TAL4Form;"
	"var w, h: Integer;"
	""
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_F);"
    "	{$ENDIF}"
	//"	 w := AL4_form.Points(X_W + 4);"
	"	 w := AL4_form.Points(X_W);"
	//"	 h := AL4_form.Points(X_H + 4);"
	"	 h := AL4_form.Points(X_H);"
	"	 form.ClientWidth := w;" 
	"	 form.ClientHeight := h;"
    "	 RESULT := true;" 
    "" .
		

FUN Set_form_stay_on_top(
	INT F|orm_native_handler, BOOL T|opmost_Z), NATIVE :
@   "var form: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_F);"
    "	{$ENDIF}"
    "	{$IFDEF FPC}"
    "    if X_T then"
    "       form.FormStyle := fsStayOnTop" 
    "    else form.FormStyle := fsNormal;"
    "	{$ELSE}"
    "			if not form.shown then"
    "    			if X_T then"
    "       			form.FormStyle := fsStayOnTop"
    "    			else form.FormStyle := fsNormal"
    "			else"
    "	 			if X_T then"
    //"					SetWindowPos( form.Handle, HWND_TOPMOST or HWND_TOP, "
    "					SetWindowPos( form.Handle, HWND_TOPMOST, "
    "						0,0,0,0,"
    "						SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE )"
    "	 			else"
    "					SetWindowPos( form.Handle, HWND_NOTOPMOST, 0,0,0,0,"
    "						SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE );"
    "	{$ENDIF}"
    .
    
    
//TODO: "Set_no_frame does not hide application button both for VCL/FPC" 
//	  " (Windows7x64)" .
    
FUN Set_form_no_frame(
	INT F|orm_native_handle, BOOL No_frame|_flag), NATIVE:
	NATIVE @
	"Do_Set_form_no_frame(X_F, X_No_frame);" .
	
*/
*)

procedure Do_Set_form_no_frame(X_F: Integer; X_No_frame: Boolean);
var form: TAL4Form;
{$IFDEF LINUX}
   p0, p1:  TPoint ;
{$ELSE}
   app_wnd: HWnd;
{$ENDIF}
var style, exstyle {$IFDEF FPC}{$ELSE} , appexstyle {$ENDIF} : Longint;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
        form := TAL4Form(All_forms[X_F]);
	{$ELSE}
        form := TAL4Form(X_F);
	{$ENDIF}
	
    {$IFDEF LINUX}
        try
           if X_No_frame then
           begin
               form.delta0 := Point(0,0);
               p0 := form.ClientToScreen(Point(0, 0));
               form.Left := p0.x;
               form.Top := p0.y;
               form.Borderless := true;
               form.BorderStyle := bsNone;
               //form.BorderWidth := 0;
               //form.BevelKind := bkNone;
               form.Width := form.Width;
               form.Height := form.Height;
               p1 := form.ClientToScreen(Point(0, 0));
               form.delta0 := Point(p0.x - p1.x, p0.y - p1.y);
               form.Constraints.MinWidth := 50;
               form.Constraints.MinHeight := 50;
           end else
           begin
               form.Borderless := false;
               form.BorderStyle := bsSizeable;
               form.Constraints.MinWidth := 0;
               form.Constraints.MinHeight := 0;
               form.delta0 := Point(0,0);
           end;
       finally
           form.ignore_close_event := false;
       end;
    {$ELSE}
        form.HandleNeeded;
        if form.Handle = 0 then Exit;
        style := GetWindowLong(form.Handle, GWL_STYLE);
        exstyle := GetWindowLong(form.Handle, GWL_EXSTYLE);
        
        {$IFDEF FPC}
        	app_wnd := TWin32Widgetset(Widgetset).AppHandle;
        {$ELSE}
        form.BorderWidth := 0;
	        app_wnd := Application.Handle;
	        appexstyle := 0;
	        if app_wnd <> 0 then
	           appexstyle := GetWindowLong(app_wnd, GWL_EXSTYLE);
        {$ENDIF}
        
        if X_No_frame then
        begin
           style := style and not (WS_BORDER or WS_DLGFRAME
               or WS_CAPTION or WS_MINIMIZEBOX or WS_MAXIMIZEBOX
               or WS_SYSMENU or WS_THICKFRAME);
           exstyle := exstyle and not (WS_EX_CONTROLPARENT
               or WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE
               or WS_EX_CLIENTEDGE or WS_EX_APPWINDOW);
           {$IFDEF FPC}
           {$ELSE}
           if app_wnd <> 0 then
               appexstyle := WS_EX_TOOLWINDOW;
           {$ENDIF}
        end
        else
        begin
           style := style or WS_THICKFRAME or WS_BORDER
               or WS_DLGFRAME or WS_CAPTION or WS_MINIMIZEBOX
               or WS_MAXIMIZEBOX or WS_SYSMENU;
           exstyle := exstyle and not WS_EX_TOOLWINDOW or WS_EX_CLIENTEDGE;
           {$IFDEF FPC}
           {$ELSE}
               if app_wnd <> 0 then
                  appexstyle := appexstyle and not WS_EX_TOOLWINDOW
                  or WS_EX_APPWINDOW;
           {$ENDIF}
        end;
        SetWindowLong(form.Handle, GWL_EXSTYLE, exstyle);
        SetWindowLong(form.Handle, GWL_STYLE, style);
        {$IFDEF FPC}
           ShowWindow(TWin32Widgetset(Widgetset).AppHandle, SW_Hide);
        {$ELSE}
           if app_wnd <> 0 then
           begin
               SetWindowLong(app_wnd, GWL_EXSTYLE, appexstyle);
               ShowWindow(app_wnd, SW_HIDE);
           end;
        {$ENDIF}
        SetWindowPos( form.Handle, 0, 0, 0, 0, 0,
           SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER
           or SWP_FRAMECHANGED );
        form.Invalidate;
       {$ENDIF}
end;

(*
/*
	
FUN Start_move_form(INT F|orm_native_handle),
	NATIVE, DEPRECATED('Platform dependent'):
@	"var form: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_F);"
    "	{$ENDIF}"
    ""
 	"{$IFDEF Linux}"
 	"	 if form.mouse_down_to_move = nil then"
 	"	 begin"
 	"	 	form.mouse_down_to_move := TTimer.Create(form);"
 	"		form.mouse_down_to_move.OnTimer "
 	"			:= {$IFDEF FPC}@{$ENDIF}form.timer_moving_form;"
 	"		form.mouse_down_to_move.Interval := 50;"
 	"		form.mouse_down_to_move.Enabled := false;"
 	"	 end;"
 	"	 if not form.mouse_down_to_move.Enabled then"
 	"	 begin"
 	"	 	form.mouse_down_to_move.Enabled := true;"
 	"		"
 	"	 		form.pos0.x := Form.Left;"
 	"	 		form.pos0.y := Form.Top;"
 	"		"
 	"	 	form.mouse0 :=  Mouse.CursorPos;"
 	"					   "
 	"	 end"
 	"	 else begin"
 	"	 	form.mouse_down_to_move.Enabled := false;"
 	"		form.delta0 := Point(0, 0);"
 	"	 end;"
 	"{$ELSE}"
    "	 ReleaseCapture(); "
    "	 SendMessage(form.Handle, {WM_NCLBUTTONDOWN}$A1, {HT_CAPTION}2, 0);"
    "{$ENDIF}" 
    ""
    .
    
	
FUN Set_form_columns_no_borders(
	INT F|orm_native_handle, BOOL No_borders|_flag), NATIVE:
	"Do_Set_form_columns_no_borders(X_F, X_No_borders);" .
	
*/
*)

procedure Do_Set_form_columns_no_borders(X_F: Integer; X_No_borders: Boolean);
var form: TAL4Form;
begin
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	form := TAL4Form(All_forms[X_F]);
    {$ELSE}
    form := TAL4Form(X_F);
    {$ENDIF}
 	form.No_borders := X_No_borders;
 	
 	{$IFDEF FPC}
 	{$ELSE}
    if X_No_borders then
    begin
	 	form.BevelOuter := bvNone;
	 	form.BevelInner := bvNone;
    end
 	   else
    begin
	 	form.BevelOuter := bvRaised;
	 	form.BevelInner := bvLowered;
    end;
    {$ENDIF}
end;
	
(*
/*
	
	
FUN Set_form_alpha_tran
	|sparency_0opaque_1invisible(
	INT F|orm_native_handle, REAL Tran|sparency_value), NATIVE:
	"	Do_Set_form_alpha_tran(X_F, X_Tran);" .
	
FUN Set_form_colors(
	INT F|orm_native_handle, INT FColor|_int, INT BColor|_int), NATIVE:
	NATIVE @
	"var form: TAL4Form;"
	"var i, j: Integer;"
	"var C: TControl;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_F);"
    "	{$ENDIF}"
	"	 form.Color := X_BColor and $FFFFFF; "
	"	 form.Font.Color := X_FColor and $FFFFFF; "
	"	for i := 0 to form.Columns.Count-1 do"
	"	begin"
	"		for j := 0 to TAL4Column(form.Columns[i])."
	"			 ControlCount  - 1 do"
	"		begin"
	"			C := TAL4Column( form.Columns[i] ).Controls[j];"
	"			if not(C is TLabel) then continue;"
	"			 TLabel(C).Color := X_BColor and $FFFFFF; "
	"			TLabel(C).  Font.Color  := X_FColor and $FFFFFF;"
	"		end;"
	"	end;"
	.
	
FUN Make_form_tool_window(
INT F|orm_native_handle, BOOL Yes|_make), NATIVE : @
	"var form: TAL4Form;"
	"var ex: DWORD;"
	"{$IFDef LINUX}"
	"{$ELSE}"     
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_F);"
    "	{$ENDIF}"
    "	form.HandleNeeded();"  
    "	if not form.Visible then form.Visible := true;"     
    "	ex := GetWindowLong(form.Handle, GWL_EXSTYLE);"
    "	if X_Yes then"
    "	begin"
    "		ex := ex or WS_EX_TOOLWINDOW;"     
    //"		ex := ex and not WS_EX_WINDOWEDGE;"     
    //"		ex := ex and not $40000; //WS_EX_THIKFRAME;"     
    "	end"
    "		     else"
    "	begin"
    "		ex := ex and not WS_EX_TOOLWINDOW;"     
    "	end;"
    "	SetWindowLong(form.Handle, GWL_EXSTYLE, ex);"     
    "	SetWindowPos(form.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or "
    "		SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOZORDER or SWP_NOSIZE"
    "		or SWP_NOMOVE);"     
    "{$ENDIF}".
			
	
	
*/
*)

procedure Do_Set_form_alpha_tran(
	X_F: Integer; X_Tran: Double);
{$IFnDEF LINUX}
const
  LWA_ALPHA=$00000002;
  WS_EX_LAYERED=$00080000;
type
  TSetLayeredWindowAttributes=
    function( hwnd: Integer; crKey: TColor; bAlpha: Byte; dwFlags: DWORD )
    : Boolean; stdcall;
var SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
    User32: THandle;
    dw: DWORD;
{$ENDIF}
var form: TAL4Form;
	Value: Integer;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 form := TAL4Form(All_forms[X_F]);
 	{$ELSE}
     form := TAL4Form(X_F);
 	{$ENDIF}
    Value := 255 - Round(X_Tran * 255);
    {$IFDEF LINUX}
	    form.AlphaBlend := Value < 255;
	    form.AlphaBlendValue := Value;
    {$ELSE}
    	
		 	User32 := GetModuleHandle( 'User32' );
		    SetLayeredWindowAttributes := TSetLayeredWindowAttributes(
		    	GetProcAddress( User32, 'SetLayeredWindowAttributes'));
		    if Assigned( SetLayeredWindowAttributes ) then
		    begin
		        dw := GetWindowLong( form.Handle, GWL_EXSTYLE );
		        if Value > 0 then
		        begin
		            SetWindowLong( 
		            	form.Handle, GWL_EXSTYLE, dw or WS_EX_LAYERED );
		            SetLayeredWindowAttributes( form.Handle, 0, Value {and $FF}, 
		            	LWA_ALPHA);
		        end else
		            SetWindowLong( 
		            	form.Handle, GWL_EXSTYLE, dw and not WS_EX_LAYERED );
		    end;
    	
    {$ENDIF}
end;
    
(*
/*
    
FUNCTION Is_form_active(INT H|andle_form) ==> BOOL, NATIVE :
@   "var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_H]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_H);"
    "	{$ENDIF}"
    "	{$IFDEF LINUX}"
    "	 RESULT := Screen.ActiveForm = F;"
    "	{$ELSE}"
    "		"
    "    		RESULT := GetForegroundWindow = F.Handle;"
    "		" 
    "	{$ENDIF}" .    
    
FUNCTION Make_form_active(INT H|andle_form), NATIVE :
@   "var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_H]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_H);"
    "	{$ENDIF}"
    "	{$IFDEF LINUX}"
    "	 "
    "	{$ELSE}"
    "		if F.Handle <> 0 then"
    "    		SetForegroundWindow(F.Handle);"
    "		" 
    "	{$ENDIF}" .    
    
FUNCTION Set_form_enabled(
	INT H|andle_form, BOOL E|nable_form), NATIVE :
@   "var form: TAL4Form;"
	"	 if X_H = 0 then Exit;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 form := TAL4Form(All_forms[X_H]);"
	"	{$ELSE}"
    "    form := TAL4Form(X_H);"
    "	{$ENDIF}"
    "     form.Enabled := X_E; " .
*/
*)

(*
/*
// Set current column handler (it will be a parent for all new controls)
//----------------------------------------------------------------------

FUN Set_form_current_column_handle(
INT H|andle_form, INT Col|umn_handler), NATIVE :
    "     Do_Set_form_current_column_handle(X_H, X_Col);" .
*/
*)
procedure Do_Set_form_current_column_handle(H, Col: Integer);
var F: TAL4Form;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    F.HCurrent_column_handle := Col;
end;

(*
/*
FUN Set_column_padding(INT Padding|_pixels),
NATIVE : @
"	column_padding := X_Padding;" .
        
// Create column panel on form
//----------------------------

FUN Create_column(
INT F|orm_native_handle, 
{Form}.{layout} Layout | column,
REAL	Width | of_column,
REAL	Label_w | idth,
INT	Nested_in | _parent_column_handle) ==> INT, NATIVE : @
//BOOL	Nested  | column)
	"RESULT := Do_Create_column(X_F, X_layout, X_Width, X_Label_w, X_Nested_in);" .
*/
*)

function Do_Create_column(
H: Integer; Layout: Integer; Width: Double; Label_w: Double; 
Nested_in: Integer): Integer;
var LastCol, ParentCol: TAL4Column;
    F: TAL4Form;
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    i: Integer;
    {$ENDIF}
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    LastCol := TAL4Column.Create(F);
    LastCol.ParentColor := TRUE;

	{$IFDEF FPC}    
	
		if not F.No_borders then
		begin
			LastCol.BorderStyle := bsSingle;
		end;
	
	{$ELSE}
	
    {$IFDEF SCROLLED_COLUMNS}
	    if F.No_borders then
	    begin
	    	LastCol.BevelOuter := bvNone;
	        F.BevelOuter := bvNone;
	        F.BevelInner := bvNone;
	    end 
	    else 
	    begin
	    	if column_padding = 0 then
	    	begin
	    		LastCol.BevelOuter := bvNone;	
	    	end;
	    	LastCol.BevelWidth := column_padding;
	    end;
    {$ELSE}
    	F.BevelOuter := bvNone;
        F.BevelInner := bvNone;
    	LastCol.BevelOuter := bvNone;
    	LastCol.BevelInner := bvNone;
    	LastCol.BevelWidth := 1;
    	LastCol.BorderWidth := 0;
    	//LastCol.Ctl3D := false;
    {$ENDIF}
    
    {$ENDIF}

	{$IFDEF FPC}
	LastCol.AutoSize := FALSE;
	{$ENDIF}
	LastCol.Label_width := Points(Label_w);
    LastCol.OnClick := {$IFDEF OBJFPC}@{$ENDIF} F.Form_clicked;
    LastCol.OnMouseMove := {$IFDEF OBJFPC}@{$ENDIF} F.Form_mouse_move;
    LastCol.OnMouseDown := {$IFDEF OBJFPC}@{$ENDIF} F.Form_mouse_down;
    LastCol.OnMouseUp := {$IFDEF OBJFPC}@{$ENDIF} F.Form_mouse_up;
    LastCol.OnMouseWheel := {$IFDEF OBJFPC}@{$ENDIF} F.Form_mouse_wheel;
    {$IFnDEF FPC}
    LastCol.OnResize := F.Column_resize;
    {$ENDIF} 
    
    if Nested_in <> 0 then
    begin
    	LastCol.Nested_in_column := Nested_in;
    end;

    LastCol.Parent := F;
    F.Add_column(LastCol);
    {$IFDEF MOBILE_SCREEN}
    	Set_height(LastCol, F.BoundsRect.Width - YPos(LastCol));
    {$ELSE}
    	Set_height(LastCol, F.ClientHeight - YPos(LastCol));
    {$ENDIF}
    if  Width > 0 then
    begin
        Set_width(LastCol, Points(Width));
        Set_height(LastCol, Points(Width));
    end
    else
    begin
        Set_width(LastCol, Points(200));
        Set_height(LastCol, Points(200));
    end;
    LastCol.Layout := Layout;
    
    LastCol.Horizontal := Layout >= 3;
    if LastCol.Horizontal then 
    begin
    	Set_height(LastCol, Points({$IFDef LINUX} 28 {$ELSE} 28 {$ENDIF}));
    	{$IFDEF SCROLLED_COLUMNS}
    	{$IFDEF SWIPE_FORMS}
    		
	    		LastCol.VertScrollbar.Visible := FALSE;
	    		LastCol.HorzScrollbar.Visible := FALSE;
    		
    	{$ELSE}
	    	 LastCol.VertScrollbar.Visible := FALSE;
	    	
    	{$ENDIF}
    	{$ENDIF}
    end;
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := -1;
    	for i := 1 to Column_descr.Count-1 do
    		if Column_descr[i] = nil then
    		begin
    			Result := i;
    			break;
    		end;
    	if Result < 0 then
    	begin
    		Result := Column_descr.Count;
    		Column_descr.Add(nil);
    	end;
    	Column_descr[Result] := LastCol;
    {$ELSE}
    	Result := Integer(LastCol);
    {$ENDIF}
    LastCol.Tag := Result;
    F.HCurrent_column_handle := Result;
    //{$IFDEF FPC}
    F.Adjust_columns;
    //{$ENDIF}
end;

(*
/*

FUN Get_column_layout(
INT C|olumn_handle) ==> {Form}.{layout}, NATIVE : @
    "var Col: TAL4Column;"
	"	 if X_C = 0 then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    Col := TAL4Column(Column_descr[X_C]);"
    "{$ELSE}"
    "    Col := TAL4Column(X_C);"
    "{$ENDIF}"
	"	RESULT := Col.Layout;" .

FUN Get_nested_in(
INT C|olumn_handle) ==> INT, NATIVE : @
    "var Col: TAL4Column;"
	"	 if X_C = 0 then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    Col := TAL4Column(Column_descr[X_C]);"
    "{$ELSE}"
    "    Col := TAL4Column(X_C);"
    "{$ENDIF}"
	"	RESULT := Col.Nested_in_column;" .



FUN Form_suspend_layout(
INT Handle|_of_form_to_suspend), CALLBACK : .

FUN Form_resume_layout(
INT Handle|_of_form_to_resume), CALLBACK : .

FUN Form_suspend_column(
INT Handle|_of_form, INT Col|umn_index), NATIVE: @
"var F: TAL4Form;"
"var col: TAL4Column;"
"	if (X_Handle = 0) or (X_Col < 0) then Exit;"
"{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
"	F := TAL4Form(All_forms[X_Handle]);"
"{$ELSE}"
"	F := TAL4Form(X_Handle);"
"{$ENDIF}"
"	if (F = nil) then Exit;"
"	col := TAL4Column(F.Columns[X_Col]);"
"	if col.suspend_count = 0 then"
"		col.DisableAlign();"
"	inc(col.suspend_count);"
//"	Writeln('++ col.suspend_count=' + IntToStr(col.suspend_count));"
.

FUN Form_resume_column(
INT Handle|_of_form, INT Col|umn_index), NATIVE: @
"var F: TAL4Form;"
"var col: TAL4Column;"
"	if (X_Handle = 0) or (X_Col < 0) then Exit;"
"{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
"	F := TAL4Form(All_forms[X_Handle]);"
"{$ELSE}"
"	F := TAL4Form(X_Handle);"
"{$ENDIF}"
"	if (F = nil) then Exit;"
"	col := TAL4Column(F.Columns[X_Col]);"
//"	Writeln('-- col.suspend_count=' + IntToStr(col.suspend_count));"
"	dec(col.suspend_count);"
"	if col.suspend_count = 0 then"
"	begin"
"		col.EnableAlign();"
"		Adjust_control_location(col, nil);" 
"		col.Realign();"
"	end;" .

FUN Get_form_column_controls_layout(
	INT Col|umn_handler) ==> {Form}.{controls_layout}, NATIVE : @
"var col: TAL4Column;"
"{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
"	if X_Col < 0 then Exit;"
"	col := TAL4Column(Column_descr[X_Col]);"
"{$ELSE}"
"	col := TAL4Column(X_Col);"
"{$ENDIF}"
"	RESULT := col.controls_layout;" .

FUN Set_form_column_controls_layout(
	INT Col|umn_handler,
	{controls_layout} CL|ayout_controls), NATIVE : @
"var col: TAL4Column;"
"{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
"	if (X_Col < 0) then Exit;"
"   col := TAL4Column(Column_descr[X_Col]);"
"{$ELSE}"
"   col := TAL4Column(X_Col);"
"{$ENDIF}"
"	col.controls_layout := X_CL;" . 

FUN Get_form_column_uses_margins(
INT C|olumn_handle) ==> BOOL,
	NATIVE :
	CASE C == 0 ? ==> ;
	NATIVE @     
   "var LastCol: TAL4Column;"
   "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
   "    LastCol := TAL4Column(Column_descr[X_C]);"
   "{$ELSE}"
   "    LastCol := TAL4Column(X_C);"
   "{$ENDIF}"
"	RESULT := not LastCol.No_margins;" .

FUN Set_form_column_margins(
INT C|olumn_handle, BOOL Use_margins), NATIVE : @
   "var LastCol: TAL4Column;"
   "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
   "    LastCol := TAL4Column(Column_descr[X_C]);"
   "{$ELSE}"
   "    LastCol := TAL4Column(X_C);"
   "{$ENDIF}"
   "LastCol.No_margins := not X_Use_margins;" .
   
FUN Get_column_label_width|_limit(
	INT C|olumn_handle) ==> REAL, NATIVE :
	CASE C == 0 ? ==> ;
	NATIVE @
   "var LastCol: TAL4Column;"
   "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
   "    LastCol := TAL4Column(Column_descr[X_C]);"
   "{$ELSE}"
   "    LastCol := TAL4Column(X_C);"
   "{$ENDIF}"
   "RESULT := AL4_form.Pixels(LastCol.Label_width);" .

// Set column label width which is sufficient short to label next control 
// to right (rather then place it below):
//-------------------------

FUN Set_column_label_width_limit(
	INT C|olumn_handle, REAL Lab|el_width),	NATIVE : @
    "    Do_Set_column_label_width_limit(X_C, X_Lab);" .
*/
*)

procedure Do_Set_column_label_width_limit(
	HC: Integer; const LabW: Double);
var LastCol: TAL4Column;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		LastCol := TAL4Column(Column_descr[HC]);
	{$ELSE}
    	LastCol := TAL4Column(HC);
	{$ENDIF}
    LastCol.Label_width := AL4_form.Points(LabW);
end;

(*
/*

FUN Set_column_position_pixels(
	INT C|olumn_handle, INT Left|_position, INT Top|_position),	
    NATIVE : @ 
    "var Col: TAL4Column;"
	"	 if X_c = 0 then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    Col := TAL4Column(Column_descr[X_c]);"
    "{$ELSE}"
    "    Col := TAL4Column(X_c);"
    "{$ENDIF}"
	"	Col.Left := X_Left;" 
	"	Col.Top := X_Top;" .


// Set column height
// (in points, only for BOTTOM and TOP aligned columns):
//-------------------------

FUN Set_form_column_width(
	INT C|olumn_handle, REAL Width|_value),	
    NATIVE : 
    "    Do_Set_column_width(X_C, X_Width);" .
    
FUN Set_column_width_pixels(
	INT C|olumn_handle, INT Width|_pixels),	NATIVE : @
    "var Col: TAL4Column;"
	"	 if X_C = 0 then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    Col := TAL4Column(Column_descr[X_C]);"
    "{$ELSE}"
    "    Col := TAL4Column(X_C);"
    "{$ENDIF}"
	"	 Col.Width := X_Width;" .

FUN Set_form_column_height(
	INT C|olumn_handle, REAL Height|_value), NATIVE : @ 
    "    Do_Set_column_height(X_C, X_Height);" .
    
FUN Set_column_height_pixels(
	INT C|olumn_handle, INT Height|_pixels), NATIVE : @ 
    "var Col: TAL4Column;"
	"	 if X_C = 0 then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    Col := TAL4Column(Column_descr[X_C]);"
    "{$ELSE}"
    "    Col := TAL4Column(X_C);"
    "{$ENDIF}"
	"	 Col.Height := X_Height;" .

*/
*)

procedure Do_Set_column_width(
	HC: Integer; const Width: Double);
var LastCol: TAL4Column;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		LastCol := TAL4Column(Column_descr[HC]);
	{$ELSE}
    	LastCol := TAL4Column(HC);
	{$ENDIF}
    if LastCol = nil then Exit;
    Set_width(LastCol, Points(Width));
    Adjust_control_location(LastCol, nil);
end;

procedure Do_Set_column_height(
	HC: Integer; const Height: Double);
var LastCol: TAL4Column;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		LastCol := TAL4Column(Column_descr[HC]);
	{$ELSE}
    	LastCol := TAL4Column(HC);
	{$ENDIF}
    if LastCol = nil then Exit;
    Set_height(LastCol, Points(Height));
    Adjust_control_location(LastCol, nil);
end;

(*
/*

FUN Set_form_column_auto_arrange(
	INT C|olumn_handle, BOOL A|uto_arrange), NATIVE : 
@   "var LastCol: TAL4Column;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "	LastCol := TAL4Column(Column_descr[X_C]);"
    "{$ELSE}"
    "	LastCol := TAL4Column(X_C);"
    "{$ENDIF}"
    "   LastCol.auto_arrange := X_A;" 
    "   if X_A then Adjust_control_location(LastCol, nil);" .

FUN Set_default_forms_font(
{Screen} Screen|_object, STR Face|name, REAL Size|points)
	:
	Screen.Default_font_face = Face
	Screen.Default_font_size = Size .

FUN Set_form_column_font(
INT C|olumn_handle,
STR Face | name,
REAL Size| font,
STR Styles| B_I_U_S), NATIVE : @ 
    "var LastCol: TAL4Column;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "	LastCol := TAL4Column(Column_descr[X_C]);"
    "{$ELSE}"
    "	LastCol := TAL4Column(X_C);"
    "{$ENDIF}"
    "	"
    "	LastCol.Font.Name := X_face;" 
    "	LastCol.Font.Size := Trunc(X_size);"
    "	LastCol.Font.Style := [];"
    "	if pos('B', X_styles{$IFDEF FPC}.Value{$ENDIF}) > 0 then"
    "		LastCol.Font.Style := ["
    "		 fsBold];" 
    "	if pos('I', X_styles{$IFDEF FPC}.Value{$ENDIF}) > 0 then"
    "		LastCol.Font.Style "
    "		:= LastCol.Font.Style + ["
    "		 fsItalic];" 
    "	if pos('U', X_styles{$IFDEF FPC}.Value{$ENDIF}) > 0 then"
    "		LastCol.Font.Style "
    "		:= LastCol.Font.Style + ["
    "		 fsUnderline];" 
    "	if pos('S', X_styles{$IFDEF FPC}.Value{$ENDIF}) > 0 then"
    "		LastCol.Font.Style "
    "		:= LastCol.Font.Style + ["
    "		 fsStrikeout];"
    "	" 
    .
*/
*)


(*
/*
// Set column string "name"
//-------------------------

FUN Set_column_alias(
INT C|olumn_handle, STR Alias|_of_column),
        NATIVE :
    "     Do_Set_column_alias(X_C, X_Alias);" .
*/
*)
procedure Do_Set_column_alias(HC: Integer; const Alias: String);
var LastCol: TAL4Column;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		LastCol := TAL4Column(Column_descr[HC]);
	{$ELSE}
    	LastCol := TAL4Column(HC);
	{$ENDIF}
    LastCol.Alias := Alias;
end;

(*
/*

FUN Disable_column_scroll(INT C|olumn_handle),
        NATIVE : @
"var LastCol: TAL4Column;"
"    {$IFDEF USE_LISTS_OF_DESCRIPTORS}"
"        LastCol := TAL4Column(Column_descr[X_C]);"
"    {$ELSE}"
"        LastCol := TAL4Column(X_C);"
"    {$ENDIF}"
"	 {$IFDEF SCROLLED_COLUMNS}"     
"    LastCol.VertScrollbar.Visible := false;"
"	 {$ENDIF}"     
.     

// Get column by index
//--------------------

FUN Get_column_handler(
INT F|orm_native_handle, INT Index|_column) ==> INT,
        NATIVE :
    "    RESULT := Do_Get_column_handler(X_F, X_Index);" .
*/
*)
function Do_Get_column_handler(F, Index: Integer): Integer;
var Col: TAL4Column;
	form: TAL4Form;
begin
    Result := 0;
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 form := TAL4Form(All_forms[F]);
 	{$ELSE}
     form := TAL4Form(F);
 	{$ENDIF}
    if  (Index < 0) or (Index >= form.Columns.Count) then
        Exit;
    Col := TAL4Column(form.Columns[Index]);
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := Column_descr.IndexOf(Col);
    {$ELSE}
    	Result := Integer(Col);
    {$ENDIF}
end;

(*
/*
// Get column width in points
//----------------------------

FUN Get_column_width(INT C|olumn_handle) ==> REAL,
    NATIVE : @
    "    RESULT := Do_Get_column_width(X_C);" .
    
FUN Get_column_pos_pixels(
INT C|olumn_handle, STR W|hat_L_T_W_H) ==> INT, NATIVE : @
    "var Col: TAL4Column;"
	"	 if X_C = 0 then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    Col := TAL4Column(Column_descr[X_C]);"
    "{$ELSE}"
    "    Col := TAL4Column(X_C);"
    "{$ENDIF}"
    "case {$IFDEF FPC} Str_X_W[1] {$ELSE} X_W[1] {$ENDIF} of"
	"'L': RESULT := Col.Left;" 
	"'T': RESULT := Col.Top;" 
	"'W': RESULT := Col.Width;" 
	"'H': RESULT := Col.Height;"
	"end;" .
	
*/
*)
function Do_Get_column_width(X_C: Integer): Double;
var Col: TAL4Column;
begin
	Result := 0;
	if X_C = 0 then Exit;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Col := TAL4Column(Column_descr[X_C]);
	{$ELSE}
    	Col := TAL4Column(X_C);
	{$ENDIF}
    Result := Pixels( Col.ClientWidth );
end;

(*
/*
// Get column height in points
//----------------------------
FUN Get_column_height(INT C|olumn_handle) ==> REAL,
    NATIVE :
    "    RESULT := Do_Get_column_height(X_C);" .
*/
*)
function Do_Get_column_height(X_C: Integer): Double;
var Col: TAL4Column;
begin
	Result := 0;
	if X_C = 0 then Exit;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Col := TAL4Column(Column_descr[X_C]);
	{$ELSE}
    	Col := TAL4Column(X_C);
	{$ENDIF}
    Result := Pixels( Col.ClientHeight );
end;

(*
/*
// Get column (parent to a certain control) left position
//----------------------------
FUN Get_parent_column_left(INT Handle|control) ==> REAL,
    NATIVE :
    "    RESULT := Do_Get_parent_column_left(X_Handle);" .
*/
*)
function ParentColumn(C: TControl): TAL4Column;
var P:  TWinControl  ;
begin
	P := C.Parent;
	while P <> nil do
	begin
		if P is TAL4Column then
		begin
			Result := TAL4Column(P); 
			Exit;
		end;
		P := P.Parent;
		if P is TCustomForm then break;
	end;
	Result := nil;
end;


function Do_Get_parent_column_left(X_C: Integer): Double;
var Ctl: THackControl; 
	col: TAL4Column;
begin
	Ctl := HackControl(X_C);
	col := ParentColumn(Ctl);
	if col <> nil then
		Result := Pixels(XPos(col))
	else Result := 0;
end;

(*
/*
// Get column (parent to a certain control) left position
//----------------------------

FUN Get_parent_column_visible(INT Handle|control) ==> BOOL,
    NATIVE :
    "    RESULT := Do_Get_parent_column_visible(X_Handle);" .
*/
*)

function Do_Get_parent_column_visible(X_C: Integer): Boolean;
var Ctl: THackControl; 
	col: TAL4Column;
begin
	Ctl := HackControl(X_C);
	col := ParentColumn(Ctl);
	if col <> nil then
		Result := col.Visible
	else Result := false;
end;

(*
/*
// Get column (parent to a certain control) top position
//----------------------------
FUN Get_parent_column_top(INT Handle|control) ==> REAL,
    NATIVE :
    "    RESULT := Do_Get_parent_column_top(X_Handle);" .
*/
*)
function Do_Get_parent_column_top(X_C: Integer): Double;
var Ctl: THackControl; 
	col: TAL4Column;
begin
	Ctl := HackControl(X_C);
	col := ParentColumn(Ctl);
	if col <> nil then
		Result := Pixels(YPos(col))
	else Result := 0;
end;

(*
/*
// Get column visible
//----------------------------

FUN Get_column_visible(
INT C|olumn_handle) ==> BOOL, NATIVE
    :
    "    Result := Do_Get_column_visible(X_C);" .
*/
*)
function Do_Get_column_visible(
X_C: Integer): Boolean;
var Col: TAL4Column;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Col := TAL4Column(Column_descr[X_C]);
	{$ELSE}
    	Col := TAL4Column(X_C);
	{$ENDIF}
    Result := Col.Visible;
end;

(*
/*
//----------------------------

FUN Get_column_hidden(INT C|olumn_handle) ==> BOOL, NATIVE :
    "    Result := Do_Get_column_hidden(X_C);" .
*/
*)
function Do_Get_column_hidden(
X_C: Integer): Boolean;
var Col: TAL4Column;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Col := TAL4Column(Column_descr[X_C]);
	{$ELSE}
    	Col := TAL4Column(X_C);
	{$ENDIF}
    Result := not Col.Visible;
end;


(*
/*
// Set column visible
//----------------------------

FUN Set_column_visible(
INT C|olumn_handle, BOOL V|isible_value), 
    NATIVE :
    "    Do_Set_column_visible(X_C, X_V);" .
    
FUN Adjust_columns(INT F|orm_native_handle), NATIVE : 
@	"var F: TAL4Form;"	
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
	"F.Adjust_columns();" .
    
FUN Get_form_mobile_config|uration(
INT F|orm_handle) ==> {Form}.{mobile_config}, NATIVE :
@	"var F: TAL4Form;"	
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
    "	{$IFDEF SWIPE_FORMS}"
    "	RESULT := F.Mobile_configuration;"
    "	{$ENDIF}" .
	
FUN Set_form_mobile_config|uration(
INT F|orm_handle, {mobile_config} MC|onfiguration_to_set),
NATIVE :
@	"var F: TAL4Form;"	
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"    
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
    "	{$IFDEF SWIPE_FORMS}"
    "	F.Mobile_configuration := X_MC;"
    "	{$ENDIF}" 
    "	F.Adjust_columns;" .
	
*/
*)

{$IFDef FPC}
{$IFnDEF LINUX}
procedure TAL4Form.ProcessResource;
begin
end;
{$ENDIF}
{$ENDIF}

var adjusting_columns: Boolean;
{$IFDEF BOTTOM_LAST}
var Min_height_c: Double;
{$ENDIF}		

procedure TAL4Form.Adjust_columns;
var R:  TRect  ;
	Col: TAL4Column;
	i: Integer;
	{$IFDEF SWIPE_FORMS}
	j: Integer;
	c: TAL4Column;
	{$ENDIF}
begin
    if (adjusting_columns) then Exit;
    adjusting_columns := true;
    try
    	{$IFDEF MOBILE_SCREEN}
        	R := BoundsRect;
    	{$ELSE}
        	R := ClientRect;
    	{$ENDIF}
    	
        //writeln('call Do_adjust_columns: ' + IntToStr(R.Right - R.Left) +
        //' x ' + IntToStr(R.Bottom - R.Top));
    	
    	C_Form.M_Do_adjust_columns(AL4Object,
    		R.Right - R.Left, R.Bottom - R.Top);
    	
    	//Application.ProcessMessages;
        for i := 0 to Columns.Count - 1 do
        begin
            Col := TAL4Column(Columns[i]);
            Adjust_control_location(Col, nil);
        end;
    finally
        adjusting_columns := false;
    end;
end;

procedure TAL4Form.Add_column(ACol: TAL4Column);
var i: Integer;
	c: TAL4Column;
const priority:array[0..4] of Integer = (
	2, 1, 3, 0, 4);
begin
	for i := 0 to Columns.Count-1 do
	begin
		c := TAL4Column(Columns[i]);
		if c.Layout = ACol.Layout then continue;
		if priority[c.Layout] < priority[ACol.Layout] then continue;
		Columns.Insert(i, ACol);
		Exit;
	end;
	Columns.Add(ACol);
end;

procedure Do_Set_column_visible(X_C: Integer; X_V: Boolean);
var Col: TAL4Column;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Col := TAL4Column(Column_descr[X_C]);
	{$ELSE}
    	Col := TAL4Column(X_C);
	{$ENDIF}
    Col.Visible := X_V;
end;

(*
/*
// Set last created column horizontally aligned
//---------------------------------------------

FUN Set_horizontal(INT F|orm_native_handle),
        NATIVE :
    "     Do_Set_horizontal(X_F);" .
*/
*)

procedure Do_Set_horizontal(H: Integer);
var LastCol, PrevCol: TAL4Column;
    F: TAL4Form;
    i: Integer;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
    LastCol := TAL4Column(F.Columns[F.Columns.Count-1]);
    if  LastCol.Horizontal then Exit;
    LastCol.Horizontal := TRUE;
    if  F.Columns.Count = 1 then
    begin
        LastCol.Anchors := [];
        Set_height(LastCol, Points(20));
        {$IFDEF MOBILE_SCREEN}
        	Set_width(LastCol, F.BoundsRect.Width);
        {$ELSE}
        	Set_width(LastCol, F.ClientWidth);
        {$ENDIF}
        LastCol.Anchors := [
        	
        	akTop, akLeft, akRight
        	
        ];
        Exit;
    end;
    LastCol.Anchors := [
    	
    	akLeft, akTop
    	
    ];
    Set_height(LastCol, Points(20));
    {$IFDEF MOBILE_SCREEN}
	    SetPos(LastCol, AL4_form.Points(2),
	    		F.BoundsRect.Height - LastCol.Height);
    {$ELSE}
	    SetPos(LastCol, AL4_form.Points(2),
	    		F.ClientHeight - LastCol.Height);
    {$ENDIF}
    for i := F.Columns.Count-2 downto 0 do
    begin
        PrevCol := TAL4Column(F.Columns[i]);
        if  PrevCol.Horizontal then break;
        Set_height(PrevCol, YPos(LastCol) - YPos(PrevCol));
    end;
    {$IFDEF MOBILE_SCREEN}
    	Set_width(LastCol, F.BoundsRect.Width);
    {$ELSE}
    	Set_width(LastCol, F.ClientWidth);
    {$ENDIF}
    LastCol.Anchors := [
    	
    	akLeft, akRight, akBottom
    	
    ];
end;

(*
/*
// Destroy control object
//-----------------------

FUN Control_suspend({Control} T|he_control) : .
        
FUN Control_resume({Control} T|he_control) : .

FUN Destroy_control|_native({Control} C|ontrol_object) :
    CASE C.Form_.Handle == 0 ? zero_control_handle(C) ==> ;
    STR save|_current_column = C.Form_.Current_column
    C.Form_.Set_current_column(C.parent_column_alias)
    do_destroy_control(C.Handle) 
    C.Form_.Set_current_column(save) .

FUN do_destroy_control|_native(INT Contr|ol_handle), NATIVE :
@	"	do_destroy_control(X_Contr);" .

FUN zero_control_handle({Control} Contr|ol_to_zero_handle), NATIVE :
    "     C_Control(X_Contr.Obj).F_Handle := 0;" .

FUN parent_column_alias({Control} C|ontrol_to_get_parent_column) ==> STR,
NATIVE : @
   "var h: Integer;"
   "var col: TAL4Column;"
   "	h := C_Control(X_C.Obj).F_Handle;"
   "	col := ParentColumn(HackControl(h));"
   "    RESULT := col.Alias;" .
    
*/
*)

procedure do_destroy_control(X_Contr: Integer);
var Col: TAL4Column;
	P:  TControl ;
	C: TControl;
begin
	if X_Contr = 0 then Exit;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TControl(All_controls[X_Contr]);
	{$ELSE}
		C := TControl(X_Contr);
	{$ENDIF}
	P := C.Parent;
	if P = nil then Exit;
	if P is TAL4Column then
	begin 
	 	Col := TAL4Column( P );
	 	Col.ListControls.Remove(C);
    end;
    C.Free;
end;

(*
/*
// Terminate application immediately
//----------------------------------
FUN Application_terminate, NATIVE :
    "    Application.Terminate;"
    "    //TerminateProcess(GetCurrentProcess, 0);".
*/
*)

(*
/*
// Get active control on form
//---------------------------

FUN Obtain_active_control(
{Form} F|orm_object) ==> {Control}, NATIVE :
	INT h|andle_form = F.Handle
	NATIVE @
    "    RESULT := Do_Obtain_active_control(X_h);" .
*/
*)
function Do_Obtain_active_control(H: Integer): Ref_obj;
var F: TAL4Form;
    W:  TWinControl ;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 F := TAL4Form(All_forms[H]);
 	{$ELSE}
     F := TAL4Form(H);
 	{$ENDIF}
 	
 	W := nil;
 	if F <> nil then
    	W := F.ActiveControl;
	
    if  W = nil then
    begin
        Result := NoneObj_C_Control.hard_link;
        Exit;
    end;
    Result := Ref_obj(W. Tag );
    if Result = nil then
       Result := NoneObj_C_Control.hard_link;
end;

(*
/*
// Activate certain control
//-------------------------
FUN Activate_control(INT H|andle_form, INT C|ontrol_native), NATIVE :
    "     Do_Activate_control(X_H, X_C);" .
*/
*)
procedure Do_Activate_control(H: Integer; X: Integer);
var W: TWinControl;
    C: TControl;
    F: TAL4Form;
    //Wnd: HWnd;
    i: Integer;
begin
    C := HackControl(X);
    if  C is  TWinControl  then
    begin
        W := C  as TWinControl ;
	 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	 	 F := TAL4Form(All_forms[H]);
	 	{$ELSE}
	     F := TAL4Form(H);
	 	{$ENDIF}
        TRY

            {$IFDEF LINUX}
                	while (W.Handle = 0) and (W <> nil) do
                		W := W.Parent;
                	for i := 0 to W.ControlCount-1 do
                	begin
                		if (W.Controls[i] is TWinControl) and
                		   (TWinControl(W.Controls[i]).Handle <> 0) 
                		   //and W.Controls[i].CanFocus 
                			then
                		begin
                			W := TWinControl(W.Controls[i]);
                			break;
                		end;
                	end;
            F.ActiveControl := W;
            {$ELSE}
            
                try
                	while (W.Handle = 0) and (W <> nil) do
                		W := W.Parent;
                	for i := 0 to W.ControlCount-1 do
                	begin
                		if (W.Controls[i] is TWinControl) and
                		   (TWinControl(W.Controls[i]).Handle <> 0) 
                		   //and W.Controls[i].CanFocus 
                			then
                		begin
                			W := TWinControl(W.Controls[i]);
                			break;
                		end;
                	end;
            		F.ActiveControl := W;
            		
            		{$IFDEF FPC}
                       //PostMessage(F.Handle, WM_NEXTDLGCTL, 0, 0);
                       //PostMessage(F.Handle, WM_NEXTDLGCTL, 1, 0);
            		{$ELSE}
                    {$ENDIF}
                    //Application.ProcessMessages;
                except on Ex: Exception do
					   begin
					   		if Ex is AL4_Exception then raise;
					   end
                end;

            {$ENDIF}
        EXCEPT on Ex2: Exception do
			   begin
			   		if Ex2 is AL4_Exception then raise;
			   end
        END;
    end;
end;

(*
/*
// Move control into view area on parent column if  it is scrolled out
//--------------------------------------------------------------------
FUN Make_control_visible(INT H|andle_form, INT C|ontrol_to_move_to_view),
        NATIVE :
    "     Do_Make_visible(X_H, X_C);" .
*/
*)
procedure Do_Make_visible(H: Integer; C: Integer);
begin
    //todo:
end;

(*
/*
// Get control left position in points (on its column)
//----------------------------------------------------

FUN Get_control_left|_position(
{Control} C|ontrol_object) ==> REAL, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "    RESULT := Do_Get_control_left(X_h);" .
*/
*)
function Do_get_control_left(H: Integer): Double;
var C: THackControl;
begin
    C := HackControl(H);
    Result := Pixels(XPos(C));
end;

(*
/*
// Get control top position in points (on its column)
//---------------------------------------------------

FUN Get_control_top|_position(
{Control} C|ontrol_object) ==> REAL, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "    RESULT := Do_Get_control_top(X_h);" .
*/
*)
function Do_get_control_top(H: Integer): Double;
var C: THackControl;
begin
    C := HackControl(H);
    Result := Pixels(YPos(C)); 
end;

(*
/*
// Set control position in points
//-------------------------------

FUN Set_control_pos|ition(
	INT C|ontrol_to_pos, REAL X|_offset, REAL Y|_offset),
        NATIVE :
    "     Do_Set_control_pos(X_C, X_X, X_Y);" .
*/
*)

procedure Do_Set_control_pos(
	H: Integer; X, Y: Double);
var C: THackControl;
begin
    C := HackControl(H);
    SetPos(C, Points(X), Points(Y));
end;

(*
/*
// Is autosized ?
//---------------------------
FUN Is_autosized_control(INT C|ontrol_to_check) ==> BOOL, NATIVE :
    "     RESULT := Do_Is_autosized_control(X_C);" .
*/
*)
function Do_Is_autosized_control(H: Integer): Boolean;
var C: TControl;
begin
    C := HackControl(H);
    RESULT := (C is TLabel) or (C is TButton);
end;

(*
/*
// Get control width in points
//----------------------------

FUN Get_control_width|_points(
{Control} C|ontrol_object) ==> REAL, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "    RESULT := Do_Get_control_width(X_h);" .
*/
*)
function Do_get_control_width(H: Integer): Double;
var C: THackControl;
begin
    C := HackControl(H);
    Result := Pixels(C.Width);
end;

(*
/*

FUN Get_label_desired_width(
{Control} C|ontrol_label) ==> REAL, NATIVE :
	INT h|andle_control = C.Handle
	//STR t|ext_of_label = C.Text
	CASE h == 0 ? ==> ;
	NATIVE @     
	//{Bitmap} b|itmap_temp = New_bitmap(1, 1, 32)
	"RESULT := Do_Get_label_desired_width(X_h);" .
*/
*)	

function Do_Get_label_desired_width(H: Integer): Double;
var C: TLabel;
	B: Graphics.TBitmap;
	g: TCanvas;
	{$IFDEF FPC}
	{$ELSE}
	sz: TSize;
	{$ENDIF}
begin
	C := TLabel(HackControl(H));
	b := Graphics.TBitmap.Create();
	try
	b.Width := 1;
	b.Height := 1;
	g := b.Canvas;
	g.Font := C.Font;
	{$IFDEF FPC}
		RESULT := Pixels(g.TextWidth(C.Caption));
	{$ELSE}
		sz := g.TextExtent(C.Caption);
		RESULT := Pixels(sz.cX);
	{$ENDIF}
	finally
		b.Free;
	end;
end;
        
(*
/*
// Get control height in points
//-----------------------------

FUN Get_control_height|_points(
{Control} C|ontrol_object) ==> REAL, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "    RESULT := Do_Get_control_height(X_h);" .
*/
*)
function Do_get_control_height(H: Integer): Double;
var C: THackControl;
begin
    C := HackControl(H);
    Result := Pixels(C.Height);
end;

(*
/*

        FUN Get_control_client_width(
        {Control} C|ontrol_object) ==> REAL, NATIVE :
			INT h|andle_control = C.Handle
			CASE h == 0 ? ==> ;
			NATIVE @
            "var C: THackControl;" 
            "C := HackControl(X_h);"
            "RESULT := C.ClientWidth;" .
            
        FUN Get_control_client_height(
        {Control} C|ontrol_object) ==> REAL, NATIVE :
			INT h|andle_control = C.Handle
			CASE h == 0 ? ==> ;
			NATIVE @
            "var C: THackControl;" 
            "C := HackControl(X_h);"
            "RESULT := C.ClientHeight;" .
            
// Set control size in points
//---------------------------

FUN Set_control_size|_auto(
	INT C|ontrol_to_pos, REAL W|idth_set, REAL H|eight_set),
        NATIVE :
    "     Do_Set_control_size(X_C, X_W, X_H);" .
*/
*)

{$IFDEF FPC}
var Setting_control_size: Integer = 0;
{$ENDIF}

procedure Do_Set_control_size(
	H: Integer; Width, Height: Double);
var C: TControl;
begin
	{$IFDEF FPC}
	if Setting_control_size > 0 then Exit;
	inc(Setting_control_size);
	try
	{$ENDIF}
    C := HackControl(H);
    {$IFDEF FPC}
    C.AutoSize := false;
    {$ELSE}
    if C is TLabel then
       TLabel(C).AutoSize := false
    //else if C is TButton then
    //    TButton(C).AutoSize := false
    ;
    {$ENDIF}
    if Width > 0 then Set_width(C, Points(Width));
    if Height > 0  then Set_height(C, Points(Height));
    {$IFDEF FPC}
    finally
    	dec(Setting_control_size);
    end;
    {$ENDIF}
end;

(*
/*
// Set control text
//---------------------

FUN Set_control_caption(
{Control} C|ontrol_object, STR Text|_set), NATIVE :
	INT h|andle_control = C.Handle
	CASE h==0 ? ==> ;
	NATIVE @   "   Do_Set_control_caption(X_h, X_Text);" .
*/
*)

procedure Do_Set_control_caption(H: Integer; const Text: String);
var C: TControl;
    CC: C_Control;
    Bmp:  Graphics  .TBitmap;
    Canv: TCanvas;
    w: Integer;
    {$IFDEF FPC}
    {$ELSE}
    sz: TSize;
    {$ENDIF}
    col: TAL4Column;
    same_text: Boolean;
    
//?{Form}.value_change
    cF: C_Form;
//.
begin
    C := HackControl(H);
    CC := C_Control(ref_obj_from_control(C).Obj);
    if CC <> nil then begin end;
    	// autosize button on base its caption size
    if (TObject(C) is TButton) or (TObject(C) is TCheckbox) 
      {$IFDef FPC} or (TObject(C) is TLabel) 
      			   and (TLabel(C).AutoSize)
      {$ENDIF}
    then
    begin
    	col := ParentColumn(TControl(C));
    	if (col <> nil) and (col.Layout in [3, 4] {top | bottom}) then
    	begin
	    	Bmp :=  Graphics  
	    			.TBitmap.Create();
	    	Bmp.Width := 1;
	    	Bmp.Height := 1;
	    	Canv := Bmp.Canvas;
	    	
	    		Canv.Font := THackControl(C).Font;
	    		Canv.Font.Style := Canv.Font.Style + [fsBold];
	    	
	    		{$IFDEF FPC}
	    		w := Canv.TextWidth(Text);
	    		{$ELSE}
		    	sz := Canv.TextExtent(Text);
		    	w := sz.cx;
		    	{$ENDIF}
		    	if (TObject(C) is TCheckbox) or (TObject(C) is TButton) then
		    		w := w * 4 div 3;
		    	if (TObject(C) is TCheckbox) or
		    	   (TObject(C) is TButton) and TButton(C).Default then
		    		w := w + 18;
		    	Set_width(TControl(C), Points(8) + w);
	    	
    	end;
    end;    
	same_text := HackControl(H).Caption = Text;
	HackControl(H).Caption := Text;
	if same_text then Exit;
    
//?{Form}.value_change
    cF := C_Form(C_Control(ref_obj_from_control(HackControl(H)).Obj).F_Form_.Obj);
    operation_started(5, cF, ref_obj_from_control(C));
    try
    	cF.M_value_change;
    finally
    	operation_ended(5, cF);
    	cF.M_Any_change;
    end;
    
    //DEBUG
    //if (w <> HackControl(H).Width) then
    //    Writeln('width changed for ' + HackControl(H).Caption
    //    + ' from ' + IntToStr(w) + ' to ' 
    //    + IntToStr(HackControl(H).Width) + #13#10 +
    //    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' + #13#10);
//.

end;

(*
/*
// Return control text
//---------------------

FUN Get_control_caption(
{Control} C|ontrol_object) ==> STR, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "     RESULT := Do_Get_control_caption(X_h);" .
*/
*)
function Do_Get_control_caption(H: Integer): String;

begin
	
    	Result := HackControl(H).Caption;
	
end;

(*
/*

FUN Set_control_align(
{Control} C|ontrol_object, {Control}.{text_align} TA|lignment), NATIVE 
	:
	INT h|andle_control = C.Handle
	CASE h==0 ? ==> ;
	NATIVE @     
    "var C: TControl; A: TAlignment;"
    "C := TControl(HackControl(X_h));"     
    "case X_TA of"
    "0: A := taLeftJustify;"
    "1: A := taCenter;"
    "2: A := taRightJustify;"
    "end;"     
    "if (C is TLabel) then TLabel(C).Alignment := A"
    "else if (C is TMemo) then TMemo(C).Alignment := A;"     
    .

// Return TRUE if control is DISABLED (!)
//---------------------------------------

FUN Get_control_disabled(
{Control} C|ontrol_object) ==> BOOL, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "     Result := Do_Get_disabled(X_h);" .
*/
*)
function Do_Get_disabled(H: Integer): Boolean;
var C: THackControl;
begin
    C := HackControl(H);
    Result := not C.Enabled;
end;

(*
/*
// Set control disabled (TRUE - disabled, FALSE - enabled)
//--------------------------------------------------------

FUN Set_control_disabled(
{Control} C|ontrol_object, BOOL Disable|_control), NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "     Do_Set_disabled(X_h, X_Disable);" .
*/
*)
procedure Do_Set_disabled(H: Integer; B: Boolean);
var C: THackControl;
begin
    C := HackControl(H);
    C.Enabled := not B;
    //C.Invalidate();
    
    if TControl(C) is TListBox then
        if B then C.Color := clBtnFace
        else C.Color := clWindow;
    
end;

(*
/*
// Get TRUE when control is hidden (FALSE if visible)
//---------------------------------------------------

FUN Get_control_hidden(
{Control} C|ontrol_object) ==> BOOL, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "     Result := Do_Get_hidden(X_h);" .
*/
*)
function Do_Get_hidden(H: Integer): Boolean;
begin
    Result := not HackControl(H).Visible;
end;

(*
/*
// Set control hidden state (TRUE - hidden, FALSE - Visible)
//----------------------------------------------------------

FUN Set_control_hidden(
{Control} C|ontrol_object, BOOL M|ake_hidden), NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "     Do_Set_hidden(X_h, X_M);" .
*/
*)
procedure Do_Set_hidden(H: Integer; B: Boolean);
var col: TAL4Column;
	ctrl: THackControl;
begin
	if HackControl(H).Visible = not B then Exit;
    HackControl(H).Visible := not B;
    ctrl := HackControl(H); 
    col := ParentColumn(ctrl);
    if col <> nil then Adjust_control_location(col, nil);
end;

(*
/*

FUN Get_control_foreground(
{Control} C|ontrol_object) ==> INT, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @   
	"var C: THackControl;"
	"	"
    "   C := HackControl(X_H);"
    "	"
    "   	RESULT := Integer( DWORD(C.Font.Color) or $FF000000 );"
    "	" .

FUN Set_control_foreground|_font_color(
{Control} C|ontrol_object, INT Color|_set), NATIVE :
	INT h|andle_control = C.Handle
	INT fh|andle_of_form = C.Form_.Handle
	NATIVE @
	"var C: THackControl;"
	"var F: TAL4Form;"     
	"var hide: Boolean;"     
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    F := TAL4Form(All_forms[X_fh]);"
    "{$ELSE}"
    "    F := TAL4Form(X_fh);"
    "{$ENDIF}"
    "   if F = nil then Exit;"     
    "   C := HackControl(X_H);"
    " 	C.Font.Color := X_Color and $00FFFFFF;"
    "  	if not F.Visible then"
    "  	begin"
    "  		if F.Controls_to_set_foreground_on_show = nil then"
    "  		begin"     
    "  		   F.Controls_to_set_foreground_on_show := TList.Create;"
    "  		   F.Controls_foreground_on_show := TList.Create;"
    "  		end;"     
    "   	F.Controls_to_set_foreground_on_show.Add(C);"     
    "   	F.Controls_foreground_on_show.Add(Pointer(X_Color and $00FFFFFF));"     
    "  	end;"     
    "	".

FUN Get_control_background(
{Control} C|ontrol_object) ==> INT, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @
	"var C: THackControl;"
    "   C := HackControl(X_H);"
    "   RESULT :=  C.Color or Integer( $FF000000 )  ;" .

FUN Set_control_background(
{Control} C|ontrol_object, INT Color|_set), NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @   
	"var C: THackControl;"
    "   C := HackControl(X_H);"
    "    C.Color := X_Color and $00FFFFFF; " .

FUN Get_control_font_face(
{Control} C|ontrol_object) ==> STR, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @   
	"var C: THackControl;"
    "   C := HackControl(X_H);"
    "	"
    "   	RESULT := C.Font.Name;" 
    "	".

FUN Set_control_font_face(
{Control} C|ontrol_object, STR Face|_set), NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @   
	"var C: THackControl;"
    "   C := HackControl(X_H);"
    "	"
    "   	C.Font.Name := X_Face;" 
    "	" .
    
FUN Get_control_font_size(
{Control} C|ontrol_object) ==> REAL, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @
    "var C: THackControl;"
    "   C := HackControl(X_H);"
    "	"
    "   	RESULT := C.Font.Size;" 
    "	" .

FUN Set_control_font_size(
{Control} C|ontrol_object, REAL Size|_set), NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @   
	"var C: THackControl; "
    "   C := HackControl(X_H);"
	"	"
    "   	C.Font.Size := Round(X_Size);"
    "	" 
    .
    
FUN Get_control_font_styles(
{Control} C|ontrol_object) ==> STR, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @   
	"var C: THackControl;"
	"var Font: TFont;"
    "   C := HackControl(X_H);"
    "	"
    "		Font := C.Font;"
    "	"
    "   if (fsBold in Font.Style) then "
    "		RESULT := RESULT + 'B';"
    "   if (fsItalic in Font.Style) then "
    "		RESULT := RESULT + 'I';"
    "   if (fsUnderline in Font.Style) then "
    "		RESULT := RESULT + 'U';"
    "   if (fsStrikeout in Font.Style) then "
    "		RESULT := RESULT + 'S';" .

FUN Set_control_font_styles(
{Control} C|ontrol_object, STR St|yles_string_B_U_I_S), NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @   
	"var C: THackControl;"
	"var Font: TFont;"
    "var fs: TFontStyles;"
    "var i: Integer;"
    "   C := HackControl(X_H);"
    "   fs := [];"
    "	for i := 1 to Length({$IFDEF FPC} Str_X_St {$ELSE} X_St {$ENDIF}) do"
    "   begin"
    "       case {$IFDEF FPC} Str_X_St[i] {$ELSE} X_St[i] {$ENDIF} of"
    "       'B': include(fs,  fsBold);"
    "       'I': include(fs,  fsItalic);"
    "       'U': include(fs,  fsUnderline);"
    "       'S': include(fs,  fsStrikeout);"
    "       end;"
    "   end;"
    "	"
    "		C.Font.Style := fs;"
    "	" .

FUNCTION List_fonts_installed(
INT Op|tions_1Mono_2True, STR Names|_of_fonts[]), NATIVE:
	Names[].Clear
	NATIVE @
    "    Do_list_fonts(X_Op, X_Names); " .
*/
*)



{$IFDEF LINUX}
{$ELSE}
	{$IFDEF CPU64}
	function EnumFontsProc(xLogFont: LPLogFont; TextMetric: LPTextMetric;
	  FontType: LongWord; Data: Int64): LongInt; stdcall;
	{$ELSE}
		{$IFDEF FPC}
		function EnumFontsProc(xLogFont: LPLogFont; TextMetric: LPTextMetric;
		  FontType: LongWord; Data: LongInt): LongInt; stdcall;
		{$ELSE}
		function EnumFontsProc(var xLogFont: TLogFont; var TextMetric: TTextMetric;
		  FontType: Integer; Data: Pointer): Integer; stdcall;
		{$ENDIF}
	{$ENDIF}
	var face_name: String;
	begin
	  face_name := xLogFont{$IFDEF FPC}^{$ENDIF}.lfFaceName;
	  {$IFDEF FPC}
	  	DynAStr(PtrUint(Data)).Add(MAXINT, face_name);
	  {$ELSE}
	  	DynAStr(Data).Add(MAXINT, face_name);
	  {$ENDIF}
	  Result := 1;
	end;
	
	var DC_fonts: HDC;
	
	{$IFDEF CPU64}
	function EnumFixedFontsProc(xLogFont: LPLogFont; TextMetric: LPTextMetric;
	  FontType: LongWord; Data: Int64): LongInt; stdcall;
	{$ELSE}
		{$IFDEF FPC}
		function EnumFixedFontsProc(xLogFont: LPLogFont; TextMetric: LPTextMetric;
		  FontType: LongWord; Data: LongInt): LongInt; stdcall;
		{$ELSE}
		function EnumFixedFontsProc(var xLogFont: TLogFont; var TextMetric: TTextMetric;
		  FontType: Integer; Data: Pointer): Integer; stdcall;
		{$ENDIF}
	{$ENDIF}
	var f, old: HFont;
	    sz1, sz2: TSize;
	begin
	  if xLogFont{$IFDEF FPC}^{$ENDIF}.lfPitchAndFamily and 3 = 1 then
	  begin
	     f := CreateFontIndirect(xLogFont);
	     try
	        old := SelectObject(DC_fonts, f);
	        GetTextExtentPoint32(DC_fonts, 'WWW', 3, sz1);
	        GetTextExtentPoint32(DC_fonts, 'iii', 3, sz2);
	        SelectObject(DC_fonts, old);
	        if sz1.cx = sz2.cx then
	        {$IFDEF FPC}
	            DynAStr(PtrUint(Data)).Add(MAXINT, xLogFont{$IFDEF FPC}^{$ENDIF}.lfFaceName);
	        {$ELSE}
	            DynAStr(Data).Add(MAXINT, xLogFont{$IFDEF FPC}^{$ENDIF}.lfFaceName);
	        {$ENDIF}
	     finally
	        DeleteObject(f);
	     end;
	  end;
	  Result := 1;
	end;
{$ENDIF}
	
	procedure Do_list_fonts(Op: Integer; X_Names: DynAStr);
	    {$IFDEF LINUX}
	var fc_s: String;
		fc_list: DynAStr;
		i: Integer;
		fname: String;
	    {$ELSE}
		{$ENDIF}
	begin
		{$IFDEF LINUX}
		fc_s := Do_execute_program('/bin/bash', 'fc-list', 2);
		if Length(fc_s) <= 0 then Exit;
		fc_list := DynAStr.Create();
		try
			Do_split_string(fc_list, fc_s, #10);
		finally
			for i := 0 to fc_list.Count()-1 do
			begin
				fname := Trim(ExtractWord(2, fc_list.GetStrings(i), [';']));
				X_Names.Add(MAXINT, fname);
			end;
			fc_list.Free;
		end;
		{$ELSE}
	    DC_fonts := GetDC(0);
	    try
	        if Op and 1 = 0 then
	            EnumFonts(DC_fonts, nil, @EnumFontsProc, Pointer(X_Names))
	        else EnumFonts(DC_fonts, nil, @EnumFixedFontsProc, Pointer(X_Names));
	    finally
	        ReleaseDC(0, DC_fonts);
	    end;
	    {$ENDIF}
	end;



(*
/*
// Show message modal (until user press OK)
//-----------------------------------------

FUN Show_message(
	INT H|andle_form_dummy, STR Text|_show), NATIVE :
    "     Do_show_message(X_H, X_Text);" .
*/
*)

function form_from_handle(H: Integer): TAL4Form;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 Result := TAL4Form(All_forms[H]);
 	{$ELSE}
     Result := TAL4Form(H);
 	{$ENDIF}
end;
	
procedure Do_show_message(
	H: Integer; const s: String);
var dlg: TForm;
	F: TAL4Form;
begin
    //ShowMessage(s);
    F := form_from_handle(H);
    {$IFDEF FPC}
    	unitC_Form.M_do_ask(F.AL4Object, s, FALSE);
    {$ELSE}
	    dlg := CreateMessageDialog(s, mtCustom, [mbOK]);
	    dlg.Position := poDesigned;
	    dlg.Left := F.Left + (F.Width - dlg.Width) div 2;
	    dlg.Top := F.Top + (F.Height - dlg.Height) div 2;
	    if dlg.Left < F.Left then dlg.Left := F.Left;
	    if dlg.Top < F.Top then dlg.Top := F.Top;
	    dlg.ShowModal;
    {$ENDIF}
end;

(*
/*
// Ask a question which requires an answer Yes or No
//-------------------------------------------------

FUN Message_box_yes_no(
	INT H|andle_form_dummy, STR Text|_show) ==> BOOL, NATIVE :
    "    RESULT := Do_ask_yes_no(X_H, X_Text);" .
    
*/
*)

function Do_ask_yes_no(
	H: Integer; const s: String): Boolean;
{$IFDef FPC}
var F: TAL4Form;
{$ENDIF}
begin
    {$IFDEF FPC}
        //Result := MessageDlg(
        //    s, TMsgDlgType.mtConfirmation,
        //    [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], 0) = mrYes;
        F := TAL4Form(All_forms[H]);
        Result := unitC_Form.M_do_ask(F.AL4Object, s, TRUE);
    {$ELSE}
    Result := MessageBox(
    	0, PChar(s), PChar(Application.Title), MB_YESNO) = IDYES;
    {$ENDIF}
end;

function Parent_form(Parent: TWinControl): TAL4Form;
begin
	while Parent <> nil do
	begin
		if Parent.Parent is TAL4Form then
		begin
			Result := TAL4Form(Parent.Parent);
			Exit;
		end;
		Parent := Parent.Parent;
	end;
	Result := nil;
end;

(*
/*

FUN Column_children_count(INT C|olumn_handle) ==> INT, NATIVE : @
   "var LastCol: TAL4Column;"
   "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
   "    LastCol := TAL4Column(Column_descr[X_C]);"
   "{$ELSE}"
   "    LastCol := TAL4Column(X_C);"
   "{$ENDIF}"
   "RESULT := LastCol.ListControls.Count;" .

FUN Column_child(
INT C|olumn_handle, INT Index|_of_child) ==> {Control},NATIVE : @
   "var LastCol: TAL4Column;"
   "var	c: TControl;"     
   "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
   "    LastCol := TAL4Column(Column_descr[X_C]);"
   "{$ELSE}"
   "    LastCol := TAL4Column(X_C);"
   "{$ENDIF}"
   "if (X_Index < 0) or (X_Index >= LastCol.ControlCount) then"
   "	c := nil"
   "else c := TControl(LastCol.ListControls[X_Index]);"
   "if (c = nil) or (c.Tag = 0) then"
   "  	 RESULT := NoneObj_C_Control.hard_link"
   "else "
   "begin"
   "	 RESULT := Ref_obj(c.Tag);"
   "	 inc(RESULT.Count, 2);"
   "end;" 
   .

FUN Adjust_control_location(INT C|olumn_handle), NATIVE : @
    "var Col: TAL4Column;"
	"	 if X_C = 0 then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    Col := TAL4Column(Column_descr[X_C]);"
    "{$ELSE}"
    "    Col := TAL4Column(X_C);"
    "{$ENDIF}"
 	"	 Adjust_control_location(Col, nil);" .

*/
*)


procedure Adjust_control_location(
	Column: TAL4Column; C_new: TControl);
begin
    if Column = nil then Exit;
    //if not Column.Visible then Exit;
	if Column.suspend_count > 0 then Exit;
    if not Column.auto_arrange then Exit;
    if Column.adjusting_controls then Exit;
	
	if (C_new <> nil) and (Column.ListControls.IndexOf(C_new) < 0) then
		Column.ListControls.Add(C_new);
    
    Column.adjusting_controls := true;
    try
    	unitC_Form.M_Do_adjust_controls(Column.AL4Form.AL4Object,
    		Column.Tag);
    finally
    	Column.adjusting_controls := false;
    end;
    
end;

procedure Set_control_events(
	Parent: TAL4Column; C: TControl);
var F: TAL4Form;
	HC: THackControl;
begin
    F := Parent_form(Parent);
    HC := THackControl(C);
    if (F <> nil) and (HC <> nil) then
    begin
        HC.OnClick := {$IFDEF OBJFPC}@{$ENDIF} F.Control_clicked;
        HC.OnResize := {$IFDEF OBJFPC}@{$ENDIF} F.Control_resized;
        HC.OnMouseMove := {$IFDEF OBJFPC}@{$ENDIF} F.Control_mouse_move;
        HC.OnMouseDown := {$IFDEF OBJFPC}@{$ENDIF} F.Control_mouse_down;
        HC.OnMouseUp := {$IFDEF OBJFPC}@{$ENDIF} F.Control_mouse_up;
        //------------ не отключать: превращает 2-клик на {Paint_turtle} в клик!
        THackControl(C).OnDblClick := {$IFDEF OBJFPC}@{$ENDIF}
        	F.Control_mouse_double_click;
    end;
end;

procedure Set_Win_control_events(
	Parent: TAL4Column; C: TControl);
var F: TAL4Form;
begin
    F := Parent_form(Parent);
    if (F <> nil) and (C is TWinControl) then
    begin
        THackWinControl(C).OnKeyDown
                        := {$IFDEF OBJFPC}@{$ENDIF} F.Control_key_down;
        THackWinControl(C).OnKeyUp
                        := {$IFDEF OBJFPC}@{$ENDIF} F.Control_key_up;
        {$IFDEF FPC}
            THackWinControl(C).OnUTF8KeyPress
                        := {$IFDEF OBJFPC}@{$ENDIF}F.Control_key_press;
        {$ELSE}
            THackWinControl(C).OnKeyPress
                        := {$IFDEF OBJFPC}@{$ENDIF}F.Control_key_press;
        {$ENDIF}
        
        THackWinControl(C).OnEnter := {$IFDEF OBJFPC}@{$ENDIF} F.Control_enter;
        THackWinControl(C).OnExit := {$IFDEF OBJFPC}@{$ENDIF} F.Control_leave;
    end;
end;

(*
/*
FUNCTION Begin_animation(
    INT H|andle_control, INT Count|_ticks, INT Interval|_ms ), NATIVE
    : @
    "do_begin_animation(X_H, X_Count, X_Interval);" .
*/
*)

(*
/*
FUNCTION Capture_mouse( INT H|andle_control ), NATIVE :
	"	Do_set_capture(X_H);" .
	
*/
*)
var Control_where_mouse_is_down: TControl;

procedure Do_set_capture(X_H: Integer);
var C:  TWinControl ;
begin

 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
     	C := TWinControl(All_controls[X_H]);
 	{$ELSE}
		C :=  TWinControl  (X_H);
 	{$ENDIF}

	if (Control_where_mouse_is_down <> C) then
	begin
		if Control_where_mouse_is_down.Parent = C then
			C :=  TWinControl  
				 (Control_where_mouse_is_down)
		else Exit;
	end;
	{$IFnDEF LINUX}
	
		SetCapture(C.Handle);
	
	{$ENDIF}
end;

	
(*
/*
    
FUNCTION Release_mouse( INT H|andle_control ), NATIVE :
@   "    {$IFDEF LINUX}"
	"	 {$ELSE}"
	"	  	ReleaseCapture;  "
	"	 {$ENDIF}" .

FUN Set_control_anchor_bottom(
{Control} C|ontrol_changed, BOOL A|nchor_bottom), NATIVE : @ 
	"//do not remove this function, it is necessary for interpreting" .
	
FUNCTION Invalidate_control(INT C|ontrol_handle), NATIVE :
@   "var C: THackControl;"
	"	C := HackControl(X_C);"
	"	C.Invalidate();" .
	
FUN Invalidate_form(INT H|andle_form_DUMMY): .	
	
*/
*)



//------------------------------------------------------- L A B E L

(*
/*
// Create label control, return integer descriptor to it
//-----------------------------------------------------
FUN Create_label({Control} L|abel_control) ==> INT, NATIVE :
    INT h|andle_form = L.Form_.Handle
    NATIVE "     Result := Do_Create_label(X_h, X_L);" .
*/
*)
{$IFDEF USE_LISTS_OF_DESCRIPTORS}
procedure release_control(C: TControl);
var i: Integer;
begin
    i := All_controls.IndexOf(C);
    if i >= 0 then All_controls[i] := nil;
end;

function allocate_control(C: TControl): Integer;
var i: Integer;
begin
	Result := -1;
	for i := All_controls.Count-1 downto 1 do
		if All_controls[i] = nil then
		begin
			Result := i;
			break;
		end;
	if Result < 0 then
	begin
		Result := All_controls.Count;
		All_controls.Add(nil);
	end;  
	All_controls[Result] := C;
end;
{$ENDIF}


type
	TAL4Label = class(TLabel)
	public destructor Destroy; override;
	end;
	
destructor TAL4Label.Destroy;
//?{Label}
var X_L: Ref_obj;
//.
begin
//?{Label}
	X_L := ref_obj_from_control(Self);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		if X_L.Obj = nil then Exit;
	{$ENDIF} 
	{$IFDEF FPC}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	C_Label(X_L.Obj).F_Handle := 0;
//.
	inherited;
end;
	
function Do_Create_label(P: Integer; X_L: Pointer): Integer;
var Parent: TAL4Column;
    L: TLabel;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    L := TAL4Label.Create(Parent);
    
    {$IFDEF CPU64}
    	L.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_L);
    {$ELSE}
    	L.Tag := Integer(X_L);
    {$ENDIF}
    
    L.Parent := Parent;
    L.AutoSize := TRUE;
    
    
    Adjust_control_location(Parent, L);
    Set_control_events(Parent, L);
    
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(L);
    {$ELSE}
    	Result := Integer(L);
    {$ENDIF}
end;


//---------------------------------------------------- B U T T O N

(*
/*
// Create button control, return descriptor
//-----------------------------------------
FUN Create_button({Control} B|utton_control) ==> INT :
    RESULT = do_create_button(B.Form_.Handle, B) 
    //B.Set_size(B.Get_text.Len * 6, B.Height)
    .

FUN do_create_button(INT F|orm_handle,
    {Control} B|utton_create) ==> INT, NATIVE :
    "     Result := do_create_button(X_F, X_B);" .
*/
*)
type
	TAL4Button = class(TButton)
	public destructor Destroy; override;
	end;
	
function ref_obj_from_control(C: TControl): Ref_obj;
begin
	Result := nil;
    if C is TAL4Column then Exit;
    Result := Ref_obj(C.Tag);
end;
	
destructor TAL4Button.Destroy;
//?{Button}
var X_L: Ref_obj;
//.
begin
//?{Button}
	X_L := ref_obj_from_control(Self);
	if X_L = nil then Exit;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	if X_L.Obj = nil then Exit;
	C_Button(X_L.Obj).F_Handle := 0;
//.
	inherited;
end;

function Do_Create_button(P: Integer; X_B: Pointer): Integer;
var Parent: TAL4Column;
    B: TAL4Button;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    B := TAL4Button.Create(Parent);
    
	{$IFDEF CPU64}
    	B.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_B);
    {$ELSE}
    	B.Tag := Integer(X_B);
    {$ENDIF}    	
    
    B.Parent := Parent;
    {$IFDEF FPC}
    	if Parent.Layout >= 3 then
    		B.AutoSize := true;
    {$ENDIF}
    Adjust_control_location(Parent, B);
    Set_control_events(Parent, B);
    Set_Win_control_events(Parent, B);
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(B);
    {$ELSE}
    	Result := Integer(B);
    {$ENDIF}
end;

(*
/*
FUN Set_form_default_button(INT H|andle_form, INT B|utton_handle),
    NATIVE :
@   "var F: TAL4Form;"
    "var B: TButton;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_H]);"
    "    B := TButton(All_controls[X_B]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_H);"
    "    B := TButton(X_B);"
    "	{$ENDIF}"
    "   if F.Default_button <> nil then"
    "      F.Default_button.Default := FALSE;"
    "   F.Default_button := B;"
    "   if B <> nil then B.Default := TRUE;"
    .
    
FUN Set_form_cancel_button(INT H|andle_form, INT B|utton_handle),
    NATIVE :
@   "var F: TAL4Form;"
    "var B: TButton;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_H]);"
    "    B := TButton(All_controls[X_B]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_H);"
    "    B := TButton(X_B);"
    "	{$ENDIF}"
    "   if F.Cancel_button <> nil then"
    "      F.Cancel_button.Cancel := FALSE;"
    "   F.Cancel_button := B;"
    "   if B <> nil then B.Cancel := TRUE;"
    .
*/
*)


//------------------------------------------------- C H E C K B O X

(*
/*
// Create checkbox, return descriptor
//-----------------------------------
FUN Create_checkbox({Control} C|heckbox_control) ==> INT :
    RESULT = do_create_checkbox(C.Form_.Handle, C) .

FUN do_create_checkbox(INT F|orm_handle,
    {Control} C|heckbox_create) ==> INT, NATIVE :
    "   Result := do_create_checkbox(X_F, X_C);" .
*/
*)
type
	TAL4Checkbox = class(TCheckbox)
	public destructor Destroy; override;
	end;
	
destructor TAL4Checkbox.Destroy;
//?{Checkbox}
var X_L: Ref_obj;
//.
begin
//?{Checkbox}
	X_L := ref_obj_from_control(Self);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		if X_L.Obj = nil then Exit;
	{$ENDIF} 
	{$IFDEF FPC}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	C_Checkbox(X_L.Obj).F_Handle := 0;
//.
	inherited;
end;
	
function Do_Create_checkbox(P: Integer; X_C: Pointer): Integer;
var Parent: TAL4Column;
    C: TAL4CheckBox;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    C := TAL4CheckBox.Create(Parent);
    {$IFDEF FPC}
    C.AutoSize := FALSE;
    {$ENDIF}
    
    {$IFDEF CPU64}
    	C.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_C);
    {$ELSE}
    	C.Tag := Integer(X_C);
    {$ENDIF}
    
    C.Parent := Parent;
	{$IFDEF FPC}
    if Parent.Layout >= 3 then
		C.AutoSize := true
    ;
	{$ELSE}
    {$ENDIF}
        
    Adjust_control_location(Parent, C);
    Set_control_events(Parent, C);
    Set_Win_control_events(Parent, C);
    
    	C.OnClick
     
    	:= {$IFDEF OBJFPC}@{$ENDIF} F.Control_changed;
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(C);
    {$ELSE}
    	Result := Integer(C);
    {$ENDIF}
end;

(*
/*
// Return TRUE if checkbox is checked
//-----------------------------------

FUN Get_checkbox_checked(
{Control} C|ontrol_object) ==> BOOL, NATIVE :
	INT h|andle_control = C.Handle
	CASE h == 0 ? ==> ;
	NATIVE
@	"var C: TCheckbox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"		C := TCheckbox(All_controls[X_h]);"
	"	{$ELSE}"
	"		C := TCheckbox(X_h);"
	"	{$ENDIF}"	
	"    RESULT := C. Checked ;" .
    
// Set checkbox state (TRUE - checked, FALSE - unchecked)
//-------------------------------------------------------

FUN Set_checkbox_checked(
{Control} C|ontrol_object, BOOL V|alue_checked), NATIVE :
	INT h|andle_control = C.Handle
	CASE h == 0 ? ==> ;
	NATIVE
@	"var C: TCheckbox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"		C := TCheckbox(All_controls[X_h]);"
	"	{$ELSE}"
	"		C := TCheckbox(X_h);"
	"	{$ENDIF}"	
	"    C. Checked  := X_V;" .
    
// Get checkbox text
//-------------------------------------------------------

//FUN Get_checkbox_text(INT C|heckbox_handle) ==> STR, NATIVE :
//@   "var C: TCheckbox;"
//    "	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
//    "		C := TCheckbox(All_controls[X_C]);"
//    "	{$ELSE}"
//    "		C := TCheckbox(X_C);"
//    "	{$ENDIF}"
//    "    RESULT := C.  Caption ;"
//    .
    
// Set checkbox text
//-------------------------------------------------------

//FUN Set_checkbox_text(INT C|heckbox_handle, STR T|ext_set), NATIVE :
//@	"var C: TCheckbox;"
//    "	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
//    "		C := TCheckbox(All_controls[X_C]);"
//    "	{$ELSE}"
//    "		C := TCheckbox(X_C);"
//    "	{$ENDIF}"
//    "    C.  Caption  := X_T;"
//    .
*/
*)

//-------------------------------------------------------------- E D I T

(*
/*
// Create edit control, return descriptor
//----------------------------------------
FUN Create_edit(
    {Control} E|dit_control, 
    STR Password|_char, 
    BOOL Read|only) ==> INT, NATIVE
    :
    INT form|_handle = E.Form_.Handle
    NATIVE @
    "     Result := do_create_edit(X_form, X_E, X_Password, X_Read);" .
*/
*)
type
	TAL4Edit = class(TEdit)
	public destructor Destroy; override;
	end;
	
destructor TAL4Edit.Destroy;
//?{Edit}
var X_L: Ref_obj;
//.
begin
//?{Edit}
	X_L := ref_obj_from_control(Self);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	{$IFDEF FPC}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	C_Edit(X_L.Obj).F_Handle := 0;
//.
	inherited;
end;
	
	
function Do_Create_edit(P: Integer; X_E: Pointer; X_Password: String; 
    X_Readonly: Boolean): Integer;
var Parent: TAL4Column;
    E: TAL4Edit;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    E := TAL4Edit.Create(Parent);
    
	{$IFDEF CPU64}
    	E.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_E);
    {$ELSE}
    	E.Tag := Integer(X_E);
    {$ENDIF}
    
    E.Parent := Parent;
    if (X_Readonly) then
    begin
        E.ReadOnly := TRUE;
         E.Color := clBtnFace; 
    end;
    if X_Password <> '' then
    	 
    		E.PasswordChar := X_Password[1];
    	
    
    Adjust_control_location(Parent, E);
    Set_control_events(Parent, E);
    Set_Win_control_events(Parent, E);
    E.OnChange := {$IFDEF OBJFPC}@{$ENDIF} F.Control_changed;
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(E);
    {$ELSE}
    	Result := Integer(E);
    {$ENDIF}
end;

(*
/*
// Get edit selection text
//------------------------------
FUN Get_edit_selection(INT E|dit_control) ==> STR, NATIVE :
    "    RESULT := Do_Get_edit_selection(X_E);" .
*/
*)
function Do_Get_edit_selection(X_E: Integer): String;
var E: TEdit;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		E := TEdit(All_controls[X_E]);
	{$ELSE}
    	E := TEdit(X_E);
	{$ENDIF}
    Result := E.SelText;
end;

(*
/*
FUN Get_edit_selection_start(INT E|dit_control) ==> INT, NATIVE :
@   "var T: TEdit;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 T := TEdit(All_controls[X_E]);"
	"	{$ELSE}"
    "    T := TEdit(X_E);"
    "	{$ENDIF}"
    "    RESULT := T.SelStart;" .

FUN Get_edit_selection_length(INT E|dit_control) ==> INT, NATIVE :
@   "var T: TEdit;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 T := TEdit(All_controls[X_E]);"
	"	{$ELSE}"
    "    T := TEdit(X_E);"
    "	{$ENDIF}"
    "    RESULT := T.SelLength;" .

FUN Set_edit_selection_range(INT E|dit_control, INT Start|_selection,
    INT Length|_selection), NATIVE :
@   "var T: TEdit;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 T := TEdit(All_controls[X_E]);"
	"	{$ELSE}"
    "    T := TEdit(X_E);"
    "	{$ENDIF}"
    "	 T.AutoSelect := false;"     
    "    T.SelStart := X_Start;"
    "    T.SelLength := X_Length;" .

*/
*)

(*
/*
// Replace edit selection with another text
//-----------------------------------------
FUN Set_edit_selection(INT E|dit_control, STR Text|_replacing_selection),
    NATIVE :
    "    Do_Set_edit_selection(X_E, X_Text);" .
*/
*)
procedure Do_Set_edit_selection(X_E: Integer; const X_Text: String);
var E: TEdit;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 E := TEdit(All_controls[X_E]);
 	{$ELSE}
     E := TEdit(X_E);
 	{$ENDIF}
    {$IFDEF FPC}
    E.SelText := X_Text;
    {$ELSE}
    	
    		E.SetSelTextBuf(PChar(X_Text));
    	
    {$ENDIF}
end;

(*
/*
// Set edit maximal length
//------------------------
FUN Set_edit_max_len(INT E|dit_control, INT V|alue_max_len),
    NATIVE :
    "    Do_Set_edit_max_len(X_E, X_V);" .
*/
*)
procedure Do_Set_edit_max_len(X_E: Integer; X_V: Integer);
var E: TEdit;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 E := TEdit(All_controls[X_E]);
 	{$ELSE}
     E := TEdit(X_E);
 	{$ENDIF}
    E.MaxLength := X_V;
end;

(*
/*
// Set edit password char
//------------------------
FUN Set_edit_password_char(INT E|dit_control, STR V|alue_password_char),
    NATIVE :
    "    Do_Set_edit_password_char(X_E, X_V);" .
*/
*)
procedure Do_Set_edit_password_char(X_E: Integer; const X_V: String);
var E: TEdit;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 E := TEdit(All_controls[X_E]);
 	{$ELSE}
     E := TEdit(X_E);
 	{$ENDIF}
    if  Length(X_V) = 0 then
		
        	E.PasswordChar := #0
		
    else
    	 
    		E.PasswordChar := X_V[1];
    	
end;

//-------------------------------------------------------------- M E M O

(*
/*
// Create memo control, return descriptor
//---------------------------------------

FUN Create_memo(
{Control} M|emo_control,
STR Op|tions_Readonly_Horizontal_Vertical_scrolls_cEnter) ==> INT
            :
    INT form|_handle = M.Form_.Handle
    
    RESULT = do_Create_memo(form, M, "R" IN Op, "H" !IN Op, "V" !IN Op, 
    "E" IN Op)
    .
FUN do_Create_memo(INT Form|_handle, {Control} Memo|_control,
BOOL Read|_only, BOOL No_h|orizontal_scroll, BOOL No_v|ertical_scroll,
BOOL Center|_text) ==> INT,
NATIVE : @
"Result := do_create_memo(X_Form, X_Memo, X_Read, X_No_h, X_No_v, X_Center);" .
*/
*)
type
	TAL4Memo = class(TMemo)
	public destructor Destroy; override;
	end;
	

	
	
destructor TAL4Memo.Destroy;
//?{Memo}
var X_L: Ref_obj;
//.
begin
//?{Memo}
	X_L := ref_obj_from_control(Self);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	{$IFDEF FPC}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	C_Memo(X_L.Obj).F_Handle := 0;
	
//.
	inherited;
end;
	

function Do_Create_memo(P: Integer; X_M: Pointer;
    X_Read, NoH, NoV, Center: Boolean): Integer;
var Parent: TAL4Column;
    M: TAL4Memo;
    F: TAL4Form;
//?{Memo}
    
//.
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    M := TAL4Memo.Create(Parent);
    if X_Read then M.ReadOnly := TRUE;
    if NoH and NoV then
    	
        	M.ScrollBars := ssNone
    	
    else if NoH then
    	
        	M.ScrollBars := ssVertical
        
    
    else if NoV then
        M.ScrollBars := ssHorizontal
    else M.ScrollBars := ssBoth;
    if Center then M.Alignment := taCenter;
    
    {$IFDEF FPC}
    M.WordWrap := NoH;
    {$ENDIF}
    
    {$IFDEF CPU64}
    	M.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_M);
    {$ELSE}
    	M.Tag := Integer(X_M);
    {$ENDIF}
    
    M.Parent := Parent;
    
    Adjust_control_location(Parent, M);
    Set_control_events(Parent, M);
    Set_Win_control_events(Parent, M);
    M.OnChange := {$IFDEF OBJFPC}@{$ENDIF} F.Control_changed;
    
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(M);
    {$ELSE}
    	Result := Integer(M);
    {$ENDIF}
    
    
end;

(*
/*
// Memo is providing lines in API.
//----------------------------------------------
FUN Memo_supports_lines ==> BOOL : RESULT = TRUE .

// Return TRUE indicating that text limit is supported
//---------------------------
FUN Memo_supports_text_limit ==> BOOL : RESULT = TRUE .
*/
*)


(*
/*
// Return memo line by index
//--------------------------
FUN Get_memo_item(INT M|emo_control, INT Row|_index) ==> STR, NATIVE :
    "    RESULT := Do_Get_memo_item(X_M, X_Row);" .
*/
*)
function Do_Get_memo_item(X_M: Integer; Row: Integer): String;
var M: TMemo;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		M := TMemo(All_controls[X_M]);
	{$ELSE}
    	M := TMemo(X_M);
	{$ENDIF}
    Result := '';
    if  (Row >= 0) and (Row < M.Lines.Count) then
        Result := M.Lines[Row];
end;

(*
/*
// Set memo line by index
//-----------------------
FUN Set_memo_item(INT M|emo_control, INT Row|_index, STR V|alue_set),
    NATIVE :
    "    Do_Set_memo_item(X_M, X_Row, X_V);" .
*/
*)
procedure Do_Set_memo_item(X_M: Integer; Row: Integer; const Value: String);
var M: TMemo;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		M := TMemo(All_controls[X_M]);
	{$ELSE}
    	M := TMemo(X_M);
	{$ENDIF}
    if  Row = M.Lines.Count then
        M.Lines.Add(Value)
    else
    if  (Row >= 0) and (Row < M.Lines.Count) then
        M.Lines[Row] := Value;
end;

(*
/*
// Get memo selection text
//------------------------------
FUN Get_memo_selection(INT M|emo_control) ==> STR, NATIVE :
    "    RESULT := Do_Get_memo_selection(X_M);" .
*/
*)
function Do_Get_memo_selection(X_M: Integer): String;
var M: TMemo;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		M := TMemo(All_controls[X_M]);
	{$ELSE}
    	M := TMemo(X_M);
	{$ENDIF}
    Result := M.SelText;
end;

(*
/*
// Replace memo selection with another text
//-----------------------------------------
FUN Set_memo_selection(INT M|emo_control, STR Text|_replacing_selection),
    NATIVE :
    "    Do_Set_memo_selection(X_M, X_Text);" .
*/
*)
procedure Do_Set_memo_selection(X_M: Integer; const X_Text: String);
var M: TMemo;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		M := TMemo(All_controls[X_M]);
	{$ELSE}
    	M := TMemo(X_M);
	{$ENDIF}
    {$IFDEF FPC}
    M.SelText := X_Text;
    {$ELSE}
    	
    		M.SetSelTextBuf(PChar(X_Text));
    	
    {$ENDIF}
end;

(*
/*
// Return count lines in memo
//---------------------------
FUN Get_memo_count_lines(INT M|emo_control) ==> INT, NATIVE :
    "    RESULT := Do_Get_memo_count_lines(X_M);" .
*/
*)
function Do_Get_memo_count_lines(X_M: Integer): Integer;
var M: TMemo;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		M := TMemo(All_controls[X_M]);
	{$ELSE}
    	M := TMemo(X_M);
	{$ENDIF}
    Result := M.Lines.Count;
end;

(*
/*
// Set memo maximal length
//------------------------
FUN Set_memo_max_len(INT M|emo_control, INT V|alue_max_len),
    NATIVE :
    "    Do_Set_memo_max_len(X_M, X_V);" .
*/
*)
procedure Do_Set_memo_max_len(X_M: Integer; X_V: Integer);
var M: TMemo;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		M := TMemo(All_controls[X_M]);
	{$ELSE}
    	M := TMemo(X_M);
	{$ENDIF}
    M.MaxLength := X_V;
end;

(*
/*
// Get memo range selection
//---------------------------

FUN Get_memo_range_sel(
INT M|emo_control) ==> {Control}.{from_to}
	:
	CASE M == 0 ? ==> ;
	INT r|anges_selection[] << 0 << 0 << 0 << 0
	do_Get_memo_range_sel(M, r[])
	RESULT = {from_to}(Line_from = r[0], From = r[1], Line_to = r[2], To = r[3])
	.
FUN do_Get_memo_range_sel(INT M|emo_control, INT R|anges_selection[]), NATIVE :
@	"var M: TMemo;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
        "M := TMemo(All_controls[X_M]);"
    "{$ELSE}"
        "M := TMemo(X_M);"
    "{$ENDIF}"
    "X_R.SetIntegers(1, M.SelStart);"
    "X_R.SetIntegers(3, M.SelLength + X_R.GetIntegers(1));"
    .

// Set memo range selection
//---------------------------

FUN Set_memo_range_sel(
INT M|emo_control, {from_to} R|ange_selection)
	:
	CASE M == 0 ? ==> ;
	do_Set_memo_range_sel(M, R.From, R.To) .
FUN do_Set_memo_range_sel(
INT M|emo_control, INT From|_char, INT To|_character_offset), NATIVE : @
	"var M: TMemo; L: Integer;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
        "M := TMemo(All_controls[X_M]);"
    "{$ELSE}"
        "M := TMemo(X_M);"
    "{$ENDIF}"
    "M.SelStart := X_From;"
    "L := X_To - X_From;"
    "if L < 0 then L := 0;"
    "M.SelLength := L;"
    //"//----------------------------------------------------------------------"
    //"writeln('set_memo_range_sel to ' + IntToStr(X_From) + ' --> SelStart=' +"
    //"		 IntToStr(M.SelStart) + ', SelLength=' + IntToStr(M.SelLength));"
    //"//----------------------------------------------------------------------"
    .
    
FUNCTION Get_memo_entire_text_shown(
{Control} M|emo_control) ==> BOOL, NATIVE:
	CASE M.Handle == 0 ? ==> ;
	INT handle|_of_memo = M.Handle     
	INT line_h|eight_of_memo = (M.Get_font_size * 1.5).Points 
	//DEBUG: "line_h= " line_h #NL ;
	NATIVE@
"var M: TMemo; "
"var LL1C, LLLC: Integer;"
"var xy: DWORD; "
"var e: TPoint;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
        "M := TMemo(All_controls[X_handle]);"
    "{$ELSE}"
        "M := TMemo(X_handle);"
    "{$ENDIF}"
"if (M.Lines.Count=0) "
"	or (M.Lines.Count=1) and (Length(Trim(M.Lines.Strings[0])) = 0) then"
"	begin RESULT := TRUE; Exit; end;"
"{$IFDEF FPC}"
"	 e := M.CaretPos;"   
"	 e.Y := e.Y * X_line_h;"
"	 e.X := Trunc(e.X * X_line_h * 0.7);"     
//"	 writeln('caret pos: ' + IntToStr(e.X) + ',' + IntToStr(e.Y));"     
"{$ELSE}"     
"    LL1C := M.Perform(EM_LINEINDEX, M.Lines.Count-1, 0);"
"    LLLC := LL1C + Length(M.Lines[M.Lines.Count-1])-1;"
"    xy := M.Perform(EM_POSFROMCHAR, LLLC, 0);"
"    e.X := xy and $FFFF;"
"    e.Y := (xy shr 16) and $FFFF;"
"{$ENDIF}"     
"RESULT := (e.X <= M.Width) and (e.Y + X_line_h <= M.Height);" .

    

//--------------------------------------------- L I S T B O X

// Create listbox control, return descriptor.
//-------------------------------------------
FUN Create_listbox({Control} L|istbox_control,
    BOOL Multi|select) ==> INT
    :
    RESULT = do_create_listbox(L.Form_.Handle, L, Multi) .

FUN do_create_listbox(INT F|orm_handle, {Control} L|istbox_create, 
    BOOL Multi|select) ==> INT, NATIVE:
    "     Result := Do_Create_listbox(X_F, X_L, X_Multi);" .
*/
*)
type
	TAL4ListBox = class(TListBox)
	public destructor Destroy; override;
	end;
	
destructor TAL4ListBox.Destroy;
//?{Listbox}
var X_L: Ref_obj;
//.
begin
//?{Listbox}
	X_L := ref_obj_from_control(Self);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	{$IFDEF FPC}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	C_Listbox(X_L.Obj).F_Handle := 0;
//.
	inherited;
end;
	
	
function Do_Create_listbox(P: Integer; X_L: Ref_obj; 
         X_Multiselect: Boolean): Integer;
var Parent: TAL4Column;
    L: TAL4ListBox;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    L := TAL4ListBox.Create(Parent);
    
    {$IFDEF CPU64}
    	L.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_L);
    {$ELSE}
    	L.Tag := Integer(X_L);
    {$ENDIF}
    
    L.Parent := Parent;
    L.Multiselect := X_Multiselect;
    Adjust_control_location(Parent, L);
    Set_control_events(Parent, L);
    Set_Win_control_events(Parent, L);
    
    	L.OnClick 
     
    	:= {$IFDEF OBJFPC}@{$ENDIF} F.Selection_changed;
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(L);
    {$ELSE}
    	Result := Integer(L);
    {$ENDIF}
end;

(*
/*
FUNCTION Listbox_clear(INT H|andle_listbox), NATIVE :
@   "var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_H]);"
	"	{$ELSE}"
    "    L := TListBox(X_H);"
    "	{$ENDIF}"
    "    L.Items.Clear;" .

// Return listbox item string by its index
//----------------------------------------------------------------------
FUN Get_listbox_item(INT L|istbox_control, INT Index|_item) ==> STR,
    NATIVE :
   @"var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_L]);"
	"	{$ELSE}"
    "    L := TListBox(X_L);"
    "	{$ENDIF}"
    "    Result := '';"
    "    if (X_Index < 0) or (X_Index >= L.Items.Count) then Exit;"
    "    Result := L.Items[X_Index];" .


// Set listbox item string by its index
//----------------------------------------------------------------------
FUN Set_listbox_item(INT L|istbox_control, INT Index|_item, 
    STR Value|_set), NATIVE :
   @"var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_L]);"
	"	{$ELSE}"
    "    L := TListBox(X_L);"
    "	{$ENDIF}"
    "    if (X_Index < 0) or (X_Index >= L.Items.Count) then Exit;"
    "    L.Items[X_Index] := X_Value;" .


// Get listbox items count
//----------------------------------------------------------------------
FUN Get_listbox_count|_items(INT L|istbox_control) ==> INT,
    NATIVE :
   @"var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_L]);"
	"	{$ELSE}"
    "    L := TListBox(X_L);"
    "	{$ENDIF}"
    "    Result := L.Items.Count;" .
    
// Add listbox item string 
//----------------------------------------------------------------------
FUN Listbox_add_item(INT L|istbox_control, STR Value|_set) ==> INT,
    NATIVE :
   @"var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_L]);"
	"	{$ELSE}"
    "    L := TListBox(X_L);"
    "	{$ENDIF}"
    "    L.Items.Add(X_Value);"
    "    Result := L.Items.Count-1;".


// Insert item into listbox at given position 
//----------------------------------------------------------------------
FUN Listbox_insert_item(INT L|istbox_control, INT Index|_before,
    STR Value|_set) ==> INT, NATIVE :
   @"var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_L]);"
	"	{$ELSE}"
    "    L := TListBox(X_L);"
    "	{$ENDIF}"
    "    Result := -1;"
    "    if (X_Index < 0) or (X_Index > L.Items.Count) then Exit;"
    "    L.Items.Insert(X_Index, X_Value);"
    "    Result := X_Index;" .


// Delete item in listbox by index
//----------------------------------------------------------------------
FUN Listbox_delete_item(INT L|istbox_control, INT Index|_delete),
    NATIVE :
   @"var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_L]);"
	"	{$ELSE}"
    "    L := TListBox(X_L);"
    "	{$ENDIF}"
    "    if (X_Index < 0) or (X_Index >= L.Items.Count) then Exit;"
    "    L.Items.Delete(X_Index);" .


// Select/deselect item in listbox by index 
//----------------------------------------------------------------------

FUN Listbox_select_item(
{Listbox} L|istbox_control, INT Index|_select,
BOOL Select|_or_deselect), NATIVE :
	INT h|andle_control = L.Handle
 	NATIVE @
   "var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_h]);"
	"	{$ELSE}"
    "    L := TListBox(X_h);"
    "	{$ENDIF}"
    "    if (X_Index < 0) or (X_Index >= L.Items.Count) then Exit;"
    "	 if L.Multiselect then"
    "		"
    "    		L.Selected[X_Index] := X_Select"
    "		" 
    "	 else if X_Select then L.ItemIndex := X_Index" 
    "	 else L.ItemIndex := -1;" .


// Select all items in listbox
//----------------------------------------------------------------------

FUN Listbox_select_all({Listbox} L|istbox_control), NATIVE :
	INT h|andle_control = L.Handle
 	NATIVE @
    "var L: TListBox;"
    "var I: Integer;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_h]);"
	"	{$ELSE}"
    "    L := TListBox(X_h);"
    "	{$ENDIF}"
    "    if (not L.MultiSelect) then Exit;"
    "    //L.SelectAll;" 
    "    for I := 0 to L.Items.Count - 1 do"
    "       L.Selected[I] := True;"  .


// Deselect all items in listbox
//----------------------------------------------------------------------

FUN Listbox_select_none({Listbox} L|istbox_control), NATIVE :
	INT h|andle_control = L.Handle
 	NATIVE @
    "var L: TListBox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_h]);"
	"	{$ELSE}"
    "    L := TListBox(X_h);"
    "	{$ENDIF}"
    "    L.ItemIndex := -1;" .


// Get count of selected items in listbox
//----------------------------------------------------------------------
FUN Listbox_get_sel_count({Listbox} L|istbox_control) ==> INT, NATIVE:
	INT h|andle_control = L.Handle
 	NATIVE @
    "var L: TListBox; "
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_h]);"
	"	{$ELSE}"
    "    L := TListBox(X_h);"
    "	{$ENDIF}"
    "	 "
    "    Result := L.SelCount;" 
    "	 " .


// Delete all selected items in listbox
//----------------------------------------------------------------------
FUN Listbox_delete_selected({Listbox} L|istbox_control), NATIVE :
	INT h|andle_control = L.Handle
 	NATIVE @
    "var L: TListBox;"
    "var i: Integer;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_h]);"
	"	{$ELSE}"
    "    L := TListBox(X_h);"
    "	{$ENDIF}"
    "    for  i := L.Items.Count-1 downto 0 do"
    "    if L.  Selected[i]  then"
    "        L.Items.Delete(i);" .


// Get next selected item in listbox
//----------------------------------------------------------------------
FUN Listbox_get_next_sel({Listbox} L|istbox_control, INT From|_index) ==> INT,
    NATIVE :
	INT h|andle_control = L.Handle
	CASE h == 0 ? RESULT = -1 ==> ;
 	NATIVE @
    "var L: TListBox;"
    "var i: Integer;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 L := TListBox(All_controls[X_h]);"
	"	{$ELSE}"
    "    L := TListBox(X_h);"
    "	{$ENDIF}"
    "    Result := -1;"
    "    if (not L.MultiSelect) then"
    "    begin"
    "       Result := L.ItemIndex;"
    "       Exit;"
    "    end;"
    "     if (L.SelCount = 0) then Exit; "
    "    if (X_From < -1) then X_From := -1;"
    "    for i := X_From+1 to L.Items.Count-1 do"
    "    if (i > X_From) and "
    "		 L.Selected[i]  then"
    "    begin"
    "       Result := i;"
    "       Exit;"
    "    end;" .
    
*/
*)


//------------------------------------------------------ C O M B O B O X

(*
/*
// Create combobox control, return descriptor
//-------------------------------------------
FUN Create_combo({Control} C|ombo_control) ==> INT :
    RESULT = do_create_combo(C.Form_.Handle, C) .

FUN do_create_combo(INT F|orm_handle,
    {Control} C|ombo_create) ==> INT, NATIVE :
    "     Result := do_create_combo(X_F, X_C);" .
*/
*)
type
	TAL4ComboBox = class(TComboBox)
	public destructor Destroy; override;
	end;
	
destructor TAL4ComboBox.Destroy;
//?{Combo}
var X_L: Ref_obj;
//.
begin
//?{Combo}
	X_L := ref_obj_from_control(Self);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	{$IFDEF FPC}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	C_Combo(X_L.Obj).F_Handle := 0;
//.
	inherited;
end;
	
	
function Do_Create_combo(P: Integer; X_C: Pointer): Integer;
var Parent: TAL4Column;
    C: TAL4ComboBox;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    C := TAL4ComboBox.Create(Parent);
    
	{$IFDEF CPU64}
    	C.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_C);
    {$ELSE}
    	C.Tag := Integer(X_C);
    {$ENDIF}
    
    C.Parent := Parent;
     C.Style := csDropDownList; 
    {$IFDEF LINUX}
        C.Height := C.Height + 4;
    {$ENDIF}
    Adjust_control_location(Parent, C);
    Set_control_events(Parent, C);
    Set_Win_control_events(Parent, C);
    C.OnChange := {$IFDEF OBJFPC}@{$ENDIF} F.Control_changed;
    
    	//C.OnSelect := {$IFDEF OBJFPC}@{$ENDIF} F.Selection_changed;
    	C.OnChange := {$IFDEF OBJFPC}@{$ENDIF} F.Selection_changed;
    
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(C);
    {$ELSE}
    	Result := Integer(C);
    {$ENDIF}
end;

(*
/*
// Return TRUE if combo can be edited (otherwise it can only be used to select
// items) --------------------------------------------------------------------
    FUN Get_combo_can_edit(INT C|ombo_control_dummy) ==> BOOL, 
        DEPRECATED('Combo can not be edit!')
        :
---- 'Use either special item ...more... or separate button or context menu etc'
RESULT = FALSE .
*/
*)

(*
/*
// Set combo style (TRUE - can be edited, FALSE - only select items)
//------------------------------------------------------------------
FUN Set_combo_can_edit(INT C|ombo_control, BOOL E|nable_edit),
ABANDONED('add special item ...enter other') : .
*/
*)

(*
/*
// Fill combo items list with strings (separated by #CR or #NL)
//-------------------------------------------------------------
FUN Set_combo_items(INT C|ombo_control, STR V|alue_items), NATIVE :
    "    Do_Set_combo_items(X_C, X_V);" .
*/
*)
procedure Do_Set_combo_items(X_C: Integer; const X_V: String);
var C: TComboBox;
    L: TStringList;
    i: Integer;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
	if C = nil then Exit;
    C.Items.BeginUpdate;
    L := TStringList.Create;
    TRY
        C.Items.Clear;
        L.Text := X_V;
        for i := 0 to L.Count-1 do
            C.Items.Add(L[i]);
    FINALLY
        C.Items.EndUpdate;
        L.Free;
    END;
end;

(*
/*
// Get count items in cobobox
//---------------------------
FUN Get_combo_count_items(INT C|ombo_control) ==> INT, NATIVE :
    "    RESULT := Do_Get_combo_count_items(X_C);" .
*/
*)
function Do_Get_combo_count_items(X_C: Integer): Integer;
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    Result := C.Items.Count;
end;

(*
/*
// Get combobox item by index
//---------------------------
FUN Combo_get_item(INT C|ombo_control, INT Row|_combo) ==> STR, 
    NATIVE :
    "    RESULT := Do_Get_combo_item(X_C, X_Row);" .
*/
*)
function Do_Get_combo_item(X_C: Integer; X_Row: Integer): String;
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    Result := C.Items[X_Row];
end;

(*
/*
// Set combobox item by index
//---------------------------
FUN Combo_set_item(INT C|ombo_control, INT Row|_combo, STR V|alue_set), 
    NATIVE :
    "    Do_Set_combo_item(X_C, X_Row, X_V);" .
*/
*)
procedure Do_Set_combo_item(X_C: Integer; X_Row: Integer; const X_V: String);
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    C.Items[X_Row] := X_V;
end;

(*
/*
// Search combobox item by string pattern
//--------------------------------------
FUN Find_combo_item(INT C|ombo_control, STR F|inding_str) ==> INT,
    NATIVE :
    "    RESULT := Do_Find_combo_item(X_C, X_F);" .
*/
*)
function Do_Find_combo_item(X_C: Integer; const X_F: String): Integer;
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    Result := C.Items.IndexOf(X_F);
end;

(*
/*
// Add an item into the end of combobox
//-------------------------------------
FUN Add_combo_item(INT C|ombo_control, STR A|dding_str) ==> INT,
    NATIVE :
    "    RESULT := Do_Add_combo_item(X_C, X_A);" .
*/
*)
function Do_Add_combo_item(X_C: Integer; const X_A: String): Integer;
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    Result := C.Items.Add(X_A);
end;

(*
/*
// Insert an item into combobox at a position
//-------------------------------------
FUN Insert_combo_item(INT C|ombo_control,
    INT I|ndex_where_insert, STR A|dding_str), NATIVE :
    "    Do_Insert_combo_item(X_C, X_I, X_A);" .
*/
*)
procedure Do_Insert_combo_item(X_C: Integer; X_I: Integer; const X_A: String);
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    C.Items.Insert(X_I, X_A);
end;

(*
/*
// Get current index selected in combobox (-1 if nothing is selected)
//-------------------------------------------------------------------
FUN Get_combo_current_index(INT C|ombo_control) ==> INT, NATIVE :
    "    RESULT := Do_Get_combo_current_index(X_C);" .
*/
*)
function Do_Get_combo_current_index(X_C: Integer): Integer;
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    if C <> nil then
    	Result := C.ItemIndex
    else Result := -1;
end;

(*
/*
// Set new current index (-1 is allowed to unselect all)
//------------------------------------------------------
FUN Set_combo_current_index(INT C|ombo_control, INT Index|_set),
    NATIVE :
    "    Do_Set_combo_current_index(X_C, X_Index);" .
*/
*)
procedure Do_Set_combo_current_index(X_C: Integer; X_Index: Integer);
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    if  (X_Index >= -1) and (X_Index < C.Items.Count) then
    begin
        C.ItemIndex := X_Index;
        C.OnChange(C);
    end;
end;

(*
/*
// Get combo selection text
//------------------------------
FUN Get_combo_selection(INT C|ombo_control) ==> STR, NATIVE :
    "    RESULT := Do_Get_combo_selection(X_C);" .
*/
*)
function Do_Get_combo_selection(X_C: Integer): String;
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    
    	Result := C.SelText;
    
end;

(*
/*
// Replace combo selection with another text
//-----------------------------------------

FUN Set_combo_selection(
	INT C|ombo_control, STR Text|_replacing_selection),
    NATIVE :
    "    Do_Set_combo_selection(X_C, X_Text);" .
*/
*)

procedure Do_Set_combo_selection(
	X_C: Integer; const X_Text: String);
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
    
    	C.SelText := X_Text;
    
end;

(*
/*
// Set combo maximal length (of Edit sub-control part)
//------------------------

FUN Set_combo_max_len(
	INT C|ombo_control, INT V|alue_max_len),
    NATIVE :
    "    Do_Set_combo_max_len(X_C, X_V);" .
*/
*)

procedure Do_Set_combo_max_len(
	X_C: Integer; X_V: Integer);
var C: TComboBox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		C := TComboBox(All_controls[X_C]);
	{$ELSE}
    	C := TComboBox(Pointer(X_C));
	{$ENDIF}
     C.MaxLength := X_V; 
end;

//------------------------------------------------------------ P R O G R E S S

(*
/*
// Create progres bar control, return descriptor
//----------------------------------------------

FUN Create_progress_bar(
	{Control} P|rogress_control) ==> INT
	:
    RESULT = do_create_progress(P.Form_.Handle, P) .

FUN do_create_progress(INT F|orm_handle,
    {Control} P|rogress_bar_create) ==> INT, NATIVE :
    "     Result := Do_Create_progress_bar(X_F, X_P);" .
*/
*)
type
	TAL4ProgressBar = class(TProgressBar)
	public destructor Destroy; override;
	end;
	
destructor TAL4ProgressBar.Destroy;
//?{Progress}
var X_L: Ref_obj;
//.
begin
//?{Progress}
	X_L := ref_obj_from_control(Self);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		if X_L.Obj = nil then Exit;
	{$ENDIF} 
	{$IFDEF FPC}
		if X_L.Obj = nil then Exit; 
	{$ENDIF}
	C_Progress(X_L.Obj).F_Handle := 0;
//.
	inherited;
end;
	
function Do_Create_progress_bar(P: Integer; X_P: Pointer): Integer;
var Parent: TAL4Column;
    PB: TAL4ProgressBar;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    PB := TAL4ProgressBar.Create(Parent);
     PB.Smooth := TRUE; 
    
    {$IFDEF CPU64}
    	PB.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_P);
    {$ELSE}
    	PB.Tag := Integer(X_P);
    {$ENDIF}
    
    PB.Parent := Parent;
    Adjust_control_location(Parent, PB);
    Set_control_events(Parent, PB);
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(PB);
    {$ELSE}
    	Result := Integer(PB);
    {$ENDIF}
end;

(*
/*
// Get progress bar value
//-----------------------

FUN Get_progress_bar_value(
	INT P|rogress_control) ==> REAL, NATIVE :
	CASE P == 0 ? ==> ;
	NATIVE @     
    "    RESULT := Do_Get_progress_bar_progress(X_P);" .
*/
*)

function Do_Get_progress_bar_progress(
	X_P: Integer): Double;
var P: TProgressBar;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		P := TProgressBar(All_controls[X_P]);
	{$ELSE}
    	P := TProgressBar(Pointer(X_P));
	{$ENDIF}
    Result := P.  Position ;
end;

(*
/*
// Set progress bar value
//-----------------------

FUN Set_progress_bar_value(
	INT P|rogress_control, REAL V|alue_set), NATIVE :
    CASE P == 0 ? ==> ;
    NATIVE @     
    "    Do_Set_progress_bar_progress(X_P, X_V);" .
*/
*)

procedure Do_Set_progress_bar_progress(
	X_P: Integer; X_V: Double);
var P: TProgressBar;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		P := TProgressBar(All_controls[X_P]);
	{$ELSE}
    	P := TProgressBar(Pointer(X_P));
	{$ENDIF}
    P. Position  :=  
       Trunc  (X_V);
end;

(*
/*
// Get progress bar maximum
//-------------------------

FUN Get_progress_bar_maximum(
	INT P|rogress_control) ==> REAL, NATIVE :
    "    RESULT := Do_Get_progress_bar_maximum(X_P);" .
*/
*)

function Do_Get_progress_bar_maximum(
	X_P: Integer): Double;
var P: TProgressBar;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		P := TProgressBar(All_controls[X_P]);
	{$ELSE}
    	P := TProgressBar(Pointer(X_P));
	{$ENDIF}
    Result := P.Max;
end;

(*
/*
// Set progress bar maximum
//-------------------------

FUN Set_progress_bar_maximum(
	INT P|rogress_control, REAL V|alue_set),
    NATIVE :
    "    Do_Set_progress_bar_maximum(X_P, X_V);" .
*/
*)

procedure Do_Set_progress_bar_maximum(
	X_P: Integer; X_V: Double);
var P: TProgressBar;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		P := TProgressBar(All_controls[X_P]);
	{$ELSE}
    	P := TProgressBar(Pointer(X_P));
	{$ENDIF}
    P.Max :=  Trunc  (X_V);
end;

(*
/*
// Get progress bar minimum
//-------------------------

FUN Get_progress_bar_minimum(
	INT P|rogress_control) ==> REAL, NATIVE :
    "    RESULT := Do_Get_progress_bar_minimum(X_P);" .
*/
*)

function Do_Get_progress_bar_minimum(
	X_P: Integer): Double;
var P: TProgressBar;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		P := TProgressBar(All_controls[X_P]);
	{$ELSE}
    	P := TProgressBar(Pointer(X_P));
	{$ENDIF}
    Result := P.Min;
end;

(*
/*
// Set progress bar minimum
//-------------------------

FUN Set_progress_bar_minimum(
	INT P|rogress_control, INT V|alue_set),
    NATIVE :
    "    Do_Set_progress_bar_minimum(X_P, X_V);" .
*/
*)

procedure Do_Set_progress_bar_minimum(
	X_P, X_V: Integer);
var P: TProgressBar;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		P := TProgressBar(All_controls[X_P]);
	{$ELSE}
    	P := TProgressBar(Pointer(X_P));
	{$ENDIF}
    P.Min := X_V;
end;

(*
/*
// Get date picker Ok
//---------------------

FUN Get_date_picker_OK(
	INT D|atepicker_control) ==> BOOL, NATIVE :
    "    RESULT := TRUE;" .
*/
*)

//------------------------------------------------------------ M E N U

// Create menu, return descriptor.
//----------------------------------------------------------------------------

function Add_menu_items(
	MP: TMenuPanel; PM:  TPopupMenu ;
	Parent_item:  TMenuItem ;
	var idx: Integer; L: DynAStr): Integer;
var Item:  TMenuITem ;
    s, a, aa: String;
    i, j: Integer;
begin
	Result := 0;
    i := idx-1;
    while i < L.Count()-1 do
    begin
        inc(i);
        if  L.GetStrings(i) = ')' then
        begin
            idx := i;
            break;
        end;
        s := L.GetStrings(i);
        a := s;
        j := pos(':', s);
        if  j > 0 then
        begin
            a := Trim(Copy(s, 1, j-1));
            s := TrimLeft( Copy(s, j+1, MaxInt) );
        end;
        aa := LowerCase(a);
        if pos(',', a) > 0 then
            a := Trim(Copy(a, 1, pos(',', a) - 1));
        
	        Item := TMenuItem.Create(PM);
	        Item.OnClick := {$IFDEF OBJFPC}@{$ENDIF} MP.Item_click;
	        Item.Caption := s;
        
        MP.AliasesList.Add(a);
        MP.AllItemsList.Add(Item);
        Item.Tag := MP.AliasesList.Count-1;
        if  Parent_item <> nil then
        	
            	Parent_item.Add(Item)
        	
        else
        	 
        		PM.Items.Add(Item);
        inc(Result);
        	
        if pos(',d', aa) > 0 then Item.Enabled := false;
        if pos(',c', aa) > 0 then Item. Checked  := true;
        if  (i < L.Count()-1) and (L.GetStrings(i+1) = '(') then
        begin
            inc(i, 2);
        	 
        		Item.OnClick := nil; 
            	if Add_menu_items(MP, PM, Item, i, L) = 0 then
            		Item.Enabled := false;
        	
        end;
    end;
    
end;

//?{Form}.selection_change
var FormWhichPopupMenu: TAL4Form;
//.

{$IFnDEF LINUX}
//?{Form}.selection_change
var HookHandle: DWORD = 0;

function HookMsgProc(
code: Integer; wparam: WPARAM; lparam: LPARAM): LResult; stdcall;
var MInfo: TMenuItemInfo;
	sbuf: PAnsiChar;
	len, i, j: Integer;
	s, a: String;
	F: C_Form;
	MP: TMenuPanel;
	Item, Subitem, SubItem0: TMenuItem;
	L: PCWPStruct;
begin
	if Code = HC_Action then
	begin
		L := PCWPStruct(Pointer(lParam));
		//write('.');
		if (L^.message = WM_MENUSELECT) and 
		   (FormWhichPopupMenu <> nil) then
		begin
			//write('^');
			MP := TMenuPanel(FormWhichPopupMenu.MenuPanel_to_destroy);
			if MP <> nil then 
			begin
	            a := '';
	            SubItem := nil;
	            for i := 0 to MP.AliasesList.Count-1 do
	            begin
	                Item := TMenuItem( MP.AllItemsList[i] );
	                if (Integer(Item.Handle) = L^.LParam) and (SubItem = nil) then
	                begin
	                    SubItem0 := Item.Items[0]; 
	                    if SubItem0 <> nil then
	                    begin
	                       j := (L^.WParam and $FFFF) - SubItem0.Tag - 1;
	                       if j < Item.Count then
		                   	  SubItem := Item.Items[j];
	                    end;
	                end;
	                if SubItem = Item then
	                begin
	                    a := MP.AliasesList[i];
	                    break;
	                end;
	            end;
	            
			    F := C_Form(FormWhichPopupMenu.AL4Object.Obj);
			    {$IFDEF FPC} F.F_menu_alias.Assign_string(a); 
			    {$ELSE} F.F_menu_alias := a;
			    {$ENDIF} 
			    
			    operation_started(6, F, nil);
			    try
				    try
				    C_Form.M_Notify_sel_change(FormWhichPopupMenu.AL4Object);
				    except //on EStop: Stop_exception do;
				    	on Ex: Exception do
					    begin
					   		 if Ex is AL4_Exception then raise;
					    end
				    end;
			    finally
			    operation_ended(6, F);
			    end;
			    
			    {$IFDEF FPC} F.F_menu_alias.Assign_string(''); 
			    {$ELSE} F.F_menu_alias := '';
			    {$ENDIF} 
			end;
		end;
	end;
	Result := CallNextHookEx(HookHandle, Code, WParam, LParam);
end;

type TFNHookProc = function (
code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;

function SetWindowsHookExA(
idHook: Integer; 
lpfn: TFNHookProc; 
hmod: HINST; 
dwThreadId: DWORD): HHOOK; stdcall;
external user32 name 'SetWindowsHookExA';
//.
{$ENDIF}

function Do_create_menu(
	P: Integer; X_V: DynAStr): TMenuPanel;
var Parent: TAL4Column;
    M: TMenuPanel;
    i: Integer;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    
    if F.MenuPanel_to_destroy <> nil then
    begin
        F.MenuPanel_to_destroy.Free;
        F.MenuPanel_to_destroy := nil;
    end;
    
    M := TMenuPanel.Create(Parent);
    F.MenuPanel_to_destroy := M;
    
    M.Form_ := F;
    F.MenuPanel_to_destroy := M;
    M.Visible := FALSE;
    M.Width := 0;
    M.Height := 0;
    M.Track := C_Form(F.AL4Object.Obj).F_tracking_menu_sel;
    
	    M.MenuObject := TPopupMenu.Create(M);
	    M.Parent := Parent;
    
    Result := M;
    //---------------------- now fill menu items tree
    M.AliasesList := TStringList.Create;
    M.AllItemsList := TList .Create;
    i := 0;
    Add_menu_items(M, M.MenuObject, nil, i, X_V);
//?{Form}.selection_change
//    {$IFnDEF FPC}
//    if HookHandle = 0 then
//    begin
//        HookHandle
//            := SetWindowsHookExA(
//            WH_CALLWNDPROC, @HookMsgProc, 0, GetCurrentThreadId);
//    end;
//    {$ENDIF}
//.
end;

// Destroy menu panel together with the menu, all its items, aliases, etc.

procedure Do_Destroy_menu(
	MP: TMenuPanel);
begin
	MP.MenuObject.Free;
	MP.MenuObject := nil;
end;

(*
/*
// Show menu, return selected item's alias
//------------------------------------------------------------------------

FUN Popup_menu(
	{Form} F|orm_showing_menu, STR M|enu_definition)
	:
    {point} pt|_to_popup = F.Get_popup_point
    STR def|inition[]
    Split(def[], M, #NL)
    FOR i IN [def[].Count-1 DOWNTO 0] :
        CASE def[i].Trim == "" ? def[].Delete(i) ;
    ;
    PUSH F.suspended_count = F.suspended_count + 1 :
    do_popup_menu(F.Handle, def[], pt.X, pt.Y) ; .
FUN do_popup_menu(
INT F|orm_handle, STR M|enu_definition[], REAL X|_on_screen, REAL Y|_on_screen),
NATIVE : "    Do_Popup_menu(X_F, X_M, X_X, X_Y);" .
*/
*)

procedure Do_Popup_menu(
	X_F: Integer; X_M: DynAStr; X, Y: Double);
var MP: TMenuPanel;
    F: TAL4Form;
    P: TPoint ;
begin
    MP := Do_create_menu(X_F, X_M);
    F := nil;
    if  X_F <> 0 then
	 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	 	 F := TAL4Form(All_forms[X_F]);
	 	{$ELSE}
         F := TAL4Form(X_F);
     	{$ENDIF}
    MP.Ready := FALSE;
    MP.Alias := '';
    P.X := AL4_form.Points(X);
    P.Y := AL4_form.Points(Y);
    if F <> nil then
    begin
    	{$IFDEF MOBILE_SCREEN}
    		P := F.LocalToAbsolute(P);
    		P := AL4Screen.ClientToScreen(P);
    	{$ELSE}
    		P := F.ClientToScreen(P);
    	{$ENDIF}
//?{Form}.selection_change    	
    	FormWhichPopupMenu := F;
//.
    end
//?{Form}.selection_change    	
    	else FormWhichPopupMenu := nil
//.
    ;
    
    	MP.MenuObject.Popup(P.X , P.Y);
    
end;

//---------------------------------------------------------- T I M E R

(*
/*
// Create timer, return descriptor.
//----------------------------------------------------------------------------

FUN Create_timer(
	{Control} T|imer_object,
    INT Interval, BOOL Active|_state) ==> INT
    :
    RESULT = do_create_timer(T.Form_.Handle, T)
    Set_timer_interval(RESULT, Interval)
    Set_timer_active(RESULT, Active) .

FUN do_create_timer(INT F|orm_handle,
    {Control} T|imer_create) ==> INT, NATIVE :
    "     Result := Do_create_timer(X_F, X_T);" .
*/
*)

function Do_create_timer(
	P: Integer; X_T: Pointer): Integer;
var Parent: TAL4Column;
    TP: TTimerPanel;
    F: TAL4Form;
begin
 	F := form_from_handle(P);
    Parent := F.Get_current_column;
    TP := TTimerPanel.Create(Parent);
    TP.Visible := FALSE;
    TP.TimerObject := TTimer.Create(TP);
    TP.TimerObject.Enabled := FALSE;
    
    {$IFDEF CPU64}
    	TP.TimerObject.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(TP);
    	TP.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_T);
    {$ELSE}
    	TP.TimerObject.Tag := Integer(TP);
    	TP.Tag := Integer(X_T);
    {$ENDIF}
    
    TP.TimerObject.OnTimer := {$IFDEF OBJFPC}@{$ENDIF} F.Form_timer_tick;
    TP.Parent := Parent;
    //TP.Caption := 'Timer';
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(TP);
    {$ELSE}
    	Result := Integer(TP);
    {$ENDIF}
end;

(*
/*
// Set timer Interval
//-------------------

FUN Set_timer_interval(
	INT T|imer_control, INT V|alue_interval),
    NATIVE :
    "    do_set_timer_interval(X_T, X_V);" .
*/
*)

procedure Do_Set_timer_interval(
	X_T, X_V: Integer);
var TP: TTimerPanel;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		TP := TTimerPanel(All_controls[X_T]);
	{$ELSE}
    	TP := TTimerPanel(Pointer(X_T));
	{$ENDIF}
    TP.TimerObject.Interval := X_V;
end;

(*
/*
// Set timer Active / Not active state
//------------------------------------

FUN Set_timer_active(
	INT T|imer_control, BOOL A|ctive_state),
    NATIVE :
    CASE T == 0 ? ==> ;
    NATIVE @
    "    do_set_timer_active(X_T, X_A);" .
*/
*)
procedure Do_Set_timer_active(X_T: Integer; X_A: Boolean);
var TP: TTimerPanel;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		TP := TTimerPanel(All_controls[X_T]);
	{$ELSE}
    	TP := TTimerPanel(Pointer(X_T));
	{$ENDIF}
    TP.TimerObject.Enabled := X_A;
end;

(*
/*

FUN Time_BeginPrecision(INT Prec|ision_milliseconds),
	NATIVE :
	"	Do_timeBeginPeriod(X_Prec);" .
	
FUN Time_EndPrecision(INT Prec|ision_milliseconds),
	NATIVE :
	"	Do_timeEndPeriod(X_Prec);" .
*/
*)

{$IFnDEF LINUX}

function timeBeginPeriod(uPeriod: UINT): UINT; stdcall;
external 'winmm.dll' name 'timeBeginPeriod';
function timeEndPeriod(uPeriod: UINT): UINT; stdcall;
external 'winmm.dll' name 'timeEndPeriod';

{$ENDIF}

procedure Do_timeBeginPeriod(p: Integer);
begin
{$IFnDEF LINUX}

	timeBeginPeriod(p);

{$ENDIF}
end;

procedure Do_timeEndPeriod(p: Integer);
begin
{$IFnDEF LINUX}

	timeEndPeriod(p);

{$ENDIF}
end;

(*
/*
// Process all form messages
//------------------------------------

FUN Process_all_form_messages(
	INT H|andle_form), NATIVE :
    "    Application.ProcessMessages;" .
*/
*)

{ TAL4Column }

// Create column
constructor TAL4Column.Create(AOwner: TComponent);
begin
  inherited;
  {$IFDEF FPC}
  AutoSize := false;
  {$ENDIF}
  AL4Form := AOwner as TAL4Form;
  ListControls := TList  .Create;
   BorderStyle := bsNone;
   BorderWidth := 0;
   //Color := clRED;
  auto_arrange := true;

  {$IFNDEF FPC}
  
  {$IFDEF SCROLLED_COLUMNS}
  BevelKind := bkFlat;
  BevelOuter := bvLowered;
  {ELSE}
  BevelInner := bvNone;
  BevelOuter := bvNone;
  {$ENDIF}

  
  {$ENDIF}
  
  {$IFDEF SCROLLED_COLUMNS}
  	HorzScrollBar.Visible := false;
  	{$IFDEF SWIPE_FORMS}
  		VertScrollbar.Visible := false;
  	{$ENDIF}
  {$ENDIF}
  
end;

// is Column horizontal ?
destructor TAL4Column.Destroy;
begin
  ListControls.Clear;
  inherited;
end;



{ TAL4Form }

(*
/*
// Get point on form used to pop up menu by default
//-------------------------------------------------

FUN Get_form_popup_point(
	INT F|orm_handle) ==> {Geometry}.{point}
	:
	CASE F == 0 ? ==> ;
	REAL p|oint_coords[] << 0 << 0
	do_Get_form_popup_point(F, p[])
	RESULT = Pt(p[0], p[1]) .
FUN do_Get_form_popup_point(INT F|orm_handle, REAL P|oint_coords[]), NATIVE : @
    "var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
    "    X_P.SetReals(0, F.Popup_point.f_X);" 
    "    X_P.SetReals(1, F.Popup_point.f_Y);"
    .
    
FUN Set_form_popup_point(
INT F|orm_handle, REAL Px|_coordinate_points, REAL Py|_coordinate_points), NATIVE 
    : @
    "var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
    "    F.Popup_point.f_X := X_Px;" 
    "    F.Popup_point.f_Y := X_Py;"
    .
    

// Get mouse point on form for current mouse event
//-------------------------------------------------

FUN Form_get_mouse_point(
	INT F|orm_handle) ==> {Geometry}.{point}
	:
    CASE F == 0 ? ==> ;
	REAL p|oint_coords[] << 0 << 0
	do_Get_mouse_point(F, p[])
	RESULT = Pt(p[0], p[1]) .
FUN do_Get_mouse_point(INT F|orm_handle, REAL P|oint_coords[]), NATIVE : @
    "var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
    "	X_P.SetReals(0, F.Mouse_point.f_X);"
    "	X_P.SetReals(1, F.Mouse_point.f_Y);"
    .
    
// Get mouse button clicked
//-------------------------------------------------

FUN Form_mouse_button(
	INT F|orm_handle) ==> {Form}.{button}, NATIVE :
	CASE F==0 ? ==> ;
	NATIVE @
	"var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
    "   Result := F.Mouse_button;" .
    
// Get mouse wheel distance
//-------------------------------------------------

FUN Form_vertical_wheel(
	INT F|orm_handle) ==> REAL, NATIVE : @
	"var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
    "    Result := F.Mouse_wheel_vertical;" .
    
// Get mouse wheel horizontal distance
//-------------------------------------------------

FUN Form_horizontal_wheel(
	INT F|orm_handle) ==> REAL, NATIVE : @
	"var F: TAL4Form;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 F := TAL4Form(All_forms[X_F]);"
	"	{$ELSE}"
    "    F := TAL4Form(X_F);"
    "	{$ENDIF}"
    "    Result := F.Mouse_wheel_horizontal;" .
    
// Get mouse point on screen
//-------------------------------------------------

FUN Get_mouse_cursor_position ==> {Geometry}.{point}
	:
	REAL mp|osition[] << 0 << 0
	do_Get_mouse_cursor_pos(mp[])
	RESULT = Pt(mp[0], mp[1]) .
FUN do_Get_mouse_cursor_pos(REAL MP|osition[]), NATIVE : @
	"var P: TPoint;"
	"	{$IFDEF LINUX}"
	"		P.X := Mouse.CursorPos.X;"
	"		P.Y := Mouse.CursorPos.Y;"
	"	{$ELSE}"
	"	 GetCursorPos(P);"
	"	{$ENDIF}"
	"	 Prepare_mouse_point_button("
	"		nil, mbLeft, "
	"		FALSE, nil, []);"
    "    X_MP.SetReals(0, Pixels(P.X));"
    "    X_MP.SetReals(1, Pixels(P.Y));"
    .
    
FUN Set_new_mouse_cursor_position(
REAL X|_coordinate_points, REAL Y|_coordinate_points), NATIVE : @
	"SetCursorPos(Points(X_X), Points(X_Y));" .
    
FUN Is_mouse_button_pressed(
{button} Button|_checked) ==> BOOL, NATIVE :
@	"var code: Integer;"
	"	case X_Button of"
	"	1, 2: code := X_Button;"
	"	3, 4, 5: code := X_Button + 1;"
	"	else Exit;"
	"	end;"
	"	RESULT := "
	"			  {$IFDEF LINUX} false "
	"			  {$ELSE} GetAsyncKeyState(code) < 0"
	"			  {$ENDIF} ;"
	.
	
	
FUN Is_keyboard_key_pressed(
INT Key|_interesting) ==> BOOL, NATIVE : @
"RESULT := "
"		   {$IFDEF LINUX} false"
" 		   {$ELSE} GetAsyncKeyState(X_Key) < 0"
"		   {$ENDIF} ;"
.	

*/
*)

// Event: control is clicked\

{$IFDEF SIMULATE_LONG_TAP_RMB}
	{$DEFINE LongTap_or_Swipe}
{$ENDIF}
{$IFDEF SWIPE_FORMS}
	{$DEFINE LongTap_or_Swipe}
{$ENDIF}

{$IFDEF LongTap_or_Swipe}
var Time_mouse_down: Integer;
	Mouse_down_pos: TPoint;
{$ENDIF}

{$IFDEF SIMULATE_LONG_TAP_RMB}
var	Timer_long_tap: TTimer;
	Ignore_click: Boolean;
	
{$ENDIF}

{$IFDEF SWIPE_FORMS}
var Mouse_down_timer: TTimer;
	Swipe_detected: Boolean;	
	handling_click_by_mouse_timer: Boolean;
	Detected_swipe_X, Detected_swipe_Y: Integer;
{$ENDIF}

(*
/*
		
        
        FUN Control_click(
        {Control} C|ontrol_which_click_should_be_handled), NATIVE:
            INT h|andle_form = C.Form_.Handle
            NATIVE @
        "var C: THackControl; F: TAL4Form;"
        "	 C := HackControl(C_Control(X_C.Obj).F_Handle);"
        "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
        "	 F := TAL4Form(All_forms[X_h]);"
        "{$ELSE}"
        "	 F := TAL4Form(X_h);"
        "{$ENDIF}"
        "F.Control_clicked(C);" .
        	//: C.Form_.click .
	
        
*/
*)

procedure TAL4Form.Control_clicked(
	Sender: TObject);
begin
	is_control_mouse_event := true;
	try
		Form_clicked(Sender);
	finally
		is_control_mouse_event := false;
	end;
end;

procedure TAL4Form.Form_clicked(
	Sender: TObject);
//?{Form}.click
var P, P0:  TPoint ;
	F: C_Form;
	C: TControl;
    R: Ref_obj;
//.
begin
	{$IFDEF SWIPE_FORMS}
	if (Detected_swipe_X <> 0) or (Detected_swipe_Y <> 0) then Exit;
	if (Mouse_down_timer <> nil) and Mouse_down_timer.Enabled then Exit;
	{$ENDIF}
	
	{$IFDEF SIMULATE_LONG_TAP_RMB}
	    if Timer_long_tap <> nil then
		   Timer_long_tap.Enabled := false;
	    
        //if true then writeln(IntToStr(
        //            GetTickCount) + ' Form_clicked, stop long tap timer!');
		if Ignore_click then
		begin
		   Ignore_click := false;
		   //Exit;
		end;
	{$ENDIF}
	
//?{Form}.click
	F := C_Form( AL4Object.Obj );
    //******************************
    //writeln('fc+' + IntToStr(F.F_level_event));
    if (F.F_level_event > 2) then Exit;
    //writeln('fc-');
    //******************************
	
    	Prepare_mouse_point_button(Self, 
    	 	 mbLeft, FALSE, F, []);
    
    R := nil;
	if is_control_mouse_event then
	begin
	    C := Sender as TControl;
	    R := ref_obj_from_control(C);
	    P.X := 0;
	    P.Y := C.Height;
	    
	    	P0 := C.ClientToScreen(P);
	    	P := ScreenToClient(P0);
	     
	    Popup_point.f_X := Pixels(P.X);
	    Popup_point.f_Y := Pixels(P.Y);
	    
	    //Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, R.Obj);
	    //F := C_Form(AL4Object.Obj);
	end
		else if Sender is TControl then
	begin 
	    C := Sender as TControl;
	    R := ref_obj_from_control(C);
	end;
    	;
    
    //-------------------------------
    //if Sender is TControl then
    //writeln('handling Form_clicked, Sender=' + TControl(Sender).Name +
    //#13#10'R=' + C_Control(R.Obj).F_Alias);
    //-------------------------------
    operation_started(0, F, R);
    try
	    try
	    F.M_Click;
	    except //on EStop: Stop_exception do;
	    		on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
    finally
    operation_ended(0, F);
    end;
    
    //Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, NoneObj_C_Control);
//.
end;


procedure TAL4Form.Control_changed(
	Sender: TObject);
var F: C_Form;
var C: TControl;
    R: Ref_obj;
//?{Form}.value_change
//.
begin
    F := C_Form( AL4Object.Obj );
    C := Sender as TControl;
    R := nil;
//?{Form}.value_change
    R := ref_obj_from_control(C);

	operation_started(5, F, R);
	try
		try
//.
//?{Checkbox}
		if R = nil then  
	    	R := ref_obj_from_control(C);
		if C is TCheckbox then
			C_Checkbox(R.Obj).M_radio_select(R);
//.
//?{Form}.value_change
	    F.M_value_change;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(5, F);
    end;
//.
	F.M_Any_change;
end;

procedure TAL4Form.Control_enter(
	Sender: TObject);
var F: C_Form;
//?{Form}.enter
var C: TControl;
    R: Ref_obj;
//.
begin
    F := C_Form( AL4Object.Obj );
//?{Form}.enter
    C := Sender as TControl;
    R := nil;
    R := ref_obj_from_control(C);

    
	operation_started(24, F, R);
	try
		try
	    F.M_enter;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(24, F);
    end;
//.
	F.M_Any_change;
end;

procedure TAL4Form.Control_leave(
	Sender: TObject);
var F: C_Form;
//?{Form}.leave
var C: TControl;
    R: Ref_obj;
//.
begin
    F := C_Form( AL4Object.Obj );
//?{Form}.leave
    C := Sender as TControl;
    R := nil;
    R := ref_obj_from_control(C);
    
	operation_started(24, F, R);
	try
		try
	    F.M_leave;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(24, F);
    end;
//.
	F.M_Any_change;
end;

(*
/*

FUNCTION Control_selection_change(
	{Control} C|ontrol_changed)
	:
    PUSH C.Form_.sender_ = C :
    	 {Form}.Notify_sel_change(C.Form_) 
    ; .
    
//FUNCTION Set_window_mouse_transparent(
//{Form} F|orm_object, BOOL Transparent), NATIVE :
//    INT h|andle_of_form = F.Handle
//    NATIVE @
//    "var form: TAL4Form;" 
//    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
//    "    form := TAL4Form(All_forms[X_h]);"
//    "{$ELSE}"
//    "    form := TAL4Form(X_h);"
//    "{$ENDIF}"
//    "form.Is_httransparent := X_Transparent;" .
*/
*)

procedure TAL4Form.Selection_changed(
	Sender: TObject);
//?{Form}.selection_change
var C: TControl;
    R: Ref_obj;
    F: C_Form;
//.
begin
//?{Form}.selection_change
	
	C := Sender as TControl;
    R := ref_obj_from_control(C);

    //Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, R.Obj);
    F := C_Form( AL4Object.Obj ); 
    
    operation_started(6, F, R);
    try
	    try
	    //C_Form.M_Notify_sel_change(AL4Object);
	    unitC_Form.M_Notify_sel_change(AL4Object);
	    except //on EStop: Stop_exception do;
	    		on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
    finally
    operation_ended(6, F);
    end;

	//Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, NoneObj_C_Control);
//.
end;


procedure TAL4Form.Listview_changed(
	Sender: TObject; Item: TListItem;
	Change: TItemChange);
begin
    Control_changed(Sender);
end;

var control_resizing: Boolean;

procedure TAL4Form.Control_resized(
	Sender: TObject);
//?{Form}.resize
var C: TControl;
    R: Ref_obj;
    CF: C_Form;
//.
begin
//?{Form}.resize
    C := Sender as TControl;
    
    //writeln('Control resized ' + FloatToStr(Pixels(C.Width)) + 'x' +
    //    FloatToStr(Pixels(C.Height)));

	if ignore_resize then Exit;
	if control_resizing then Exit;
	control_resizing := true;
	try
	    R := ref_obj_from_control(C);
	    CF := C_Form(AL4Object.Obj);
	    if CF.F_Handle = 0 then Exit;
	    if CF.F_suspended_count > 0 then Exit;
		operation_started(7, CF, R);
		{$IFDEF FPC}
		inc(Setting_control_size);
		{$ENDIF}
		try
			try
		    C_Control(R.Obj).M_resized;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
	    finally
	    	{$IFDEF FPC}
	    	dec(Setting_control_size);
	    	{$ENDIF}
	    	operation_ended(7, CF);
	    end;
	finally
		control_resizing := false;
	end;
//.
end;

{$IFDef FPC}
procedure TAL4Form.Form_resized(Sender: TObject);
{$ELSE}
procedure TAL4Form.Form_resized(var M: TMessage);
{$ENDIF}
var CF: C_Form;
begin
	inherited;
	if not was_Shown then begin 
		//writeln('no was shown --> ignored Form_resized ...');
		Exit;
	end;
	if ignore_resize then begin
		//writeln('ignore_resize = TRUE --> ...');
		Exit;
	end;
	CF := C_Form( AL4Object.Obj );
	Adjust_columns;
//?{Form}.resize

    operation_started(7, CF, nil);
    try
	    try
	    CF.M_resize;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
    finally
    operation_ended(7, CF);
    end;
//.
end;

{$IFDef FPC}
procedure TAL4Form.Form_moved(Sender: TObject);
{$ELSE}
procedure TAL4Form.Form_moved(var M: TMessage);
{$ENDIF}
//?{Form}.moved
var CF: C_Form;
//.
begin
//?{Form}.moved
	if not created then Exit;
	CF := C_Form( AL4Object.Obj );
    
    operation_started(8, CF, nil);
    try
	    try
	    if CF <> nil then
	       CF.M_moved;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
    finally
    operation_ended(8, CF);
    end;    
//.
end;

procedure prepare_info(
	Key:Word; F: C_Form; Shift: TShiftState);
var Info: St_key_info__C_Form;
	c: Char;
begin
	if F = nil then Exit;
    Info := St_key_info__C_Form(F.F_Key.Obj);
    Info.f_Special := 0;
    {$IFDEF FPC} Info.f_Char.Assign_string(''); 
    {$ELSE} Info.f_Char := '';
    {$ENDIF} 

    Info.f_Right := false;
    Info.f_Caps := false;
    Info.f_Shift := false;
    Info.f_Ctrl := false;
    Info.f_Alt := false;
    Info.f_Win := false;

    if  (Key >= Word('A')) and (Key <= Word('Z')) or
        (Key >= Word('0')) and (Key <= Word('9')) or
        (Key = 8) or (Key = 13) or (Key = Word(' ')) then
        {$IFDEF FPC} Info.f_Char.Assign_string('' + Char(Key)); 
	    {$ELSE} Info.f_Char := '' + Char(Key);
	    {$ENDIF} 

    if Key = 0 then 
	    {$IFDEF FPC} Info.f_Char.Assign_string(''); 
	    {$ELSE} Info.f_Char := '';
	    {$ENDIF} 
        
    c := #0;
    CASE Key OF
    $5B, $DB: begin c := '['; Key := 0; end;
    $5D, $DD: begin c := ']'; Key := 0; end;
    $3C, $BC: begin c := '<'; Key := 0; end;
    $3E, $BE: begin c := '>'; Key := 0; end;
    $3A, $BA: begin c := ';'; Key := 0; end;
    $5E, $DE: begin c := ''''; Key := 0; end;
    $3F, $BF: begin c := '/'; Key := 0; end;
    $5C, $DC: begin c := '\'; Key := 0; end;
    $40, $C0: begin c := '~'; Key := 0; end;
    END;
    if c <> #0 then
    	{$IFDEF FPC} Info.f_Char.Assign_string('' + c); 
	    {$ELSE} Info.f_Char := '' + c;
	    {$ENDIF} 


    Info.f_Special := Byte(Key);

    {$IFDEF LINUX}
    {$ELSE}
    		Info.f_Caps := (GetKeyState(Key) and 1) <> 0;
    {$ENDIF}
    
    {$IFDEF LINUX}
	    Info.f_Shift := ssSHIFT in Shift;
	    Info.f_Ctrl := ssCtrl in Shift;
	    Info.f_Alt := ssAlt in Shift;
	    //Info.f_Win := ssWin in Shift;
    {$ELSE}
		    Info.f_Shift := GetKeyState( VK_SHIFT ) < 0;
		    Info.f_Ctrl := GetKeyState( VK_CONTROL ) < 0;
		    Info.f_Alt := GetKeyState( VK_MENU ) < 0;
		    
		    Info.f_Win := (GetKeyState(VK_LWIN) < 0) 
		    			   or (GetKeyState(VK_RWIN) < 0);
    {$ENDIF}
end;


procedure prepare_info_press(
	{$IFDEF FPC} 
		Key: TUTF8Char
	{$ELSE}
		Key: Char
	{$ENDIF}; 
	F: C_Form; Shift: TShiftState);
var Info: St_key_info__C_Form;
begin
    Info := St_key_info__C_Form(F.F_Key.Obj);
    Info.f_Special := 0;
    {$IFDEF FPC} Info.f_Char.Assign_string(''); 
    {$ELSE} Info.f_Char := '';
    {$ENDIF} 

    Info.f_Right := false;
    Info.f_Caps := false;
    Info.f_Shift := false;
    Info.f_Ctrl := false;
    Info.f_Alt := false;
    Info.f_Win := false;
    
    {$IFDEF FPC} Info.f_Char.Assign_string('' + Key); 
    {$ELSE} Info.f_Char := '' + Key;
    {$ENDIF} 
    
    {$IFDEF FPC}
	    if Length(Key) = 1 then
	    	Info.f_Special := 
	    						Byte(Key[1])
	    					  
	    else Info.f_Special := 0;
    {$ELSE}
    	Info.f_Special := Byte(Key);
    {$ENDIF}
    Info.f_Caps := FALSE;
    {$IFDEF LINUX}
	    Info.f_Shift := ssSHIFT in Shift;
	    Info.f_Ctrl := ssCtrl in Shift;
	    Info.f_Alt := ssAlt in Shift;
    {$ELSE}
	    Info.f_Shift := GetKeyState( VK_SHIFT ) < 0;
	    Info.f_Ctrl := GetKeyState( VK_CONTROL ) < 0;
	    Info.f_Alt := GetKeyState( VK_MENU ) < 0;
	    Info.f_Win := (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0);
    {$ENDIF}
    if Info.f_Ctrl and Info.f_Alt and (GetKeyState(VK_LCONTROL) < 0)
    	and (GetKeyState(VK_RMENU) < 0) then
    begin
    	//writeln('ALT-Gr detected');
    	Info.f_Ctrl := false;
    end;
end;


procedure Prepare_mouse_point_button(
	Form: TAL4Form; Button: TMouseButton; 
    do_Button: Boolean; CF: C_Form; Shift: TShiftState);
var P, P0:  TPoint ;
	
    b: Integer;
    {$IFnDEF LINUX}
    
    hC: THandle;
    iI: TIconInfo;
    
    {$ENDIF}
begin
	if Form = nil then Exit;
	{$IFDEF LINUX}
		P := Mouse.CursorPos;
	{$ELSE}
		GetCursorPos(P);
    {$ENDIF}
    
    if Form <> nil then
    begin
    	P0 := P;
    	{$IFDEF MOBILE_SCREEN}
    		P := Form.LocalToAbsolute(P);
    	{$ELSE}
    		P := Form.ScreenToClient(P);
    	{$ENDIF}
	    Form.Mouse_point.f_X := Pixels(P.X);
	    Form.Mouse_point.f_Y := Pixels(P.Y);
	    
	    begin
		    Form.Popup_point.f_X := Pixels(P.X);
		    Form.Popup_point.f_Y := Pixels(P.Y);
            //if true then
            //    writeln('handle mouse down, Popup_point=' +
            //    FloatToStr(P.X) + '   ' + FloatToStr(P.Y) +
            //    ', P0 = ' + FloatToStr(P0.X) + '   '
            //    + FloatToStr(P0.Y));
	    end;
   
	    if do_Button then
	    begin
	        CASE Button OF
	         mbLeft: b := 1;
	         mbRight: b := 2;
	         mbMiddle: b := 3;
	        else b := 0;
	        END;
	        Form.Mouse_button := b;
	    end;
    	prepare_info(0, CF, Shift);
    end;
    
end;

procedure TAL4Form.timer_moving_form(
Sender: TObject);
{$IFDEF LINUX}
var mp, P:  TPoint ;
{$ENDIF}
begin
{$IFDEF LINUX}
	if Application.Terminated then
	begin
		Exit;
	end;
	if (mouse_down_to_move <> nil) and (mouse_down_to_move.Enabled) then
	begin
		mp :=  Mouse.CursorPos; 
		P.x := pos0.x + mp.x - mouse0.x;
		P.y := pos0.y + mp.y - mouse0.y;
	    Left :=  ( P.x + delta0.x );
	    Top :=  ( P.y + delta0.y );
	    if (mp.X >= Left) and (mp.X < Left + Width) and
	    	(mp.Y >= Top) and (mp.Y < Top + Height) then
	    else mouse_down_to_move.Enabled := false;
		Exit;
	end;
{$ENDIF}
end;

{$IFDEF SWIPE_FORMS}
procedure TAL4Form.handle_swipe_move(P: TPoint);
var i: Integer;
	c: TAL4Column;
begin
	if Mouse_down_timer <> nil then
	   Mouse_down_timer.Enabled := false;
	if Detected_swipe_X <> 0 then
		Detected_swipe_X := P.X - Mouse_down_pos.X
	else if Detected_swipe_Y <> 0 then
		Detected_swipe_Y := P.Y - Mouse_down_pos.Y;
    //if true then writeln('swiping, Detected_swipe_X=' +
    //    IntToStr(Detected_swipe_X) +
    //    ', Detected_swipe_Y=' + IntToStr(Detected_swipe_Y) +
    //    ', P=(' + FloatToStr(P.X) + ';' + FloatToStr(P.Y) + ')');
	Adjust_columns;
	for i := 0 to Columns.Count-1 do
	begin
		c := TAL4Column(Columns[i]);
		if not c.Visible then continue;
		if (c.Width = 0) or (c.Height = 0) then continue;
		if (Detected_swipe_X <> 0) and c.Horizontal then continue;
		if (Detected_swipe_Y <> 0) and not c.Horizontal then continue;
		SetPos(c, XPos(c) + Detected_swipe_X,
				  YPos(c) + Detected_swipe_Y);
	end;
	{$IFDEF MOBILE_SCREEN}
		InvalidateRect(BoundsRect);
	{$ELSE}
		Invalidate;
	{$ENDIF}
end;

procedure TAL4Form.handle_swiped;
var i, j: Integer;
	c, t, b: TAL4Column;
	f: TAL4Form;
	{$IFDEF FPC}
	{$ELSE}
	M: TMessage;
	{$ENDIF}
begin
	f := Self;
	if Detected_swipe_X <> 0 then
	begin
		for i := 0 to Columns.Count-1 do
		begin
			c := TAL4Column(Columns[i]);
			if not c.Horizontal then
			begin
				if (Left_visible_column < i) then
					Left_visible_column := i;
				break;
			end; 
		end;
		i := Left_visible_column;
		if (Detected_swipe_X > 0) and (Left_visible_column > 0) then
			i := Left_visible_column - 1
		else
		if (Detected_swipe_X < 0) and (Left_visible_column < Columns.Count-1) then
			i := Left_visible_column + 1;
		//if i <> Left_visible_column then
		begin
			j := i;
			if i >= Columns.Count then i := Columns.Count-1;
			if i < 0 then i := 0;
            //if true then
            //    writeln('Left_visible_column=' + IntToStr(Left_visible_column) +
            //        ', i=' + IntToStr(i));
			c := TAL4Column(Columns[i]);
			if not c.Horizontal 
			    then
			begin 
				Left_visible_column := i;
			end
			
			;
		end;
	end
		else
	if Detected_swipe_Y <> 0 then
	begin
		if Top_visible_column >= Columns.Count then
			Top_visible_column := Columns.Count-1;
		if Bottom_visible_col >= Columns.Count then	
			Bottom_visible_col := Columns.Count-1;
		t := nil;
		if (Top_visible_column >= 0) and (Top_visible_column < Columns.Count) then
			t := TAL4Column(Columns[Top_visible_column]);
		b := nil;
		if (Bottom_visible_col >= 0) and (Bottom_visible_col < Columns.Count) then
			b := TAL4Column(Columns[Bottom_visible_col]);
			
		i := Top_visible_column;
		if (Detected_swipe_Y > 0) then
		begin
			if (Bottom_visible_col > 0) and (b <> nil) and
				(TAL4Column(Columns[Bottom_visible_col - 1]).Layout = b.Layout) then
			begin
				Bottom_visible_col := Bottom_visible_col - 1;
			end
				else
			if (Top_visible_column > 0) and (t <> nil) and
				(TAL4Column(Columns[Top_visible_column - 1]).Layout = t.Layout) then
			begin
				Top_visible_column := Top_visible_column - 1;
			end;
		end 
		else if (Detected_swipe_Y < 0) then
		begin
			if (Top_visible_column < Columns.Count-1) and (t <> nil) and
				(TAL4Column(Columns[Top_visible_column+1]).Layout = t.Layout) then
			begin
				Top_visible_column := Top_visible_column + 1;
			end
				else
			if (Bottom_visible_col < Columns.Count-1) and (b <> nil) and
				(TAL4Column(Columns[Bottom_visible_col+1]).Layout = b.Layout) then
			begin
				Bottom_visible_col := Bottom_visible_col + 1;
			end;
		end; 
	end;
    //if true then
    //begin
    //    for i := 0 to Columns.Count-1 do
    //    begin
    //        c := TAL4Column(Columns[i]);
    //        //writeln('column[' + IntToStr(i) + ']: ' + c.Alias + ', Layout=' +
    //        //    IntToStr(c.Layout));
    //    end;
    //    writeln('swiped, Detected_swipe_X=' + IntToStr(Detected_swipe_X) +
    //    ', Detected_swipe_Y=' + IntToStr(Detected_swipe_Y) +
    //    ', Left_visible_column=' + IntToStr(Left_visible_column) +
    //    ', Top_visible_column=' + IntToStr(Top_visible_column) +
    //    ', Bottom_visible_col=' + IntToStr(Bottom_visible_col));
    //end;
	Detected_swipe_X := 0;
	Detected_swipe_Y := 0;
	f.Adjust_columns;
end;
{$ENDIF}

procedure TAL4Form.Control_mouse_move(
    Sender: TObject; Shift: TShiftState;
    X, Y:  Integer );
begin
	is_control_mouse_event := true;
	try
		Form_mouse_move(Sender, Shift, X, Y);
	finally
		is_control_mouse_event := false;
	end;
end;

procedure TAL4Form.Form_mouse_move(
	Sender: TObject; Shift: TShiftState; 
	X, Y:  Integer );
var F: C_Form;
	stop_handling: Boolean;
	C: TControl;
    R: Ref_obj;
    CC: C_Control;
{$IFDEF SWIPE_FORMS}
	{$DEFINE Swipe_or_Linux}
{$ENDIF}
{$IFDEF LINUX}
	{$DEFINE Swipe_or_Linux}
{$ENDIF}
{$IFDEF Swipe_or_Linux}
var P: TPoint;
	dT: Integer;
{$ENDIF}
begin
	stop_handling := FALSE; if stop_handling then;
    F := C_Form(AL4Object.Obj);
{$IFDEF SWIPE_FORMS}
    	if Application.Terminated then Exit;
    	if (Mouse_down_timer<>nil) and (Mouse_down_timer.Enabled) 
    		or (Detected_swipe_X <> 0) or (Detected_swipe_Y <> 0)
    	then
    	begin
		 	
		 		GetCursorPos(P);
		 	
            //if true then
            //    writeln('mouse move ' + FloatToStr(P.X) + ';' + FloatToStr(P.Y));
    		if (Detected_swipe_X = 0) and (Detected_swipe_Y = 0) then
    		begin
    			//try to detect swipe by mouse/hand
			 	dT := Abs(
			 		{$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF} 
			 		- Time_mouse_down); 
			 	if dT > 0 then
			 	begin
					if (Pixels(Abs(P.X - Mouse_down_pos.X)) / dT >= 0.1) and
		    		   (Abs(P.X - Mouse_down_pos.X) > 
		    		   	2 * Abs(P.Y - Mouse_down_pos.Y) ) then
		    		   Detected_swipe_X := P.X - Mouse_down_pos.X
		    		else if (Pixels(Abs(P.Y - Mouse_down_pos.Y)) / dT >= 0.1) and
		    		   (Abs(P.Y - Mouse_down_pos.Y) > 2 * Abs(P.X - Mouse_down_pos.X)) 
		    		   then
		    		   Detected_swipe_Y := P.Y - Mouse_down_pos.Y
		    		else
		    		begin
		    			Detected_swipe_X := 0;
		    			Detected_swipe_Y := 0;
		    		end;
                    //if true then
                    //    if (Detected_swipe_X <> 0) or (Detected_swipe_Y <> 0) then
                    //    writeln('detected swipe ok:' +
                    //    'delta time = ' + IntToStr(
                    //    (Abs(GetTickCount
                    //    - Time_mouse_down))) +
                    //    ', dX=' + IntToStr(P.X - Mouse_down_pos.X) +
                    //    ', dY=' + IntToStr(P.Y - Mouse_down_pos.Y));
	    		end;
                //if true then
                //    if (Detected_swipe_X = 0) and (Detected_swipe_Y = 0) then
                //    writeln('detect swipe failed: ' +
                //    'delta time = ' + IntToStr(
                //    (Abs(GetTickCount
                //    - Time_mouse_down))) +
                //    ', dX=' + IntToStr(P.X - Mouse_down_pos.X) +
                //    ', dY=' + IntToStr(P.Y - Mouse_down_pos.Y));
                //;
    		end;
    		if (Detected_swipe_X <> 0) or (Detected_swipe_Y <> 0) then
    		begin
    			handle_swipe_move(P);
    			Exit;
    		end;
    	end;
    {$ENDIF}

	{$IFDEF LINUX}
		P := Mouse.CursorPos;
	    P := ScreenToClient(P);
	    Mouse_point.f_X := Pixels(P.X);
	    Mouse_point.f_Y := Pixels(P.Y);
	{$ELSE}
    	Prepare_mouse_point_button(Self, 
     		 mbLeft, FALSE, F, Shift);
	{$ENDIF}
	
//?{Control}.mouse_move
	if is_control_mouse_event then
	begin
		C := Sender as TControl;
		R := ref_obj_from_control(C);
		
	 	if R <> nil then
	 	begin    
		    CC := C_Control(R.Obj);
		    CC.F_stop_handling := false;
		    
			operation_started(10, F, R);
			try
				try
			    CC.M_mouse_move;
			    except //on EStop: Stop_exception do;
			    	on Ex: Exception do
				    begin
				   		 if Ex is AL4_Exception then raise;
				    end
			    end;
			finally
		    operation_ended(10, F);
		    end;
		    stop_handling := CC.F_stop_handling;
	    end;
    end;
//.

//?{Form}.mouse_move
	if not stop_handling then
    begin
    	R := nil;
    	CC := nil;
    	if is_control_mouse_event then
    	begin
    		C := Sender as TControl;
    		R := ref_obj_from_control(C);
    		if R <> nil then
    		begin
		    	CC := C_Control(R.Obj);
    		end;
    	end;
	
		operation_started(10, F, R);
		try
			try
		    F.M_mouse_move;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
		finally
	    operation_ended(10, F);
	    end;
    end;
//.
end;

var Shift_on_click: TShiftState;

{$IFDEF SIMULATE_LONG_TAP_RMB}
procedure Create_long_tap_timer(F: TAL4Form);
begin
   Timer_long_tap := TTimer.Create(nil);
   Timer_long_tap.Interval := 800;
   Timer_long_tap.OnTimer := F.Form_long_tap;
end;
{$ENDIF}

{$IFDEF SWIPE_FORMS}
var Mouse_down_timer_control: TControl;
	param_Button: TMouseButton;
	param_Shift: TShiftState;
	param_X, param_Y:  Integer ;
{$ENDIF}

procedure TAL4Form.Control_mouse_down(
    Sender: TObject; Button: TMouseButton; Shift: TShiftState;
    X, Y:  Integer );
begin
    //writeln('Control.mouse.down');
    //!!!!!!!!!!!!!!!!!!!!	
    is_control_mouse_event := true;
	try
		Form_mouse_down(Sender, Button, Shift, X, Y);
	finally
		is_control_mouse_event := false;
	end;
end;

var double_click_on_mouse_down: Boolean;

procedure TAL4Form.Form_mouse_down(
	Sender: TObject; Button: TMouseButton; Shift: TShiftState; 
  	X, Y:  Integer );
var F: C_Form;
	C: TControl;
    R: Ref_obj;
    CC: C_Control;
    stop_handling: Boolean;
	
begin
    //writeln('Form.mouse.down');
    //!!!!!!!!!!!!!!!!!!!!	
    
    stop_handling := FALSE;
	R := nil;
	CC := nil;
	if is_control_mouse_event then
	begin
    	C := Sender as TControl;
    	Control_where_mouse_is_down := C;
    	R := ref_obj_from_control(C);
    	CC := C_Control(R.Obj);
	end
		else
		C := nil;
    
    F := C_Form(AL4Object.Obj);
    //******************************
    //writeln('fmd+');
    if F.F_level_event > 1 then Exit;
    //writeln('fmd-');
    //******************************
    
    {$IFDEF SWIPE_FORMS}
	 	
			GetCursorPos(Mouse_down_pos);
	 	
    {$ENDIF}
 	
    {$IFDEF SIMULATE_LONG_TAP_RMB}
    	Time_mouse_down :=  
    		{$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF};
    {$ENDIF}
    {$IFDEF SWIPE_FORMS}
    	Time_mouse_down :=  
    		{$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF};
    {$ENDIF}
    {$IFDEF SWIPE_FORMS}
        //if true then
        //    writeln('mouse down ' + FloatToStr(Mouse_down_pos.X) + ';' +
        //        FloatToStr(Mouse_down_pos.Y));
    	Detected_swipe_X := 0;
    	Detected_swipe_Y := 0;
    	if Mouse_down_timer = nil then
    	begin
    		Mouse_down_timer := TTimer.Create(nil);
    		Mouse_down_timer.Interval := 100;
    		Mouse_down_timer.OnTimer := Mouse_down_timer_tick;
    	end;
    	if not handling_click_by_mouse_timer then
    	begin
    		Mouse_down_timer_control := nil;
    		param_Button := Button;
    		param_Shift := Shift;
    		param_X := X;
    		param_Y := Y;
    		Mouse_down_timer.Enabled := true;
    		Exit;
    	end;
    {$ENDIF}
    
    Prepare_mouse_point_button(Self, Button, TRUE, F, Shift);
    
//?{Control}.mouse_down
	if is_control_mouse_event then
	begin
	    CC.F_stop_handling := false;
	    
		operation_started(11, F, R);
		try
			try
		    CC.M_mouse_down;
		 	except //on EStop: Stop_exception do;
		 		on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
		finally
	    operation_ended(11, F);
	    end;
	    stop_handling := CC.F_stop_handling;
    end;
//.
    
//?{Form}.mouse_down
	if not stop_handling then
	begin
	    Shift_on_click := Shift;
	    
	    operation_started(11, F, R);
	    try
		    try
		    F.M_mouse_down;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
	    finally
	    operation_ended(11, F);
	    end; 
	    
	    //Object_assign_hard(F.F_sender, NoneObj_C_Control);
    end;
//.
    
//?{Form}.mouse_double_click
	//{$IFDEF FPC}
    if double_click_on_mouse_down then
    begin
       double_click_on_mouse_down := false;
       do_Form_mouse_double_click(Sender);
    end;
    //{$ENDIF}
//.
end;

{$IFDEF SWIPE_FORMS}

procedure TAL4Form.Mouse_down_timer_tick(Sender: TObject);
begin
	// We go here only in case when swipe was not detected.
	// and just allow to handle mouse down even by the u7sual way.
	Mouse_down_timer.Enabled := false;
	if Application.Terminated then Exit;
	handling_click_by_mouse_timer := true;
	if Mouse_down_timer_control <> nil then
		Form_mouse_down(Mouse_down_timer_control,
			param_Button, param_Shift, param_X, param_Y)
	else Form_mouse_down(Self,
			param_Button, param_Shift, param_X, param_Y);
	handling_click_by_mouse_timer := false;
end;

{$ENDIF}



{$IFDEF SIMULATE_LONG_TAP_RMB}

procedure TAL4Form.Form_long_tap(Sender: TObject);
var F: C_Form;
	P: TPoint;
	
begin
	Timer_long_tap.Enabled := false;
	
    	GetCursorPos(P);
	
	if (Abs(Mouse_down_pos.X - P.X) > Points(3)) or
	   (Abs(Mouse_down_pos.Y - P.Y) > Points(3)) then Exit;
	F := C_Form(AL4Object.Obj);
	Ignore_click := true;
	
    //if true then
    //    writeln(IntToStr( GetTickCount) +
    //                ' [][][][][][][] pop up square ...........');
end;
{$ENDIF}

procedure TAL4Form.Control_mouse_up(
    Sender: TObject; Button: TMouseButton; Shift: TShiftState;
    X, Y:  Integer );
begin
    //writeln('Control.mouse.up');
    //!!!!!!!!!!!!!!!!!!!!	
    
    is_control_mouse_event := true;
	try
		Form_mouse_up(Sender, Button, Shift, X, Y);
	finally
		is_control_mouse_event := false;
	end;
end;

var last_time_dblclick: Integer;

procedure TAL4Form.Form_mouse_up(
	Sender: TObject; Button: TMouseButton; Shift: TShiftState; 
	X, Y:  Integer );
var F: C_Form;
	C: TControl;
    R: Ref_obj;
    CC: C_Control;
    stop_handling: Boolean;
begin
    //writeln('Form.mouse.up');
    //!!!!!!!!!!!!!!!!!!!!	
    
    R := nil;
	{$IFDEF SWIPE_FORMS}
	if (Detected_swipe_X <> 0) or (Detected_swipe_Y <> 0) then
	begin
		handle_swiped; 
		Exit;
	end;
	if (Mouse_down_timer <> nil) and Mouse_down_timer.Enabled then
	begin
		Mouse_down_timer.Enabled := false;
		handling_click_by_mouse_timer := true;
		Form_mouse_down(Sender, Button, Shift, X, Y);
		Form_clicked(Sender);
		handling_click_by_mouse_timer := false;
	end;
	{$ENDIF}
	
	{$IFDEF SIMULATE_LONG_TAP_RMB}
		if Timer_long_tap <> nil then
		   Timer_long_tap.Enabled := false;
		
        //if true then writeln(IntToStr(
        //                GetTickCount) + 'form mouse up: stop long tap timer!');
	{$ENDIF}
	
	stop_handling := FALSE;
    F := C_Form(AL4Object.Obj);
    if F = nil then Exit; // Free Pascal ???
    //******************************
    //writeln('fmu+' + IntToStr(F.F_level_event));
    if F.F_level_event > 1 then Exit;
    //writeln('fmu-');
    //******************************
    if is_control_mouse_event then
    begin
	    C := Sender as TControl;
	    R := ref_obj_from_control(C);
    end
    else C := nil;
    {$IFDEF SIMULATE_LONG_TAP_RMB}
    	if  {$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF} 
    		- Time_mouse_down > 800 then
    		Button :=  mbRight;
    {$ENDIF}
    Prepare_mouse_point_button(Self, Button, TRUE, F, Shift);
    
//?{Control}.mouse_up
	if is_control_mouse_event then
	begin
	    CC := C_Control(R.Obj);
	    CC.F_stop_handling := false;
	    
		operation_started(12, F, R);
		try
			try
		    CC.M_mouse_up;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
		finally
	    operation_ended(12, F);
	    end;
	    stop_handling := CC.F_stop_handling;
    end;
//.    

//?{Form}.mouse_up
    if not stop_handling then
    begin
		operation_started(12, F, R);
		try
			try
		    F.M_mouse_up;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
		finally
	    operation_ended(12, F);
	    end;
	end;
//.

    LastTimeMouseUp :=  
     {$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF};
    LastMouseUp.X := X;
    LastMouseUp.Y := Y;
    if is_control_mouse_event and
       (Button <>  mbLeft) then
       Control_clicked(Sender);
       
end;

procedure TAL4Form.Control_mouse_double_click(
	Sender: TObject);
begin
    //writeln('Control.mouse.DOUBLE-CLICK');
    //!!!!!!!!!!!!!!!!!!!!	
    
    is_control_mouse_event := true;
	try
		Form_mouse_double_click(Sender);
	finally
		is_control_mouse_event := false;
	end;
end;

procedure TAL4Form.Form_mouse_double_click(
	Sender: TObject);
begin
    //writeln('Form.mouse.DOUBLE-CLICK');
    //!!!!!!!!!!!!!!!!!!!!	
    
    {$IFDEF FPC}
	do_Form_mouse_double_click(Sender);
	{$ELSE}
	double_click_on_mouse_down := true;
	{$ENDIF}
end;

procedure TAL4Form.do_Form_mouse_double_click(
	Sender: TObject);
var F: C_Form;
	C: TControl;
    R: Ref_obj;
    stop_handling: Boolean;
//?{Control}.mouse_double_click
    CC: C_Control;
//.
begin
	{$IFDEF SWIPE_FORMS}
	if (Detected_swipe_X <> 0) or (Detected_swipe_Y <> 0) then Exit;
	{$ENDIF}

	stop_handling := FALSE;
	R := nil;
	if is_control_mouse_event then
	begin
	    C := Sender as TControl;
	    R := ref_obj_from_control(C);
	end;
	
    F := C_Form(AL4Object.Obj);
    //******************************
    //writeln('fmdc+');
    if F.F_level_event > 2 then Exit;
    					 // 2 instead of 1, otherwise double-click does not work
    					 // in Linux !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    //writeln('fmdc-');
    //******************************
    Prepare_mouse_point_button(
    	Self,  mbLeft, 
    	FALSE, F, Shift_on_click);
    	
//?{Control}.mouse_double_click
	if is_control_mouse_event then
	begin
	    CC := C_Control(R.Obj);
	    CC.F_stop_handling := false;
	    
		operation_started(13, F, R);
		try
			try
		    CC.M_mouse_double_click;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
		finally
	    operation_ended(13, F);
	    end;
	    stop_handling := CC.F_stop_handling;
    end;
//.
    	
//?{Form}.mouse_double_click
	if not stop_handling then
	begin

	    operation_started(13, F, R);
	    try
		    try
		    F.M_mouse_double_click;
		    last_time_dblclick := 
		    	{$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF};
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
	    finally
	    operation_ended(13, F);
		end;
    end; 
//.
end;

{$IFnDEF FPC}
procedure TAL4Form.Column_resize(Sender: TObject);
var Col: TAL4Column;
begin
	if not(Sender is TAL4Column) then Exit;
	Col := TAL4Column(Sender);
	/////////////////////////////////////////////////////
    //writeln('adjust controls for column: ' + Col.Alias);
    //if Col.Alias = 'COL_2' then
    //begin
    //    asm nop end;
    //end;
	//////////////////////////////////
	Adjust_control_location(Col, nil);
end;
{$ENDIF}

var Total_wheel_delta: Integer;

procedure TAL4Form.Form_mouse_wheel(
	Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
	 MousePos: TPoint; 
  	var Handled: Boolean);
//?{Form}.mouse_wheel
var F: C_Form;
    C: TControl;
    R: Ref_obj;
    CC: C_Control;
//.
begin
//?{Form}.mouse_wheel
	inc(Total_wheel_delta, WheelDelta);
	{$IFnDEF FPC}
    if Abs( {$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF} 
    		- Last_time_wheel) <= 1 then begin
    	Exit;
    end;
    Last_time_wheel :=  {$IFDEF FPC} GetTickCount64 {$ELSE} GetTickCount {$ENDIF};
    {$ENDIF}
    
    F := C_Form(AL4Object.Obj);
    R := nil;
    Prepare_mouse_point_button(
    	Self,  mbLeft, FALSE, F, Shift);
    WheelDelta := Total_wheel_delta;
    Total_wheel_delta := 0;
    Mouse_wheel_vertical := WheelDelta / 2
    	/ {$IFDEF LINUX} 514.0 {$ELSE} 240.0 {$ENDIF}; 
    
    C := ActiveControl;
    
    
    CC := nil;
    if  C <> nil then
    begin
    	R := ref_obj_from_control(C);
        if R <> nil then
        begin
	        CC := C_Control(R.Obj);
	        CC.F_stop_handling := false;
	        
			operation_started(14, F, R);
			try
				try
		        CC.M_mouse_wheel;
			    except //on EStop: Stop_exception do;
			    	on Ex: Exception do
				    begin
				   		 if Ex is AL4_Exception then raise;
				    end
			    end;
			finally
		    operation_ended(14, F);
		    end;
        end;
    end;
    
	operation_started(14, F, R);
	try
		try
	    Handled := F.M_mouse_wheel;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(14, F);
    end;

//.
end;

var Shift_key_down: TShiftState;

procedure TAL4Form.Control_key_down(
	Sender: TObject; var Key: Word;
	Shift: TShiftState);
//?{Form}.key_down
var F: C_Form;
    C: TControl;
    R: Ref_obj;
//.
begin
	//writeln('Control_key_down' + IntToHex(Key, 2));
//?{Form}.key_down
    F := C_Form(AL4Object.Obj);
    //******************************
    
    //writeln('ckd+');
    
    if key_pressing then Exit;
	key_pressing := true;
    try
    //writeln('ckd-');
    //******************************
    C := Sender as TControl;
    R := ref_obj_from_control(C);
    prepare_info(Key, F, Shift);
    Shift_key_down := Shift;

	operation_started(15, F, R);
	try
		try
		    if F.M_key_down = 0 then
		    begin 
		    	//Key := 0; //if not commented typing does not work in standrard Edit controls
		    	if St_key_info__C_Form(F.F_Key.Obj).f_Ignore then
		    	   Key := 0;
		    end;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end 
	    end;
	finally
    operation_ended(15, F);
    end;
    
    finally
    	key_pressing := false;
    end;
//.
end;

procedure TAL4Form.Form_key_down(
	Sender: TObject; var Key: Word; 
	Shift: TShiftState);
//?{Form}.key_down
var F: C_Form;
//.
begin
	//writeln('Form_key_down' + IntToHex(Key, 2));
	if (ActiveControl <> nil) and not (ActiveControl is TAL4Column) then Exit;
{$IFDEF SPB_KEYBOARD_LINUX}
	if Assigned(Control_redirect_keys) then begin
	   Control_key_down(Control_redirect_keys, Key, Shift);
   //writeln('SPB key down: ' + IntToStr(Key));
   		//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
       if Key in [VK_UP, VK_LEFT, VK_RIGHT, VK_DOWN, VK_TAB, VK_HOME, VK_END,
           {VK_PAGEUP} 34, {VK_PAGEDOWN} 33] then
           Key := 0;
	   Exit;
	end;
{$ENDIF}
//?{Form}.key_down
    F := C_Form(AL4Object.Obj);
    //******************************
    //writeln('fkd+');
    if F.F_level_event > 1 then begin
    	Key := 0; 
    	Exit;
    end;
    //writeln('fkd-');
    //******************************
    prepare_info(Key, F, Shift);
    Shift_key_down := Shift;

	operation_started(15, F, nil);
	try
		try
		    if F.M_key_down = 0 then 
		    begin
		        if St_key_info__C_Form(F.F_Key.Obj).f_Ignore then
		           Key := 0;
		    end;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(15, F);
    end;
//.	
end;

procedure TAL4Form.Control_key_up(
	Sender: TObject; var Key: Word; 
	
	Shift: TShiftState);

var F: C_Form;
    C: TControl;
    CC: C_Control;
    R: Ref_obj;
    
    {$IFDEF FPC}
var ch: TUTF8Char;
    {$ENDIF}
    
begin
    F := C_Form(AL4Object.Obj);
	//writeln('Control_key_up '+IntToHex(Key,2)+' l:'+IntToStr(F.F_level_event));
    //******************************
    //writeln('cku+');
    if F.F_level_event > 1 then begin
    	Key := 0; 
    	Exit;
    end;
    //writeln('cku-');
    //******************************
    C := Sender as TControl;
    prepare_info(Key, F, Shift);
    R := ref_obj_from_control(C);
    CC := C_Control(R.Obj);
        
	operation_started(16, F, R);
	try
		try
		     if F.M_key_up = 0 then  
		    begin
			    {$IFDEF FPC}
			    if  (Key = 9) {$IFNDEF LINUX} or (Key = 8) {$ENDIF}
			        then
			    begin
			    	ch := Char(Key);
			    	Control_key_press(Sender, ch);
			    end;
			    {$ENDIF}
			    Key := 0;
		    end;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(16, F);
    end;
end;

procedure TAL4Form.Form_key_up(
	Sender: TObject; var Key: Word; 
	 
	Shift: TShiftState);
{$IFDEF SPB_KEYBOARD_LINUX}
var C: {$IFDEF FPC} TUTF8Char {$ELSE} Char {$ENDIF};
{$ENDIF}	

var F: C_Form;

begin
if (ActiveControl <> nil) and not (ActiveControl is TAL4Column) then Exit;
//writeln('Form_key_up' + IntToHex(Key, 2));
{$IFDEF SPB_KEYBOARD_LINUX}
	if Assigned(Control_redirect_keys) then
	begin
		Control_key_up(Control_redirect_keys, Key, Shift);
		if Key = VK_TAB then
		begin
			C := #9;
			Control_key_press(Control_redirect_keys, C);
		end;
	//writeln('key up  : ' + IntToStr(Key));
		//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
        //if Key in [VK_UP, VK_LEFT, VK_RIGHT, VK_DOWN, VK_TAB, VK_HOME, VK_END,
        //    {VK_PAGEUP} 34, {VK_PAGEDOWN} 33] then
        //    Key := 0;
		Exit;
	end;
{$ENDIF}	

    F := C_Form(AL4Object.Obj);
    prepare_info(Key, F, Shift);

	operation_started(16, F, nil);
	try
		try
		    if F.M_key_up = 0 then 
		    	Key := 0;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(16, F);
	end;
end;

{$IFDef FPC}
function TAl4Form.default_cancel_button(F: C_Form; Key: TUTF8Char): Boolean;
var Cklik: TControl;
	Cbutton: C_Button;
begin
	Result := false;
	Cbutton := nil;
    if (Shortint(Key[1]) = VK_RETURN) 
    	and not C_Button(F.F_Default_button.Obj).Is_none_object then
    begin
    	if (ActiveControl is TMemo) and not TMemo(ActiveControl).ReadOnly
    	then Exit;
    	Cbutton := C_Button(F.F_Default_button.Obj); 
    end else
    if (Shortint(Key[1]) = VK_ESCAPE) 
    	and not C_Button(F.F_Cancel_button.Obj).Is_none_object then
    begin
    	Cbutton := C_Button(F.F_Cancel_button.Obj); 
    end;
    if Cbutton = nil then Exit;
    Cklik := TButton(All_controls[Cbutton.F_Handle]);
    if (Cklik <> nil) and Cbutton.M_Visible and Cklik.Enabled then
    begin
    	Control_clicked(Cklik);
    	Result := true;
    end;
end;
{$ENDIF}

procedure TAL4Form.Control_key_press(
	{$IFDEF FPC}
	Sender: TObject; var Key: TUTF8Char
	{$ELSE}
	Sender: TObject; var Key: Char
	{$ENDIF}
	);
var F: C_Form;
    C: TControl;
    E: C_Edit;
    R: Ref_obj;
    s: String;
//?{Form}.key_press
//.
begin
//writeln('Control key pressed: ' + Key);
    F := C_Form(AL4Object.Obj);
    //******************************
    //if F.F_level_event > 1 then begin
    //    Key := #0;
    //    Exit;
    //end;
    {$IFDEF FPC}
    if default_cancel_button(F, Key) then
    begin
    	Key := #0;
    	Exit;
    end;
    {$ENDIF}
    //******************************
    C := Sender as TControl;
    R := ref_obj_from_control(C);
    prepare_info_press(Key, F, Shift_key_down);
    
    if (C is TEdit) then
    begin
    	E := C_Edit(R.Obj);
    	s :=  E.F_options {$IFDEF FPC}.Value{$ENDIF};
    	if (pos('N', s) > 0) then
	    	if pos(Key, '0123456789.,+-'#8) <= 0 then
	    		Key := #0;
    end;

//?{Form}.key_press
    operation_started(17, F, R);
    try
	    try
		    if F.M_key_press = 0 then 
		    	//Key := #0 -- prevents type in edit controls !!!
		    ;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
    finally
    operation_ended(17, F);
    end;
//.
end;

{$IFDEF FPC}


procedure TAL4Form.Form_UTF8key_press(
	Sender: TObject; var Key: TUTF8Char);
{$ELSE}

procedure TAL4Form.Form_key_press(
	Sender: TObject; var Key: Char);
{$ENDIF}
//?{Form}.key_press
var F: C_Form;
//.
begin
if (ActiveControl <> nil) and not (ActiveControl is TAL4Column) then Exit;
//writeln('Form key pressed: ' + Key);
{$IFDEF SPB_KEYBOARD_LINUX}
	if Assigned(Control_redirect_keys) then 
	begin
		Control_key_press(Control_redirect_keys, Key);
		Key := #0;
		Exit;
	end;
{$ENDIF}	
//?{Form}.key_press
	    F := C_Form(AL4Object.Obj);
	    //******************************
        //if F.F_level_event > 1 then begin
        //    Key := #0;
        //    Exit;
        //end;
	    {$IFDEF FPC}
	    if default_cancel_button(F, Key) then
	    begin
	    	Key := #0;
	    	Exit;
	    end;
	    {$ENDIF}
	    //******************************
	    prepare_info_press(Key, F, Shift_key_down);
	
	    operation_started(17, F, nil);
	    try
		    try
		    if F.M_key_press = 0 then
		    	//Key := #0 -- prevents typing in edit controls
		    ;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
	    finally
	    operation_ended(17, F);
	    end;
//.
end;

//?{Form}.accept

{$IFDEF FPC}
procedure TAL4Form.Form_DropFiles(Sender: TObject; 
	const FileNames: array of String);
var F: C_Form;
	a: DynAStr;
	j: Integer;
begin
	a := New_DynAStr;
	a.Add(MAXINT, ParamStr(0));
	
    for j := 0 to High(FileNames) do
    begin
      a.Add(MAXINT, FileNames[j]);
    end;
      
	unitC_System_functions.M_Set_parameters(a);
	a.Free;
	
	F := C_Form(Self.AL4Object.Obj);
    
	operation_started(26, F, nil);
	try
		if F.M_accept then
    		F.M_command;
    finally
    	operation_ended(26, F);
    end;
end;

{$ELSE}


procedure TAL4Form.WMDropFiles(var DropMsg: TWMDropFiles);
var F: C_Form;
	a: DynAStr;
	j, N: Integer;
	Pt: TPoint;
	Buf: array[ 0..MAX_PATH ] of Char;
	hDrop: THandle;
begin
    inherited;
	a := New_DynAStr;
	a.Add(MAXINT, ParamStr(0));
	
	hDrop := DropMsg.Drop;
	DropMsg.Result := 0;
	try
      DragQueryPoint( hDrop, Pt );
      N := DragQueryFile( hDrop, $FFFFffff, nil, 0 );
      for j := 0 to N-1 do
      begin
        DragQueryFile( hDrop, j, Buf, Sizeof( Buf ) );
        a.Add(MAXINT, Buf);
      end;
	finally
      DragFinish( hDrop );
	end;
      
	unitC_System_functions.M_Set_parameters(a);
	a.Free;
	
	Mouse_point.f_X := Pixels(Pt.X);
    Mouse_point.f_Y := Pixels(Pt.Y);
	
	F := C_Form(Self.AL4Object.Obj);
    
	operation_started(26, F, nil);
	try
		if F.M_accept then
    		F.M_command;
    finally
    	operation_ended(26, F);
    end;
end;
{$ENDIF}


//
procedure TAL4Form.CreateWnd;
begin
	inherited;
	//if not drag_accepted then
	begin
		{$IFDEF FPC}
		AllowDropFiles := true;
		OnDropFiles := @Self.Form_DropFiles;
		{$ELSE}
		//drag_accepted := true;
		DragAcceptFiles( Handle, true);
		{$ENDIF}
	end;
end;


//.

{$IFnDEF LINUX}


var slot: THandle;

procedure TAL4Form.WndProc(var Message: TMessage);
var Buf : array[0..MAX_PATH] of Char;
	F: C_Form;
	s: String;
	ss: DynAStr;
	len, k, i: Integer;
	ready: DWORD;
	MS: TMemoryStream;
begin
////{--}write(IntToStr(Message.Msg) + ' ');
	{$IFDEF FPC}
	case Message.Msg of
	WM_SIZE: 
		begin
			//writeln('form resized!');
			Form_resized(nil);
		end;
	WM_MOVE: 
		begin
			//writeln('form moved!');
			Form_moved(nil);
		end;
	end;
	{$ENDIF}

	if can_handle_another_instance_notify then
	begin
		if slot = 0 then
		begin
			slot := CreateMailSlot(
				PChar('\\.\mailslot\' + Unique_id),
				0,
				MAILSLOT_WAIT_FOREVER,
				nil);
		end;
	    case Message.Msg of
	    WM_CLOSE, WM_NCDESTROY:
         	begin
		        if LongBool(first_inst_mutex) then
		        begin
		          CloseHandle( first_inst_mutex );
		          first_inst_mutex := 0;
		          CloseHandle(slot);
		        end;
	        end;
	    end;
	    if (Message.Msg = registered_msg) and
	       (slot <> INVALID_HANDLE_VALUE) then
    	begin
	        ss := New_DynAStr();
	        k := 0;
	        MS := TMemoryStream.Create;
	        MS.SetSize(4096);
	        ReadFile(slot, MS.Memory^, MS.Size, ready, nil);
	        MS.SetSize(ready);
	        MS.Read(k, Sizeof(Integer));
	        for i := 1 to k do
	        begin
	        	len := 0;
				MS.Read(len, Sizeof(Integer));
				SetLength(s, len);
				MS.Read(PChar(s)^, len);
				ss.Add(MAXINT, s);        	
	        end;
	        MS.Free;
	        unitC_System_functions.M_Set_parameters(ss);
	        ss.Free;
	        
	        F := C_Form(AL4Object.Obj);
	        operation_started(15, F, nil);
		    try
		    F.M_command;
		    finally
		    operation_ended(15, F);
		    end;
        	Message.Result := 0;
        	Exit;
        end;
	end;
	inherited;
end;

{$ENDIF}

procedure TAL4Form.Form_timer_tick(
	Sender: TObject);
//?{Form}.timer
var F: C_Form;
    T: TTimer;
    TP: TTimerPanel;
    R: Ref_obj;
//.
begin
//?{Form}.timer
	 if not Enabled then Exit; 
	
    F := C_Form(AL4Object.Obj);
    T := Sender as TTimer;
    
    	TP := TTimerPanel(T.Tag);
    
    R := ref_obj_from_control(TP);

        
	operation_started(18, F, R);
	try
		try
			if not Application.Terminated then
		       F.M_timer;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(18, F);
    end;
//.
end;

// Form constructor

constructor TAL4Form.CreateNew(
	AOwner: TComponent; 
	Dummy:  Integer  = 0);
begin
	inherited;
	
  Hidden := FALSE;
  Columns := TList  .Create;
  {$IFDEF USE_LISTS_OF_DESCRIPTORS}
  	if Column_descr = nil then
  	begin
  		Column_descr := TList  .Create;
  		Column_descr.Add(nil);
  	end; 
  {$ENDIF}


   OnClick := {$IFDEF OBJFPC}@{$ENDIF} Form_clicked; 

  {$IFNDEF MOBILE_SCREEN}
  OnCloseQuery := {$IFDEF OBJFPC}@{$ENDIF} Event_CloseQuery;
  OnClose := {$IFDEF OBJFPC}@{$ENDIF} Event_Close;
  OnDestroy := {$IFDEF OBJFPC}@{$ENDIF} Event_OnDestroy;
  Position :=  poDefaultPosOnly ;
  {$ENDIF}
  			  
   BorderWidth := AL4_form.Points(2); 
  
end;

procedure TAL4Form.Set_active_control(C: TControl);
begin
	if C = nil then Exit;
	
		
			if C is TWinControl then
			   ActiveControl := TWinControl(C);
		
	
end;


// Form destructor

destructor TAL4Form.Destroy;
var F: C_Form;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	i, j: Integer;
	{$ENDIF}
begin
    if MenuPanel_to_destroy <> nil then
    begin
        MenuPanel_to_destroy.Free;
        MenuPanel_to_destroy := nil;
    end;
	
  if  (Columns <> nil) then
  begin                    
  	  {$IFDEF USE_LISTS_OF_DESCRIPTORS}
  	  for i := 0 to Columns.Count-1 do
  	  begin
  	  	  j := Column_descr.IndexOf(Columns[i]);
  	  	  if j >= 0 then Column_descr[j] := nil;
  	  end;	
  	  {$ENDIF}
  	  
      if ControlsHandlingNavigationKeys <> nil then
         FreeAndNil(TObject(ControlsHandlingNavigationKeys));
      if MenuPanel_to_destroy <> nil then
      begin
         MenuPanel_to_destroy.Free;
         MenuPanel_to_destroy := nil;
      end;
      F := C_Form(AL4Object.Obj);
      if F <> nil then
      begin
	      F.F_Handle := 0;
	      Columns.Clear;
	      FreeAndNil(TObject(Columns));
      end;
      {$IFDEF USE_LISTS_OF_DESCRIPTORS}
      i := All_forms.IndexOf(Self);
      if i >= 0 then All_forms[i] := nil;
      {$ENDIF}
      inherited;
  end;
end;

{$IFNDEF FPC}

procedure TAL4Form.DialogKey(var Msg: TWMKey);
var F: C_Form;
begin
	F := C_Form(AL4Object.Obj);
    //if St_key_info__C_Form(F.F_Key.Obj).f_Ignore then
    //begin
    //    Msg.Result := 0;
    //    Msg.CharCode := 0;
    //    Exit;
    //end;
    case Msg.CharCode of
      VK_DOWN, VK_UP, VK_RIGHT, VK_LEFT, VK_TAB:
      begin
        //if Assigned(OnNavigationKey) then
        //  if OnNavigationKey(Self, Msg.CharCode, KeyDataToShiftState(Msg.KeyData));
        {$IFNDEF MOBILE_SCREEN}
        if (ControlsHandlingNavigationKeys <> nil) and 
      	   (ControlsHandlingNavigationKeys.IndexOf(ActiveControl) >= 0) then
        begin
      	   inherited;
      	   Msg.Result := 0;
           Exit;
        end
        else
        {$ENDIF} 
        begin
      	  Msg.Result := 0;
      	  inherited;
        end;
      end
      else
        inherited
    end;
end;

{$ENDIF}

function TAL4Form.Get_current_column_handle: Integer;
var X_F: C_Form;
begin
    if (HCurrent_column_handle = 0) then
    begin
       X_F := C_Form(AL4Object.Obj);
       X_F.M_initial_column;
    end;
    Result := HCurrent_column_handle;
end;

function TAL4Form.Get_current_column: TAL4Column;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Result := TAL4Column(Column_descr[Get_current_column_handle]);
	{$ELSE}
		Result := TAL4Column(Get_current_column_handle);
	{$ENDIF}
end;



{$IFnDEF LINUX}

procedure TAL4Form.WMQueryEndSession(var M: TMessage);
begin
	queried_end_session := TRUE;
	inherited;
end;

{$ENDIF}

	// Event: form close query
procedure TAL4Form.Event_CloseQuery(Sender: TObject;
  var CanClose: Boolean);
var F: C_Form;
begin
	//{debug}writeln('closing!');
	if ignore_close_event then Exit;   
    CanClose := true;
	F := C_Form( AL4Object.Obj );
//?{Form}.closing

	//{$IFDef FPC}
	    {$IFNDEF MOBILE_SCREEN}
	    if F.M_Modal then
	        if ModalResult <> 0 then Exit;
	    {$ENDIF}
    //{$ENDIF}
    
    F.F_reason_closing := 1;
    {$IFDEF LINUX}
    {$ELSE}
	if queried_end_session then
		F.F_reason_closing := 2;
	queried_end_session := FALSE;
	{$ENDIF}
	
	operation_started(1, F, nil);
	try
		try
	   	CanClose := (F.M_closing and $FF) = 0;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(1, F);
    end; 
//.
	{$IFnDEF FPC}
		{$IFNDEF MOBILE_SCREEN}
    	if F.M_Modal then Exit;
    	{$ENDIF}
	{$ENDIF}
    
	if CanClose then
	begin
		F.F_Closed := true;
	end;
    //if true then
    //	Writeln('---------------------------- CLOSING -----------------------');
end;

// Event: Form close
procedure TAL4Form.Event_Close(Sender: TObject; var AAction: TCloseAction);
var F, P: C_Form;
begin
	if ignore_close_event then Exit;
	//Action := caFree;
	//	if true then
		//Writeln('----------------------------- EVENT CLOSE --------------------');

	F := C_Form( AL4Object.Obj );
	{$IFNDEF MOBILE_SCREEN}
    if F.M_Modal then
    begin
        if ModalResult <> 0 then 
        begin
       		P := C_Form(F.F_parent_form_.Obj);
       		if P.F_current_modal_dialog_.Obj = F then
       			Object_assign_weak(P.F_current_modal_dialog_, NoneObj_C_Form); 	
            AAction :=  caHide;
            		//writeln('Event_Close --> caHide');
        	//if Application.MainForm <> Self then Exit;
        	if not F.M_Is_main_form then Exit;
        end
    end;
    {$ENDIF}
    
    OnActivate := nil; // fixing Lazarus
    
//?{Form}.closed
	operation_started(2, F, nil);
	try
	//if true then writeln('before M_closed');
	F.M_closed;
	finally
	operation_ended(2, F);
	end;
//.
	
	AAction :=  caFree;
	FormClosed;
	F.F_Handle := 0;
	//if true then
	//	Writeln('----------------------------- FORM CLOSED -------------------' +
	//	', Action=' + IntToStr(Integer(Action)));
end;

// Event: form is destroying
procedure TAL4Form.Event_OnDestroy(Sender: TObject);
var F: C_Form;
    S: C_Screen;
begin
	//if true then
	//	Writeln('----------------------------- ON DESTROY --------------------');
	{$IFNDEF MOBILE_SCREEN}
    OnDestroy := nil;
    {$ENDIF}
    //C_Form( AL4Object.Obj ).DESTRUCT;
    if not(AL4Object.Obj is C_Form) then Exit;
    F := C_Form( AL4Object.Obj );
    if F = nil then Exit;
    F.F_Handle := 0;
    try
    S := C_Screen( F.F_Screen_.Obj );
    S.M_Form_destroyed( AL4Object);
    except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    end;
	//if true then
	//	Writeln('----------------------------- FORM DESTROYED ---------------');
end;

{$IFnDEF LINUX}

procedure THackButton.CMTextChanged(var Msg: TMessage);
begin
    Width := 8 + AL4_form.Points(6) * Length(Text);
end;

{$ENDIF}

{ TTrayPanel }

procedure TTrayPanel.HandleTrayMessage(Button: TMouseButton; Shift: TShiftState);
//?{Form}.click
var CF: C_Form;
    R: Ref_obj;
//.
begin
//?{Form}.click
    
    CF := C_Form(Form.AL4Object.Obj);
    Prepare_mouse_point_button(Form, Button, TRUE, CF, Shift);
    
    R := ref_obj_from_control(Self);

    operation_started(0, CF, R);
    try
	    try
	    CF.M_click;    
	    except //on EStop: Stop_exception do
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
    finally
    operation_ended(0, CF);
    end;
//.
end;

constructor TTrayPanel.Create(AOwner: TComponent);
begin
	inherited Create(AOwner);
	{$IFDEF FPC}
	ti := TTrayIcon.Create(Self);
	{$ENDIF}
end;

{$IFDEF FPC}

function TTrayPanel.Active: Boolean;
begin
	Result := (ti <> nil) and ti.Visible;
end;
{$ENDIF}

destructor TTrayPanel.Destroy;
begin

	{$IFDEF FPC}
		FreeAndNil(TObject(ti));
	{$ELSE}
	  if Active then
	     Nim_operation(Form.Handle, ID, 'd', 0 {IconObject.Handle}, tp_Text);
	  Active := false;
	{$ENDIF}

  inherited;
end;

{$IFnDEF LINUX}

var last_tray_id: Integer;
	last_tray_text: String;
	last_tray_wnd: HWnd;
	last_tray_ico: HIcon;

procedure Nim_operation(Wnd: HWND; ID: Integer; op: Char; Icon: HIcon;
    const Text: String);
Var Nim:{$IFDEF FPC} TNotifyIconDataA {$ELSE} TNotifyIconData {$ENDIF};
begin
   if (op = 'c') then
   begin 
	 if (last_tray_id = ID) and (last_tray_wnd = Wnd) and (last_tray_text = Text)
	 and (last_tray_ico = Icon)
	 then Exit;
   end;
   if (op = 'c') or (op = 'a') then
   begin
	 last_tray_text := Text;
	 last_tray_wnd := Wnd;
	 last_tray_id := ID;
	 last_tray_ico := Icon;
   end;
	
   Nim.cbSize := SizeOf(Nim);
   {$IFDEF FPC}
   Nim.hWnd := Wnd;
   {$ELSE}
   Nim.Wnd := Wnd;
   {$ENDIF}
   Nim.uID := ID;
   Nim.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
   Nim.hicon := Icon;
   Nim.uCallbackMessage := wm_user+ID;
   StrLCopy(Nim.szTip, PChar(Text), Sizeof(Nim.szTip)-1);
   Case op OF
      'a': {$IFDEF FPC} Shell_NotifyIconA {$ELSE} Shell_NotifyIcon {$ENDIF}
      		(Nim_Add,@Nim);
      'c': {$IFDEF FPC} Shell_NotifyIconA {$ELSE} Shell_NotifyIcon {$ENDIF}
      		(Nim_Modify,@Nim);
      'd': {$IFDEF FPC} Shell_NotifyIconA {$ELSE} Shell_NotifyIcon {$ENDIF}
      		(Nim_Delete,@Nim);
   End;
end;

{$ENDIF}


procedure TAL4Form.DefaultHandler(var Message);
var i: Integer;
	Button: TMouseButton;
	Shift: TShiftState;
begin
    {$IFDEF FPC}
    {$ELSE}
    if (TMessage(Message).Msg >= WM_USER+1) and 
       (TMessage(Message).Msg < WM_USER+1000) and 
       (TrayIcons <> nil) then
    begin
        for i := 0 to TrayIcons.Count-1 do
            if DWORD(TTrayPanel(TrayIcons[i]).ID + WM_USER) = 
                TMessage(Message).Msg then
            begin
            	Button :=  mbLeft;
                case TMessage(Message).lParam of
                WM_LBUTTONUP: ;//Button := TMouseButton.mbLeft;
                WM_RBUTTONUP: Button :=  mbRight;
                WM_MBUTTONUP: Button :=  mbMiddle;
                else Exit;
                end;
                Shift := [];
                if GetKeyState(
                    VK_SHIFT ) < 0 then
                   include(Shift, ssShift);
                if GetKeyState(
                    VK_CONTROL ) < 0 then 
                   include(Shift, ssCtrl);
                if GetKeyState(
                    VK_MENU ) < 0 then
                   include(Shift, ssAlt); 
                TTrayPanel(TrayIcons[i]).HandleTrayMessage(Button, Shift);
            end;
    end;
    {$ENDIF}
    inherited;
end;



{ TMenuPanel }

// Destroy MenuPanel together with its lists
destructor TMenuPanel.Destroy;
begin
    //DEBUG:
	//Writeln('Destroying Popup menu panel');
	
  if mp_destroying then Exit;
  mp_destroying := TRUE;
  FreeAndNil(TObject(MenuObject));
  AllItemsList.Free;
  AliasesList.Free;
  inherited;
end;

// when item clicked, selected Alias is stored and flag "Selected" becomes TRUE
procedure TMenuPanel.Item_click(Sender: TObject);
//?{Form}.menu_item
var i: Integer;
    F: C_Form;
//.
begin
//?{Form}.menu_item
	
    	if  not(Sender is TMenuItem) then Exit;
    	i := TMenuItem(Sender).Tag;
	
    Ready := TRUE;
    F := C_Form(Form_.AL4Object.Obj);
    Alias := AliasesList[i];
    
	operation_started(20, F, nil);
    {$IFDEF FPC} F.F_menu_alias.Assign_string(Alias); 
    {$ELSE} F.F_menu_alias := Alias;
    {$ENDIF} 
	try
		try
	    F.M_menu_item;
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	    end;
    finally
	    {$IFDEF FPC} F.F_menu_alias.Assign_string(''); 
	    {$ELSE} F.F_menu_alias := '';
	    {$ENDIF} 
    operation_ended(20, F);
    end;
    
    //Form_.MenuPanel_to_destroy.Free;
    //Form_.MenuPanel_to_destroy := nil;
//.
end;

// ----- does not work

{ TTimerPanel }

destructor TTimerPanel.Destroy;
//?{Timer}
var X_L: Ref_obj;
//.
begin
//?{Timer}
	X_L := ref_obj_from_control(Self);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS} if X_L = nil then Exit; {$ENDIF}
	if (X_L <> nil) and (X_L.Obj <> nil) then
	begin
		C_Timer(X_L.Obj).F_Handle := 0;
	end;
	FreeAndNil(TObject(TimerObject));
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
//.
  	inherited;
end;


procedure TAL4Form.DestroyWnd;
begin
    //FormClosed; -- in VCL, it is called on form's window recreate
    //(even on form resize. In result, can not call FormClosed once
    //more time at the real form close event).
    inherited;
end;


procedure TAL4Form.FormClosed;
var i: Integer;
var AAction: TCloseAction;
begin
	if Called_FormClosed then Exit;
	Called_FormClosed := true;
    if TrayIcons <> nil then
    begin
        for i := TrayIcons.Count-1 downto 0 do
        begin
            (TObject(TrayIcons[i])).Free;
            TrayIcons[i] := nil;
        end;
        FreeAndNil(TObject(TrayIcons));
    end;

    if Control_timers <> nil then
    begin
        for i := Control_timers.Count-1 downto 0 do
            TAnimation_timer(Control_timers[i]).Stop_timer;
        FreeAndNil(TObject(Control_timers));
    end;
    
    
   
	//if true then
	//	Writeln('----------------------------- FormClosed --------------------'+
	//	'Self=' + IntToStr(Integer(Self)) + ', Main_form_index=' +
	//	IntToStr(Main_form_index));

    if Self = form_from_handle(Main_form_index) then
    begin
        Application.Terminate;
    end;
    OnResize := nil;
	OnMouseMove := nil;
    OnMouseDown := nil;
    OnMouseUp := nil;
     OnDblClick := nil; 
    OnMouseWheel := nil;
    
	OnKeyDown := nil;
	OnKeyUp := nil;
	
		{$IFDEF FPC}
		OnUTF8KeyPress := nil;
		{$ELSE}
		OnKeyPress := nil;
		{$ENDIF}
	
	{$IFNDEF MOBILE_SCREEN}
     KeyPreview := TRUE; 
	OnDeactivate := nil;
	{$ENDIF}
end;      	

{$IFDEF FPC}
procedure TAL4Form.Form_shown(Sender: TObject);
{$ELSE}
procedure TAL4Form.Form_shown(var M: TMessage);
{$ENDIF}
var i: Integer;
    CF: C_Form;
    c: THackControl;
begin
	CF := C_Form(AL4Object.Obj);
	////////////////////////////////////////////////////////////////
    //writeln('FORM_SHOWN want_width=' + FloatToStr(CF.F_want_width) +
    //' height=' + FloatToStr(CF.F_want_height) );
	////////////////////////////////////////////////////////////////
	if ignore_resize then Exit; //???????????????????????????????????????????
	{$IFDEF FPC}
	{$ELSE}
		if M.WParam = 0 then Exit;
  	{$ENDIF}	             
	was_Shown := true;
	inherited;
	
	
	shown := TRUE;
	
	if (CF.F_want_width > 0) or (CF.F_want_height > 0) then
	begin
		/////////////////////////////////////////////////////////////////////
		//writeln('Usatnawka razmera formy w ' + FloatToStr(CF.F_want_width) +
		//' x ' + FloatToStr(CF.F_want_height));
		if CF.F_want_width > 0 then Width := Points(CF.F_want_width);
		if CF.F_want_height > 0 then Height := Points(CF.F_want_height);
	end;
	
	if Columns <> nil then
	begin
		inc(CF.F_suspended_count);
		try
		    for i := 0 to Columns.Count-1 do
		        Adjust_control_location(TAL4Column(Columns[i]), nil);
		finally
			dec(CF.F_suspended_count);
		end;
	end;
    
	operation_started(9, CF, nil);
	try
		try
	    CF.M_shown;    
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
	finally
    operation_ended(9, CF);
    end;
    
    if Controls_to_set_foreground_on_show <> nil then
    begin
    	FOR i := 0 TO Controls_to_set_foreground_on_show.Count-1 DO
    	begin
    		c := THackControl(Controls_to_set_foreground_on_show[i]);
    		c.Font.Color := Integer(Controls_foreground_on_show[i]);
    	end;
    	Controls_to_set_foreground_on_show.Free;
    	Controls_to_set_foreground_on_show:=nil;
    	Controls_foreground_on_show.Free;
    	Controls_foreground_on_show:=nil;
    end;
    
    {$IFDEF FPC}
    	{$IFDEF LINUX}
    		Form_resized(Sender);
    	{$ELSE}
    		//Perform(WM_SIZE, 0, 0);
    		PostMessage(Handle, WM_SIZE, 0, 0);
    	{$ENDIF}
    {$ELSE}
    	Form_resized(M);
    {$ENDIF}
end;

var handling_activation: Boolean;

{$IFDef FPC}
procedure TAL4Form.Form_activate(Sender: TObject);
{$ELSE}
procedure TAL4Form.Form_activate(var M: TWMActivate);
{$ENDIF}
var CF: C_Form;

var re: TRect;
begin
    inherited;
    {$IFDef FPC}
    {$ELSE}
    //if M.Active <> 0 then
    {$ENDIF}
    if not handling_activation then
    begin
        CF := C_Form(AL4Object.Obj);
    	handling_activation := true;
    ////////////////////////////////////////////////////////////
    GetWindowRect(Handle, re);
    {$IFDef FPC}
    {$ELSE}
    //if M.Active <> 0 then
    if M.Active <> 0 then
    {$ENDIF}
    if Visible and (WindowState = wsMinimized) then 
    begin
    	//writeln('try to fix it !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
    	WindowState := wsNormal;
    	GetWindowRect(Handle, re);
    end;
    //writeln('handling Form_activate --- ' + Caption +
    //' visible=' + IntToStr(Integer(IsWindowVisible(Handle))) +
    //' pos=' + IntToStr(re.Left) + ',' + IntToStr(re.Top) +
    //' size=' + IntToStr(re.Right - re.Left) + 'x' + IntToStr(re.Bottom-re.Top));
    ////////////////////////////////////////////////////////////
		operation_started(3, CF, nil);
		try
			try
	{$IFDef FPC}
    {$ELSE}
			if M.Active = 0 then
				CF.M_deactivated
			else 
    {$ENDIF}			
            	CF.M_activated;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
			    begin
			   		 if Ex is AL4_Exception then raise;
			    end
		    end;
		finally
        handling_activation := false;
	    operation_ended(3, CF);
	    end;
    end;
end;

{$IFDef FPC}
procedure TAL4Form.Form_deactivate(Sender: TObject);
var CF: C_Form;
begin
    inherited;
    if not handling_activation then
    begin
        CF := C_Form(AL4Object.Obj);
        
    	handling_activation := true;
    //writeln('handling Form_activate');
		operation_started(3, CF, nil);
		try
			try
            CF.M_deactivated;  
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
			    begin
			   		 if Ex is AL4_Exception then raise;
			    end
		    end;
		finally
        handling_activation := false;
	    operation_ended(3, CF);
	    end;
    end;
end;
{$ENDIF}

procedure do_begin_animation(X_H: Integer; X_Count: Integer; X_Interval: Integer);
var a: TAnimation_timer;
	i: Integer;
var C: THackControl;
	Form: TAL4Form;
begin
	C := HackControl(X_H);
	Form := TAL4Form(ParentColumn(C).Parent);
	if Form.Control_timers <> nil then
		for i := Form.Control_timers.Count - 1 downto 0 do
		begin
			a := TAnimation_timer(Form.Control_timers[i]);
			if a.Control_handle = X_H then
			begin
				a.Counter := 0;
				a.Last_counter := X_Count;
				a.Interval := X_Interval;
				Exit;
			end; 
		end;
	
	a := TAnimation_timer.Create(X_H, X_Count, X_Interval);
	a.Enabled := TRUE;
end;

constructor TAnimation_timer.Create(X_H, X_Count, X_Interval: Integer);
var C: THackControl;
begin
    inherited Create(nil);
    C := HackControl(X_H);
    Control_handle := X_H;
    Ref_control := ref_obj_from_control(C);
    Inc(Ref_control.Obj.hard_link.Count, 2);
    
    Form := TAL4Form(ParentColumn(C).Parent);
    if Form.Control_timers = nil then   
       Form.Control_timers := TList.Create;
    Form.Control_timers.Add(Self);
    
    Counter := 0;
    Last_counter := X_Count;
    Interval := X_Interval;
    OnTimer := {$IFDEF OBJFPC}@{$ENDIF} Tick_timer;
end;

procedure TAnimation_timer.Tick_timer(Sender: TObject);
var CC: C_Control;
	F: C_Form;
begin
    inc(Counter);
    if Counter >= Last_counter then Stop_timer;
    CC := C_Control(Ref_control.Obj);
    
    F := C_Form(Form.AL4Object.Obj);
    operation_started(19, F, Ref_control);
    try
	    try
	    CC.M_animation; //(Counter);
	    except //on EStop: Stop_exception do;
	    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
	    end;
    finally
    operation_ended(19, F);
    end;    
end;

procedure TAnimation_timer.Stop_timer;
var i: Integer;
begin
    Enabled := false;
    for i := Form.Control_timers.Count-1 downto 0 do
        if TAnimation_timer(Form.Control_timers[i]) = Self then
        begin
            Form.Control_timers.Delete(i);
            Ref_control.Ref_dec_hard();
            break;
        end;
end;

constructor TScreen_handler.Create(X_Screen: Ref_obj);
begin
	inherited Create;
	Ref_scr := X_Screen;
	inc(Ref_scr.Count, 2);
end;

(*
/*

FUN get_Last_time_activity ==> REAL, NATIVE, PUBLIC :
@	"	RESULT := Last_time_active;" .
        
FUN do_Last_time_set, NATIVE, PUBLIC : @
	"	Last_time_active := Now;" .
*/
*)

procedure TScreen_handler.Handler;
//?{Long_operation}
var F, L: C_Form;
	L_f: C_Long_operation;
	form, Lform: TAL4Form;
	dNow, diff: Double;
//.
begin
//?{Long_operation}
 	//if C_Long_operation.M_Continue_now then Exit;
	//Exit;
    dNow := Now;
    diff := (dNow - Last_time_active) * 24 * 3600 * 1000;
    if (diff < 100) then Exit;
    
    F := C_Form(C_Screen(Ref_scr.Obj).F_Form_operation_.Obj);
    L_f := C_Long_operation(C_Screen(F.F_Screen_.Obj).F_long_operation_internal.Obj);
    if F.F_Can_stop_long_operation then
    begin
	    if (diff > 2000) and (not F.Is_NONE_object) 
           //and
           //(dNow * 24.0 * 3600
           //- L_f.F_last_indic.f_DT / 1000 > 2000)
	       then
	    begin
	        Last_time_active := dNow;
	        L := C_Form(F.M_Long_operation().Obj);
	        
	        {$IFDEF USE_LISTS_OF_DESCRIPTORS}
	        Lform := TAL4Form(All_forms[L.F_Handle]);
	        {$ELSE}
	        Lform := TAL4Form(L.F_Handle);
	        {$ENDIF}
	        
	        if not Lform.Visible then // L.M_Visible() then
	            L.M_Show();
	    end;
    end;
    if not L_f.Is_NONE_object and (Allow_handle_events > 0) then
    begin
    	dec(Allow_handle_events);
    	try
        	Application.ProcessMessages();
    	finally
    		inc(Allow_handle_events);
    	end;
        if L_f.F_Cancelled then
        begin
            L_f.F_Cancelled := false;
            L_f.F_Finished := true;
		 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		 	 form := TAL4Form(All_forms[F.F_Handle]);
		 	{$ELSE}
	         form := TAL4Form(F.F_Handle);
	     	{$ENDIF}
             form.Enabled := true; 
            raise Stop_exception.Create('Long operation is cancelled');
        end;
    end;
//.
end;

procedure TScreen_handler.Exception_handler(Sender: TObject; E: Exception);
begin
	//writeln('*** APPLICATION EXCEPTION: ' + E.Message + ' ***');
end;

{$IFNDEF LINUX}

procedure TAL4Form.CreateParams(var Params: TCreateParams);
begin
	inherited CreateParams(Params);
	//ParentWindow := GetDesktopWindow; -- uncomment to get drag from moving
	Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
	{$IFDEF FPC}
		Params.WndParent := GetDesktopWindow;
	{$ENDIF}
end;

procedure TAL4Form.WMSysCommand(var Msg: TWMSysCommand);
begin
  case Msg.CmdType of
  //SC_SIZE:
  //  begin
  //  ShowWindow(Application.Handle, SW_Hide);
  //  inherited;
  //  end;
  	  
  SC_MINIMIZE:
  	begin
    {$IFDEF FPC}
    Application.Minimize;
    {$ELSE}
  	ShowWindow(Application.Handle, SW_Hide);
    {$ENDIF}
  	ShowWindow(Handle, SW_MINIMIZE);
  	end;
  else inherited;
  end;
end;
{$ENDIF}

	initialization
	
{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	All_controls := TList  .Create;
	All_controls.Add(nil);
	All_forms := TList  .Create;
	All_forms.Add(nil);
{$ENDIF}

{$IFDEF FPC}
//RequireDerivedFormResource := false;
// Absolutely useless to set it to true.
// I just want to remove unnecessary message in console about resources
// which are never used with AL-IV code still forms are always built by
// the code, not from resources.
{$ENDIF}

	finalization
	
	FreeAndNil(TObject(Monitors_stored));

(*
/*
END
*/
*)
end.
