(*
/*

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

CLASS {AL4_form|s_Delphi_KOL}, NATIVE, UNTESTED :
IMPORT: {Screen}, {Form}, {Control}, {Listbox}, {String_functions} ;
IMPORT: {Geometry}, {Dialog} .
IMPORT, ANYWAY: {System_functions} .
IMPORT, ANYWAY: {Long_operation} . 
//, {Fake_parameters} .
// for single instance only

NATIVE: @
        "uses AL4_form, AL4_drawing, Windows, Messages;" .
        
FUN out_system_stack, UNCOOKED, PUBLIC :.
*/
*)
unit AL4_form;
{$I EXTERNAL_DEFINES.inc}
{$I KOLDEF.inc}
//defines

interface

uses {$IFDEF KOL} KOL //, unitC_Fake_parameters 
     {$ELSE} Classes, Forms, Controls, Menus,
             StdCtrls, ExtCtrls, ComCtrls, Dialogs
     {$ENDIF},
// use AL4 to access system functions (AL4.pas inserted by the compiler into
// a project folder)
     AL4, System_functions,
// use All_classes from a project folder (generated for a certain project)
     All_classes, unitC_Form,
//?{Checkbox}
	 unitC_Checkbox,
//.
//?{Long_operation}
    unitC_Long_operation,
//.
//?{System_functions}
	unitC_System_functions,
//.
     Windows, Messages;

//{$WARN UNIT_DEPRECATED OFF}
//{$WARN SYMBOL_PLATFORM OFF}
//{$IFDEF Delphi7}
//{$WARN UNSAFE_TYPE OFF}
//{$WARN UNSAFE_CAST OFF}
//{$WARN UNSAFE_CODE OFF}
//{$ENDIF}

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

    PAL4Column = ^TAL4Column;

// class Form to represent any designed form on the Delphi side
    PAL4Form = ^TAL4Form;
    TAL4Form = object(KOL.TObj)
    protected
        procedure Event_Show(Sender: PObj);
        procedure Event_Close(Sender: PObj; var Accept: Boolean);
        //procedure Event_OnDestroy(Sender: PObj);
    public
        AL4Object: Ref_obj;
        Form: KOL.PControl;

		fClosed: Boolean;
        Hidden: Boolean;
        shown: Boolean;
        Columns: PList; // of PAL4Column
        click_disabled: Boolean;
        Popup_point: TPointF;
        Mouse_point: TPointF;
        Mouse_button: Integer;
        Mouse_wheel_vertical: Double;
        Mouse_wheel_horizontal: Double;
        
        MenuPanel_to_destroy: PObj;
        Main_menu_dummy: PMenu;
        Default_button: PControl;
        Cancel_button: PControl;
        Control_timers: PList;
       
        HCurrent_column_handle: Integer;
        function Get_current_column_handle: Integer;

        destructor Destroy; virtual; // override;
    public
        procedure Control_clicked(Sender: PObj);
        procedure Control_changed(Sender: PObj);
        procedure Selection_changed(Sender: PObj);
        procedure Listview_changed(Sender: PControl; IdxFrom, IdxTo: Integer; OldState, NewState: DWORD);
        procedure Form_clicked(Sender: PObj);
        procedure Control_resized(Sender: PObj);
        procedure Control_destroyed(Sender: PObj);
        procedure Form_resized(Sender: PObj);
        procedure Form_moved(Sender: PObj);
        //---------------------- 'mouse'
        procedure Prepare_mouse_point_button(Button: TMouseButton; 
            do_Button: Boolean; Info: PSt_Key_info__C_Form);
    public
        procedure Control_mouse_move(Sender: PControl; var Mouse: TMouseEventData);
            //(Sender: PObj; Shift: TShiftState; X, Y: Integer);
        procedure Form_mouse_move(Sender: PControl; var Mouse: TMouseEventData);
        procedure Control_mouse_down(Sender: PControl; var Mouse: TMouseEventData);
        procedure Form_mouse_down(Sender: PControl; var Mouse: TMouseEventData);
        procedure Control_mouse_up(Sender: PControl; var Mouse: TMouseEventData);
        procedure Form_mouse_up(Sender: PControl; var Mouse: TMouseEventData);
        procedure Control_mouse_double_click(Sender: PControl; var Mouse: TMouseEventData);
        procedure Form_mouse_double_click(Sender: PControl; var Mouse: TMouseEventData);
        procedure Form_mouse_wheel(Sender: PControl; var Mouse: TMouseEventData);
        //------------------------ 'keyboard'
        procedure Control_key_down(Sender: PControl; var Key: Longint; sShift: DWORD);
        procedure Control_key_up(Sender: PControl; var Key: Longint; sShift: DWORD);
        procedure Control_key_press(Sender: PControl; var Key: KOLChar; sShift: DWORD);
        procedure Control_mouse_wheel(Sender: PControl; var Mouse: TMouseEventData);
        //------------------------ 'timer'
        procedure Form_timer_tick(Sender: PObj);
    public
        //------------------------ 'fix KOL menu problems'
//?{Form}.menu_item
        procedure MainMenu_destroyed(Sender: PObj);
//.        
    public
    	procedure Form_key_down(Sender: PControl; var Key: Longint; sShift: DWORD);
        procedure Form_key_up(Sender: PControl; var Key: Longint; sShift: DWORD);
        function Form_message(var M: KOL.TMsg; var Rslt: Integer): Boolean;
    public
    	//------------------------- 'drop files'
//?{Form}.accept
        procedure Form_drop_files(Sender: PControl; 
        	const FileList: KOL_String; const Pt: TPoint);
//.
    end;

// class to represent a column (which is a panel to place controls on it)
    //PAL4Column = ^TAL4Column;
    TAL4Column = object(TObj)
    public
	    Panel: PControl;
		AL4Form: PAL4Form;
        Alias: String;
        Label_width: Integer; // in pixels
        ListControls: PList;
        Horizontal: Boolean;
        auto_arrange: Boolean;
        suspend_count: Integer;
        controls_layout: Integer;
        Layout: Integer;
        No_margins: Boolean;
        destructor Destroy; virtual; // override;
        constructor CreateColumn;
        procedure Resize(Sender: PObj);
    end;

// class to access protected properties of TControl
    PHackControl = ^THackControl;
    THackControl = object(TControl)
    end;

// class to store menu
//?{Form}.menu_item
    PMenuPanel = ^TMenuPanel;
    TMenuPanel = object(TObj)
    public
        Form_: PAL4Form;
        MenuObject: PMenu;
        AliasesList: PStrList;
        //AllItemsList: PList;
        Ready: Boolean;
        Alias: String;
        destroying: Boolean;
        procedure Item_click(Sender : PMenu; Item : Integer);
        destructor Destroy; virtual; // override;
    end;
//.
    
    PHackMenu = ^THackMenu;
    THackMenu = object(KOL.TMenu)
    end;

// class to store timer
//?{Form}.timer
    PTimerPanel = ^TTimerPanel;
    TTimerPanel = object(TControl)
        TimerObject: PTimer;
        constructor CreateTimerPanel(xParent: PControl);
        destructor Destroy; virtual; //override;
    end;
//.

//?{Control}.animation
    PAnimation_timer = ^TAnimation_timer;
    TAnimation_timer = object(TObj)
    public
        Form: PAL4Form;
        Ref_control: Ref_obj;
        Counter: Integer;
        Last_counter: Integer;
        T: PTimer;
        Control_handle: Integer;
        constructor Create(X_H, X_Count, X_Interval: Integer);
        procedure Tick_timer(Sender: PObj);
        procedure Stop_timer;
    end;    
//.

// 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;

// 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);

// internal function to avoid accessing nil controls
function HackControl(H: Integer): PHackControl;

// 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);

procedure adjust_all_columns(H: Integer);
procedure Do_show_noactivate(H: Integer);
procedure Do_show_hide(H: Integer; Show: Boolean);
procedure Do_show_modal(H, P: Integer);
//var modal_Result: String;

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);

// functions to work with Columns

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 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);

// 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_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);
{$IFnDEF SMALLEST_CODE}
procedure Set_default_font(const Face: String; Size: Integer);
procedure OK_Set_form_font_to_default(Form: PControl);
{$ENDIF}
var Set_form_font_to_default: procedure(Form: PControl);
var Default_font: PGraphicTool;


procedure Do_show_message(const s: String);
function Do_ask_yes_no(const s: String): Boolean;

procedure Adjust_control_location_1(Parent: PAL4Column; C_new: PControl);
procedure dummy_Adjust_control_location(Parent: PAL4Column; C_new: PControl);
var Adjust_control_location: procedure (Parent: PAL4Column; C_new: PControl)
	= dummy_Adjust_control_location;
	
procedure Set_control_events(Parent: PAL4Column; C: PControl);
procedure Set_Win_control_events(Parent: PAL4Column; C: PControl);
procedure Do_begin_animation(X_H: Integer; X_Count: Integer; X_Interval: Integer);

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

function Do_Create_button(P: Integer; X_B: Pointer): Integer;
procedure Do_Set_form_default_button(X_H: Integer; X_B: Integer);
procedure Do_Set_form_cancel_button(X_H: Integer; X_B: 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: 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(X_L: Ref_obj; X_Multiselect: Boolean): Integer;
procedure Do_Listbox_select_all(X_L: Integer);
function Do_Listbox_get_next_sel(X_L: Integer; X_From: Integer): 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);

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

// menu functions
//?{Form}.menu_item
function Do_create_menu(P: Integer; X_V: DynAStr): PMenuPanel;
procedure Do_Destroy_menu(MP: PMenuPanel);
//.
procedure Do_Popup_menu(X_F: Integer; X_M: DynAStr; X_X, 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);
//?{Form}.timer
function NewTimerPanel(ParentForm: PControl): PTimerPanel;
//.

{$IFNDEF NOEXCEPTIONS}
{$IFNDEF NOLONGOP}
type
	PScreen_handler = ^TScreen_handler;
	TScreen_handler = object(TAL4_handler)
		//C_Scr: C_Screen;
		Ref_scr: Ref_obj;
		constructor Create(X_Screen: Ref_obj);
		procedure Handler; virtual;
	end;
	
{$ENDIF}
{$ENDIF}
var Allow_handle_events: Integer = 1;

procedure Do_Screen_created(X_S: Ref_obj);

var Monitors_stored: PList;
var Faked: Boolean;
var Main_form_handle: Integer;

var Last_time_active: TDateTime;

procedure operation_started(Form: C_Form; operation: Integer ; Control: Ref_obj);

function call_do_long_operation(X_Caller: Ref_obj; X_Exist: Ref_obj): Ref_obj;

implementation

uses unitC_Control;

(*
/*

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


procedure List_screen_monitors;
var A: TRectsArray;
    i: Integer;       
begin
	if Monitors_stored = nil then Monitors_stored := NewList;
	if not Faked then Monitors_stored.Clear;
    A := ListMonitors;
    for i := 0 to High(A) do
    begin
    	Monitors_stored.Add(Pointer(A[i].Left));
    	Monitors_stored.Add(PointeR(A[i].Top));
    	Monitors_stored.Add(Pointer(A[i].Right - A[i].Left));
    	Monitors_stored.Add(Pointer(A[i].Bottom - A[i].Top));
    end;
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 := NewList;"
    "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 Exit;
	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 Exit;"
    "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;"
	"var p: TPoint;"
	"	 p.X := GetSystemMetrics(76 {SM_XVIRTUALSCREEN});"
	"	 p.Y := GetSystemMetrics(77 {SM_YVIRTUALSCREEN});"
    "    r := MakeRect( p.X, p.Y, "
    "		p.X + GetSystemMetrics( 78 {SM_CXVIRTUALSCREEN} ),"
    "		p.Y + GetSystemMetrics( 79 {SM_CYVIRTUALSCREEN} ) );" 
 	"	 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));"   
	.
*/
*)

(*
/*

// 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
    NATIVE @
    "var form: PAL4Form;"
    "	 Object_assign_weak(Screen_object_ref_, X_Screen.Obj);"    
    "    form := PAL4Form(X_h);"
    "    if form.Hidden then Applet.Visible := FALSE"
    "	 else if not form.Form.Visible then form.Form.Show;"
    "	     {$IFNDEF SMALLER_CODE}"
    " 		 adjust_all_columns(X_h);"
    " 		 {$ENDIF}"
    "	 App_running := true;"
    "    Run(Applet);" 
    "	 App_running := false;" .
    
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 := GetTickCount;" .	
*/
*)


	(*
	/*
------------------------------------------------- '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;" .
 	*/
 	*)
	
	var registered_msg: DWORD;	
	var first_inst_mutex: THandle;
		
	procedure unregister_instance;
	begin
	 	if LongBool(first_inst_mutex) then
	 	begin
	 		CloseHandle(first_inst_mutex);
	 		first_inst_mutex := 0;
	 	end;
	end;
 	(*
 	/*

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


	
	*/
	*)
	procedure parse_command_parameters(p: PChar);
	var a: DynAStr;
		e: PChar;
		item: String;
		i: Integer;
	begin
		a := New_DynAStr();
		for i := 0 to Length(p) do
		begin
			if p^ = #0 then break;
			if p^ = '"' then
			begin
				inc(p);
				e := StrScan(p, '"');
				if (e <> nil) then 
				begin
					SetString(item, p, Integer(e) - Integer(p));
					a.Add(MAXINT, item);
					p := e;
					inc(p);
					continue;
				end;
			end;
			e := StrScan(p, ' ');
			if (e <> nil) then
			begin
				SetString(item, p, Integer(e) - Integer(p));
				a.Add(MAXINT, item);
				p := e;
				inc(p);
				continue;
			end;
			item := p;
			a.Add(MAXINT, item);
			break;
		end;
		unitC_System_functions.M_Set_parameters(a);
		a.Free;
	end;	
	
	procedure operation_started(Form: C_Form; operation: Integer ; Control: Ref_obj);
	begin
		if Control = nil then 
		begin
			if Form = nil then Exit;
			Control := Form.hard_link;
		end;
		Form.M_operation_started(operation, Control);
	end;


	function WndProc_another_instance_notify(
		Control: PControl; var Msg: KOL.TMsg; var Rslt: Integer ) : Boolean;
	var Buf : array[0..MAX_PATH] of KOLChar;
		F: C_Form;
	begin
	  Result := False;
	  case Msg.message of
	  WM_CLOSE, WM_NCDESTROY:
	      if LongBool(first_inst_mutex) and (Control.Handle = Msg.hwnd) then
	      begin
	        CloseHandle( first_inst_mutex );
	        first_inst_mutex := 0;
	      end;
	  end;
	  if  Msg.message = registered_msg then
	  begin
	      Result := True;
          GetWindowText( Msg.lParam, Buf, MAX_PATH );
          parse_command_parameters(Buf);
          
	      F := C_Form(PAL4Form(Control.Tag).AL4Object.Obj);
          operation_started(F, 26, F.hard_link);
		  try
		  F.M_command;
		  finally
		  F.M_operation_ended(26);
		  end;
	      Rslt := 0;
	  end;
	end;
	
	procedure Attach_another_instance_notification(Form: PControl);
	begin
		Form.AttachProc( WndProc_another_instance_notify );
	end;
	
	procedure main_form_running(X_M: Ref_obj);
	begin
	 	if registered_msg <> 0 then
	 		Attach_another_instance_notification(
	 			PAL4Form(C_Form(X_M.Obj).F_Handle).Form);
	end;
	
	function register_instance(const X_Uniq, X_Command_line: String): Boolean;
	var CritSecMutex : THandle;
    	DW : Longint;
    	Recipients : DWord;
    	cmd, param: String;
    	buf: array[0..MAX_PATH] of KOLChar;
    	i, j: Integer;
	begin
		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
			if Applet = nil then Applet := NewApplet('');
			Applet.Visible := false;
			
			GetModuleFileName( 0, buf, MAX_PATH );
			cmd := buf;
			if pos(' ', cmd) > 0 then cmd := '"' + cmd + '"'; 
			for i := 1 to ParamCount do
			begin
				if pos(' ', ParamStr(i)) > 0 then
				begin
					param := ParamStr(i);
					for j := Length(param) downto 1 do
						if param[j] = '"' then
							param := Copy(param, 1, j) + Copy(param, j, MAXINT);
					cmd := cmd + ' "' + param + '"'
				end
				else cmd := cmd + ' ' + ParamStr(i);
			end;  
		    Applet.Caption := cmd;
		    if Applet.GetWindowHandle <> 0 then
		    begin
		       Recipients := BSM_APPLICATIONS;
		       SendMessage(HWND_BROADCAST, registered_msg, 0, Applet.Handle);
		    end;
		    TerminateProcess(GetCurrentProcess, 0);
		end;
	end;

function InchesToPixels(
	inches: Double): Double;
var DC: HDC;
    ppi: Integer;
begin
    DC := GetDC(0);
    ppi := GetDeviceCaps(DC, LOGPIXELSY);
    Result := ppi * inches;
    ReleaseDC(0, DC);
end;

(*
/*
//---------- points --> pixels

FUN Points|_convert_to_pixels(
	REAL P|oints_value) ==> INT, NATIVE :
    "    RESULT := Points(X_P);" .
    
FUN Set_form_application_button(
INT H|andle_of_form, BOOL Value|_set), NATIVE : @
"var F: PAL4Form;"
"	F := PAL4Form(X_H);"
"	if X_Value then"
"	   SetWindowLong(F.Form.Handle, GWL_EXSTYLE,"
"    		GetWindowLong(F.Form.Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW)"
"	else" 
"	   SetWindowLong(F.Form.Handle, GWL_EXSTYLE,"
"    		GetWindowLong(F.Form.Handle, GWL_EXSTYLE) and not WS_EX_APPWINDOW);" 
.

FUN Is_mobile_screen ==> BOOL: .
    
*/
*)

function Points{ToPixels}(
	pts: Double): Integer;
var d: Double;
begin
	d := InchesToPixels(1) / 72.0 * pts; 
    Result := Trunc(d + 0.000001);
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(1) * 72.0;
end;

(*
/*

FUN Screen_created(
	{Screen} S|creen_object_containing_all_forms_dummy), NATIVE : @
    "   Do_Screen_created(X_S);" 
	"	 if Screen_object_ref_ <> nil then" 
	"	  	Object_assign_weak(Screen_object_ref_, X_S.Obj)"
	"	 else Screen_object_ref_ := X_S;" .

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;
		
(*
		/*

*/
*)

procedure Do_Screen_created(
	X_S: Ref_obj);
{$IFNDEF NOEXCEPTIONS}
{$IFNDEF NOLONGOP}
var sh: PScreen_handler;
{$ENDIF}
{$ENDIF}
begin
    {$IFNDEF NOEXCEPTIONS}
    {$IFNDEF NOLONGOP}
	new(sh, Create(X_S));
	long_operation_handlers.Add(sh);
	{$ENDIF}
    {$ENDIF}
end;



(*
/*

FUN Set_forms_autoscroll(BOOL A|utoscroll_forms) : .

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

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

procedure OK_Set_form_font_to_default(Form: PControl);
begin
    Form.Font.Assign(Default_font);
end;

function Do_Form_create(
	X_F: Ref_obj): Integer;
var Form: PAL4Form;
	F: C_Form;
begin
    if Applet = nil then
    begin
       Applet := NewApplet('');
       {$IFDEF ICON_APPLICATION}
			Applet.Icon := LoadIcon(hInstance, 'MAIN');
       {$ENDIF}
    end;
    new(Form, Create);
    Form.Hidden := TRUE;
    Form.Form := NewForm(Applet, '') {$IFNDEF SMALLEST_CODE} .Tabulate {$ENDIF};
    Form.Form.Visible := false;
    Form.Form.Tag := DWORD(Form);
    Form.AL4Object := X_F;
    Form.Columns := NewList;
    {$IFDEF KEY_PREVIEW}
    Form.Form.KeyPreview := TRUE;
	Form.Form.OnKeyDown := Form.Form_key_down;
	Form.Form.OnKeyUp := Form.Form_key_up;
    {$ENDIF}
    
	F := C_Form(Form.AL4Object.Obj);

	{$IFnDEF SMALLEST_CODE}    
	if Assigned(Set_form_font_to_default) then
		Set_form_font_to_default(Form.Form);
    {$ENDIF}
    Form.Form.CreateWindow;
    Form.Form.OnClose := Form.Event_Close;
//?{Form}.click
    Form.Form.OnClick := Form.Form_clicked;
//.

//?{Form}.resize
    Form.Form.OnResize := Form.Form_resized;
    Form.Form.OnMove := Form.Form_moved;
//.

//?{Form}.mouse_move
    Form.Form.OnMouseMove := Form.Form_mouse_move;
//.

//?{Form}.mouse_down
    Form.Form.OnMouseDown := Form.Form_mouse_down;
//.

//?{Form}.mouse_up
    Form.Form.OnMouseUp := Form.Form_mouse_up;
//.

 //?{Form}.mouse_double_click
    Form.Form.OnMouseDblClk := Form.Form_mouse_double_click;
 //.

//?{Form}.mouse_wheel
    Form.Form.OnMouseWheel := Form.Form_mouse_wheel;
//.

//?{Form}.shown
    Form.Form.OnShow := Form.Event_Show;
//.

	//------------------//?{Form}.activated
    Form.Form.OnMessage := Form.Form_message;
	//------------------//.

//?{Form}.accept
	Form.Form.OnDropFiles := Form.Form_drop_files;
//.
	{$IFDEF ICON_APPLICATION}
	Form.Form.Icon := LoadIcon(hInstance, 'MAIN');
	{$ENDIF}

	F.M_Any_change;
    Result := Integer(Pointer(Form));
    Form.Hidden := FALSE;
    //Form.Form.Visible := true;
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: PBitmapEx;"
	"var f: PAL4Form;"     
	"    B := PBitmapEx(X_Bitmap_h);"     
	"    if (B = nil) or (B.Ico = nil) then Exit;" 	 
    "    F := PAL4Form(X_Form_h);"
	"if (f <> nil) then"
	"	 f.Form.Icon := B.Ico.Handle;"     
	.


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

FUN Get_window_handle(
	INT H|andle_native) ==> INT, NATIVE :
@   "var F: PAL4Form;"
    "    F := PAL4Form(X_H);"
    "	 if F <> nil then"
    "    	RESULT := F.Form.GetWindowHandle;" .

FUN Call_any_change({Form} F|orm_object), NATIVE:
	INT h|andle_form = F.Handle
	NATIVE @
    "var F: PAL4Form;"
	"var CF: C_Form;"
    "    F := PAL4Form(X_h);"
	"	 CF := C_Form(F.AL4Object.Obj);"
	"{$IFnDEF SMALLER_CODE}"     
	"	 dec(Allow_handle_events);"     
	"	 try"
	"{$ENDIF}"     
	"	 	CF.M_Any_change();"
	"{$IFnDEF SMALLER_CODE}"     
	"	 finally"
	"		inc(Allow_handle_events);"     
	"	 end;"     
	"{$ENDIF}"     
	.

*/
*)

(*
/*
// Destroy Delphi form
//--------------------

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

procedure Do_destroy_form(H: Integer);
begin
    HackControl(H).Free;
end;

(*
/*
// Close Delphi form
//--------------------

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

var postquit_sent: Boolean;

procedure Do_form_close(
	X_H: Integer);
var f: PAL4Form;
var cF: C_Form;
	cS: C_Screen;
//?{Form}.closed
//.
begin
    f := PAL4Form(X_H);
    if f = nil then Exit;
    cF := C_Form(f.AL4Object.Obj);
	cS := C_Screen(cF.F_Screen_.Obj);
	
//?{Form}.closed
    operation_started(cF, 2, nil);
    Try
        cF.M_closed;
    finally
        cF.M_operation_ended(2);
    end;
//.
	if (cS.F_Main_form_.Obj = cF) and not postquit_sent then
	begin
		postquit_sent := true;
		PostQuitMessage(0);
		Exit;
	end
	else
    	f.Form.Close;
		//Object_assign_weak(cS.F_Main_form_, NoneObj_C_Form);
	//cS.M_Form_destroyed(cF.hard_link);
end;	


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

FUN Form_visible(
	INT H|andle_native) ==> BOOL, NATIVE :
@	"	if X_H = 0 then Exit;"
    "   RESULT := PAL4Form(X_H).Form.Visible;" .
    
FUN Form_hidden(
	INT H|andle_native) ==> BOOL, NATIVE :
@	"	if X_H = 0 then Exit;"
    "   RESULT := PAL4Form(X_H).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: PAL4Form;
begin
	F := PAL4Form(H);
 	F.Hidden := false;
	if F.Form.WindowState = wsMinimized then
	   F.Form.SetWindowState(wsNormal);
	 F.Form.ShowNoActivate;
	//ShowWindow(F.Handle, SW_SHOWNOACTIVATE);
end;

procedure adjust_all_columns(
	H: Integer);
var i: Integer;
begin
    for i := 0 to PAL4Form(H).Columns.Count-1 do
    begin
        Adjust_control_location(PAL4Form(H).Columns.Items[i], nil);
    end;
end;

procedure Do_show_hide(
	H: Integer; Show: Boolean);
var i: Integer;
begin
	if H = 0 then Exit;
    if  Show then
    begin
    	if not PAL4Form(H).fClosed then
    	begin  
	        PAL4Form(H).Hidden := FALSE;
	        PAL4Form(H).Form.Show;
	        adjust_all_columns(H);
    	end;
    end
    else 
    begin
        PAL4Form(H).Form.Hide;
        PAL4Form(H).Hidden := TRUE;
    end;
end;

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

	FUN Show_form_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 Do_show_modal(H, P: Integer);
var F, FP: PAL4Form;
	{$IFnDEF SMALLEST_CODE}
	CF: C_Form;
	{$ENDIF}
    CP: C_Form;
    save_level_event: Integer;
    save_menu_alias: String;
begin
 if H = 0 then Exit;
    F := PAL4Form(Pointer(H));
    F.Hidden := false;
    
    FP := PAL4Form(Pointer(P));
    CP := C_Form(FP.AL4Object.Obj);
    save_level_event := CP.F_level_event;
    CP.F_level_event := 0;
    save_menu_alias := CP.F_menu_alias;
    CP.F_menu_alias := '';
    try
    	F.Form.ShowModal;
		{$IFnDEF SMALLEST_CODE}
		CF := C_Form(F.AL4Object.Obj);
	    if CF.M_Modal then
	        if F.Form.ModalResult <> 0 then
	        begin
	       		if CP.F_current_modal_dialog_.Obj = CF then
	       			Object_assign_weak(CP.F_current_modal_dialog_, NoneObj_C_Form);
	            //Exit;
	        end;
	    {$ENDIF}    
	    //F.Form.Close; //-- not closed automatically in KOL
	    F.Form.Hide; //-- not closed automatically in KOL
    finally
    	CP.F_menu_alias := save_menu_alias;
    	CP.F_level_event := save_level_event;
    end;
end;

(*
/*
// Set modal result
//---------------------

FUN Set_modal_result(
	INT H|andle_native, STR Result|_set), NATIVE :
@   "var form: PAL4Form;"
	"	 if X_H = 0 then Exit;"
    "    form := PAL4Form(Pointer(X_H));"
    "    form.Form.ModalResult := ID_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: PAL4Form;
begin
    F := PAL4Form(H);
    if F <> nil then
    	Result := F.Form.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: PAL4Form;
begin
    F := PAL4Form(H);
    if F <> nil then
    begin
	    F.Form.Caption := V;
	    if (V <> '') and (Applet.Caption = '') then Applet.Caption := V;
	end;
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: PAL4Form;
begin
    F := PAL4Form(H);
    if F <> nil then
    	Result := Pixels(F.Form.Left)
    else Result := 0;
end;

(*
/*
// 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: PAL4Form;
begin
    F := PAL4Form(H);
    if F <> nil then
    	Result := Pixels(F.Form.Top)
    else Result := 0;
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: PAL4Form;
//?{Form}.moved
	cF: C_Form;
//.
begin
	if H = 0 then Exit;
    F := PAL4Form(H);
    F.Form.Left := Points(X_L);
    F.Form.Top := Points(X_T);
//?{Form}.moved
    cF := C_Form(F.AL4Object.Obj);
    operation_started(cF, 8, nil);
    try
    	cF.M_moved;
    finally
    	cF.M_operation_ended(8);
    end;
//.
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: PAL4Form;"
   "F := PAL4Form(X_F);"
   "F.Form.BoundsRect := MakeRect(X_p_l, X_p_t, X_p_l + X_p_w, X_p_t + X_p_h);"
   .


FUN Get_form_state(
INT F|orm_handle) ==> {Form}.{state}, NATIVE: @
"var F: PAL4Form;"
    "F := PAL4Form(X_F);"
"	 if IsIconic(F.Form.Handle) then RESULT := 1"
"	 else"
"	 if IsZoomed(F.Form.Handle) then RESULT := 2;" .

FUN Set_form_state(
INT F|orm_handle, {Form}.{state} V|alue_to_set), NATIVE: @
"var F: PAL4Form;"
"var R: TRect;"
"var W: HWnd;"
    "F := PAL4Form(X_F);"
"	 case X_V of"
"	 0: F.Form.SetWindowState(wsNormal);" 
"	 1: F.Form.SetWindowState(wsMinimized);" 
"	 2: begin"
"		{$IFDEF SMALLER_CODE}"
"			F.Form.SetWindowState(wsMaximized);"
"		{$ELSE}"
"			SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);"
//"			writeln('workarea: ' + Int2Str(R.Left) + ' ' + Int2Str(R.Top) + ' '"
//"			+ Int2Str(R.Right) + ' ' + Int2Str(R.Bottom));"
"			F.Form.SetWindowState(wsMaximized);"
"			if (F.Form.Left >= R.Left) and (F.Form.Top >= R.Top)"
"			and (F.Form.Left + F.Form.Width <= R.Right)"
"			and (F.Form.Top + F.Form.Height <= R.Bottom) then"
"			begin"
"				F.Form.BoundsRect := R;"
"				Exit;"
"			end;"
"			W := FindWindow('Shell_TrayWnd', nil);"
"			if (R.Right-2 <= F.Form.Left) or"
" 			   (R.Left+2 >= F.Form.Left + F.Form.Width)"
"			or (R.Bottom-2 <= F.Form.Top) or"
"			   (R.Top+2 >= F.Form.Top + F.Form.Height)"
"			then Exit;"
"			GetWindowRect(W, R);"
"			if (R.Top > F.Form.Top) and (R.Top < F.Form.Top + F.Form.Height)"
"			then begin"
"				F.Form.Height := R.Top - F.Form.Top;"
"			end"
"			else if (R.Bottom > F.Form.Top) and "
"				 (R.Bottom < F.Form.Top + F.Form.Height) then begin"
"				F.Form.Height := F.Form.Top + F.Form.Height - R.Bottom;"
"				F.Form.Top := R.Bottom;"
"			end"
"			else if (R.Left > F.Form.Left) and "
"				 (R.Left < F.Form.Left + F.Form.Width) then begin"
"				F.Form.Width := R.Left - F.Form.Left;"
"			end"
"			else if (R.Right > F.Form.Left) and "
"				 (R.Right < F.Form.Left + F.Form.Width) then begin"
"				F.Form.Width := F.Form.Left + F.Form.Width - R.Right;"
"				F.Form.Left := R.Right;"
"			end;"
"		{$ENDIF}"
"		end;"
//"	 2: F.Form.Perform(WM_COMMAND, SC_MAXIMIZE, 0);"
"	 end;" .


// Get form width in points
//-------------------------

FUN Get_form_width(
	INT F|orm_native_handler) ==> REAL, NATIVE :
@	"var F: PAL4Form;"
	"	F := PAL4Form(X_F);"
	"	if F <> nil then"
	"		Result := Pixels(F.Form.Width);" .
	
// Get form height in points
//--------------------------

FUN Get_form_height(
	INT F|orm_native_handler) ==> REAL, NATIVE :
@	"var F: PAL4Form;"
	"	F := PAL4Form(X_F);"
	"	if F <> nil then"
	"		Result := Pixels(F.Form.Height);" .
	
// Set form size in points
//------------------------

FUN Set_form_size(INT F|orm_native_handler,
    REAL W|idth_points, REAL H|eight_points), NATIVE :
@  "var F: PAL4Form;"		
   "	if X_F = 0 then Exit;"
   "	F := PAL4Form(X_F);"
   "	F.Form.Width := Points(X_W);"
   "	F.Form.Height := Points(X_H);" .
   
FUN Set_form_minimal_size(INT F|orm_native_handler,
    REAL W|idth_dummy, REAL H|eight_dummy) : .
	
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: PAL4Form;"
	"var P: TPoint;"
    "    form := PAL4Form(X_F);"
	"	 if (form = nil) then EXIT;"
	"	P := form.Form.Client2Screen(MakePoint(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: PAL4Form;"
	"    form := PAL4Form(Pointer(X_F));"
	"	 if (form = nil) then EXIT;"
    "    if (X_w) then "
    "		RESULT := Pixels(form.form.ClientRect.Right)"
    "		- Points(4) * 2"
    "	 else RESULT := Pixels(form.form.ClientRect.Bottom)"
    "		- Points(2) * 2;" .
    
FUN Set_form_client_size(
INT F|orm_native_handler,
REAL W|idth_points, REAL H|eight_points) ==> BOOL,
NATIVE :
@	"var form: PAL4Form;"
	"var w, h: Integer;"
	"	 form := PAL4Form(Pointer(X_F));"
	"	 w := Points(X_W + 4);"
	//"	 w := Points(X_W);"
	"	 h := Points(X_H + 4);"
	//"	 h := Points(X_H);"
	"	 form.form.Width := w + (GetSystemMetrics(SM_CXFRAME) "
	"		//+ GetSystemMetrics(SM_CXBORDER) * 2" 
	"		+ GetSystemMetrics(SM_CXEDGE)) * 2;" 
	"	 form.form.Height := h + (GetSystemMetrics(SM_CYFRAME)) "
	"		//+ GetSystemMetrics(SM_CXEDGE) * 2 "
	"		+ GetSystemMetrics(SM_CYCAPTION)"
	"		;" 
    "	 RESULT := true;" .
		
   
   
// Set form special view options
//------------------------------

FUN Set_form_stay_on_top(
	INT F|orm_native_handler, BOOL T|opmost_Z),
    NATIVE :
@   "var form: PAL4Form;"
    "    form := PAL4Form(X_F);"
    "    form.Form.StayOnTop := X_T;"
    .
    
FUN Set_form_no_frame(
	INT F|orm_native_handle, BOOL No_frame|_flag), NATIVE:
@	"var form: PAL4Form;"
    "    form := PAL4Form(X_F);"
    "	 if X_No_frame then"
    "	 begin"
    "	 	form.Form.Style := form.Form.Style and not WS_THICKFRAME;"
    "		form.Form.Border := 0;"
    "	 end;"
    "	 form.Form.HasBorder := not X_No_frame;"
    "	 Applet.Visible := not X_No_frame;"
    "	 if not X_No_frame then"
    "	 begin"
	"	 	form.Form.Style := form.Form.Style or WS_THICKFRAME;"
	"		form.Form.Border := 2;"
	"	 end;" .
	 
FUN Start_move_form(INT F|orm_native_handle),
	NATIVE, DEPRECATED('Platform dependent'):
@	"var form: PAL4Form;"
    "    form := PAL4Form(X_F);"
    "	 ReleaseCapture();"
    "	 SendMessage(form.Form.Handle, "
    "		{WM_NCLBUTTONDOWN}$A1, {HT_CAPTION}2, 0);" .

	
FUN Set_form_columns_no_borders(
	INT F|orm_native_handle, BOOL No_borders|_flag), NATIVE:
@	"var form: PAL4Form;"
    "    form := PAL4Form(X_F);"
	.
	
FUN Set_form_alpha_tran
	|sparency_0opaque_1invisible(
	INT F|orm_native_handle, REAL Tran|sparency_value), NATIVE:
@	"var form: PAL4Form;"
    "    form := PAL4Form(X_F);"
    "	 form.Form.AlphaBlend := Round((1 - X_Tran) * 255);" .
    
FUN Set_form_colors(
	INT F|orm_native_handle, INT FColor|_int, INT BColor|_int), NATIVE:
	NATIVE @
	"var form: PAL4Form;"
	"var i, j: Integer;"
	"var C: PHackControl;"
	"	form := PAL4Form(X_F);"
	"	form.Form.Color := X_BColor and $FFFFFF;"
	"	form.Form.Font.Color := X_FColor and $FFFFFF;"
	"	for i := 0 to form.Columns.Count-1 do"
	"	begin"
	"		PAL4Column(form.Columns.Items[i]).Panel.Color "
	"		:= X_BColor and $FFFFFF;"
	"		PAL4Column(form.Columns.Items[i]).Panel.Font.Color "
	"		:= X_FColor and $FFFFFF;"
	"		for j := 0 to PAL4Column(form.Columns.Items[i]).Panel.ChildCount-1 "
	"		do begin"
	"			C := PHackControl("
	"				PAL4Column(form.Columns.Items[i]).Panel.Children[j]);"
	"			if C.fCommandActions = nil then continue;"
	"			//if C.SubClassName <> 'STATIC' then continue;"
	"			C.Color := X_BColor and $FFFFFF;"
	"			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: PAL4Form;"
	"var ex: DWORD;"
	"	form := PAL4Form(X_F);"
    "	form.Form.CreateWindow;"  
    "	if not form.Form.Visible then form.Form.Visible := true;"     
    "	ex := GetWindowLong(form.Form.Handle, GWL_EXSTYLE);"
    "	if X_Yes then"
    "		 ex := ex or WS_EX_TOOLWINDOW"     
    "	else ex := ex and not WS_EX_TOOLWINDOW;"     
    "	SetWindowLong(form.Form.Handle, GWL_EXSTYLE, ex);"     
    "	SetWindowPos(form.Form.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or "
    "		SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOZORDER or SWP_NOSIZE"
    "		or SWP_NOMOVE);" .     

	

FUNCTION Is_form_active(INT H|andle_form) ==> BOOL, NATIVE :
@   "var F: PControl;"
    "    F := HackControl(X_H);"
    "    RESULT := GetForegroundWindow = F.Handle;" .
    
FUNCTION Make_form_active(INT H|andle_form), NATIVE :
@   "var F: PControl;"
    "    F := HackControl(X_H);"
    "    SetForegroundWindow(F.Handle);" .
    
FUNCTION Set_form_enabled(
	INT H|andle_form, BOOL E|nable_form), NATIVE
	:
@   "var form: PAL4Form;"
	"	 if X_H = 0 then Exit;"
    "    form := PAL4Form(X_H);"
    "    form.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 :
@	"var F: PAL4Form;"
	"	if X_H = 0 then Exit;"
	"	F := PAL4Form(X_H);"
	"	F.HCurrent_column_handle := X_Col;" .
	
FUN Set_column_padding|Dummy_in_KOL(
INT Padding|_pixels_DUMMY): .	
	
// 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 | column_handle)
==> INT, NATIVE : @
"RESULT := Do_Create_column(X_F, X_layout, X_Width, X_Label_w, X_Nested_in);" .
*/
*)
{$DEFINE NO_NESTED_COLUMNS} //-------------------------------------

function Do_Create_column(
H: Integer; Layout: Integer; Width: Double; Label_w: Double;
Nested_in: Integer): Integer;
var LastCol: PAL4Column;
	{$IFNDEF SMALLER_CODE}
	ParentCol: PAL4Column;
	{$ENDIF}
    F: PAL4Form;
    n: Double;
    w: Integer;
    const aligns_array: array[0..4] of TControlAlign =
    	(caClient, caLeft, caRight, caTop, caBottom);
begin
	if H = 0 then Exit;
    F := PAL4Form(H);
    new(LastCol, CreateColumn);
	LastCol.AL4Form := F;
	LastCol.Layout := Layout;
	
	{$IFNDEF NO_NESTED_COLUMNS} ///////////////////////////////////
	//ParentCol := nil;
	if Nested_in <> 0 then
		ParentCol := PAL4Column(Nested_in);
	{$ENDIF} /////////////////////////////////////////////////
	begin
		LastCol.Panel := NewPanel(F.Form, esNone);
    	F.Columns.Add(LastCol);
	end;
	LastCol.Panel.Tag := DWORD(LastCol);
	LastCol.Label_width := Points(Label_w);
//?{Form}.click
    LastCol.Panel.OnClick := F.Form_clicked;
//.
//?{Form}.mouse_move
    LastCol.Panel.OnMouseMove := F.Form_mouse_move;
//.
//?{Form}.mouse_down
    LastCol.Panel.OnMouseDown := F.Form_mouse_down;
//.
//?{Form}.mouse_up
    LastCol.Panel.OnMouseUp := F.Form_mouse_up;
//.
//?{Form}.mouse_double_click
    LastCol.Panel.OnMouseDblClk := F.Form_mouse_double_click;
//.
//?{Form}.mouse_wheel
    LastCol.Panel.OnMouseWheel := F.Form_mouse_wheel;
//.

    n := 200;
    if  Width > 0 then n := Width;
    w := Points(n);
    LastCol.Panel.Width := w;
    LastCol.Panel.Height := w;
    {$IFNDEF NO_NESTED_COLUMNS} /////////////////////////
    if ParentCol = nil then
    {$ENDIF} ///////////////////////////////////////
    	LastCol.Panel.Align := aligns_array[Layout];
    LastCol.Horizontal := Layout >= 3;
    if LastCol.Horizontal then LastCol.Panel.Height := Points(22);
    F.HCurrent_column_handle := Integer(LastCol);
    Result := Integer(LastCol);

    LastCol.Panel.OnResize := LastCol.Resize;
end;

(*
/*

FUN Get_column_layout(
INT C|olumn_handle) ==> {Form}.{layout}, NATIVE : @
    "var Col: PAL4Column;"
    "	 if X_c = 0 then Exit;"
    "    Col := PAL4Column(X_C);"
    "	RESULT := Col.Layout;" .

FUN Get_nested_in(
INT C|olumn_handle) ==> INT : .


FUN Form_suspend_layout(INT Handle|_of_form_to_suspend) : .

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: PAL4Form;"
"var col: PAL4Column;"
"	if (X_Handle = 0) or (X_Col < 0) then Exit;"
"	F := PAL4Form(X_Handle);"
"	if (F = nil) then Exit;"
"	col := F.Columns.Items[X_Col];"
"	if col.suspend_count = 0 then"
"		; //col.Panel.Visible := false;"
"	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: PAL4Form;"
"var col: PAL4Column;"
"	if (X_Handle = 0) or (X_Col < 0) then Exit;"
"	F := PAL4Form(X_Handle);"
"	if (F = nil) then Exit;"
"	col := F.Columns.Items[X_Col];"
//"	Writeln('-- col.suspend_count=' + IntToStr(col.suspend_count));"
"	dec(col.suspend_count);"
"	if col.suspend_count = 0 then"
"	begin"
"		Adjust_control_location(col, nil);" 
"		//col.Panel.Visible := true;"
"	end;" .

FUN Get_form_column_controls_layout(
	INT Col|umn_handler) ==> {Form}.{controls_layout}, NATIVE : @
"var col: PAL4Column;"
"	col := PAL4Column(X_Col);"     
"	RESULT := col.controls_layout;" .

FUN Set_form_column_controls_layout(
	INT Col|umn_handler,
	{controls_layout} CL|ayout_controls), NATIVE : @
"var F: PAL4Form;"
"var col: PAL4Column;"
"	col := PAL4Column(X_Col);"
"	col.controls_layout := X_CL;" .

FUN Get_form_column_uses_margins(
INT C|olumn_handle) ==> BOOL,
	NATIVE :
	CASE C == 0 ? ==> ;
	NATIVE @     
"var LastCol: PAL4Column;"
"    LastCol := PAL4Column(X_C);"
"	 RESULT := not LastCol.No_margins;" .

FUN Set_form_column_margins(
INT C|olumn_handle, BOOL Use_margins), NATIVE : @
"var LastCol: PAL4Column;"
"    LastCol := PAL4Column(X_C);"
"	 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: PAL4Column;"
   "    LastCol := PAL4Column(X_C);"
   "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: PAL4Column;
begin
    LastCol := PAL4Column(HC);
    LastCol.Label_width := Points(LabW);
end;

(*
/*

FUN Set_column_position_pixels(
INT C|olumn_handle, INT Left|_position, INT Top|_position),	
NATIVE : @ 
    "var Col: PAL4Column;"
	"	 if X_c = 0 then Exit;"
    "    Col := PAL4Column(X_c);"
	"	Col.Panel.Left := X_Left;" 
	"	Col.Panel.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: PAL4Column;"
	"	 if X_c = 0 then Exit;"
    "    Col := PAL4Column(X_C);"
	"	 Col.Panel.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: PAL4Column;"
	"	 if X_c = 0 then Exit;"
    "    Col := PAL4Column(X_C);"
	"	 Col.Panel.Height := X_Height;" .
	
*/
*)

procedure Do_Set_column_height(
	HC: Integer; const Height: Double);
var LastCol: PAL4Column;
begin
	if HC = 0 then Exit;
    LastCol := PAL4Column(HC);
    LastCol.Panel.Height := Points(Height);
    Adjust_control_location(LastCol, nil);
end;

procedure Do_Set_column_width(
	HC: Integer; const Width: Double);
var LastCol: PAL4Column;
begin
	if HC = 0 then Exit;
    LastCol := PAL4Column(HC);
    LastCol.Panel.Width := Points(Width);
    Adjust_control_location(LastCol, nil);
end;

(*
/*

FUN Set_form_column_auto_arrange(
	INT C|olumn_handle, BOOL A|uto_arrange),	
    NATIVE : 
@   "var LastCol: PAL4Column;"
    "   LastCol := PAL4Column(Pointer(X_C));"
    "   LastCol.auto_arrange := X_A;" 
    "   if X_A then Adjust_control_location(LastCol, nil);" .
*/
*)

procedure Set_default_font(const Face: String; Size: Integer);
begin
	Default_font := NewFont;
	Default_font.FontName := Face;
	Default_font.FontHeight := -Points(Size);
	Set_form_font_to_default := OK_Set_form_font_to_default;	
end;
(*
/*
    
FUN Set_default_forms_font(
{Screen} Screen|_holder,STR Face|name, REAL Size|points), NATIVE: @
"{$IFnDEF SMALLEST_CODE}"
"	Set_default_font(X_Face, Round(X_Size));" 
"{$ENDIF}" .    

FUN Set_form_column_font(
INT C|olumn_handle, 
STR Face | name,
REAL Size| font,
STR Styles| B_I_U_S), NATIVE : @
    "var LastCol: PAL4Column;"
    "   LastCol := PAL4Column(Pointer(X_C));"
    "	LastCol.Panel.Font.FontName := X_face;" 
    "	LastCol.Panel.Font.FontHeight := -Points(X_size);"
    "	LastCol.Panel.Font.FontStyle := [];"
    "	if pos('B', X_styles) > 0 then"
    "		LastCol.Panel.Font.FontStyle := [fsBold];" 
    "	if pos('I', X_styles) > 0 then"
    "		LastCol.Panel.Font.FontStyle := "
    "			LastCol.Panel.Font.FontStyle + [fsItalic];" 
    "	if pos('U', X_styles) > 0 then"
    "		LastCol.Panel.Font.FontStyle := "
    "			LastCol.Panel.Font.FontStyle + [fsUnderline];" 
    "	if pos('S', X_styles) > 0 then"
    "		LastCol.Panel.Font.FontStyle := "
    "			LastCol.Panel.Font.FontStyle + [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: PAL4Column;
begin
    LastCol := PAL4Column(HC);
    LastCol.Alias := Alias;
end;

(*
/*

FUN Disable_column_scroll(INT C|olumn_handle): .
//,
//        NATIVE : @
//"var LastCol: PAL4Column;"
//"    LastCol := PAL4Column(X_C);"
//"    LastCol.VertScrollbar.Visible := false;"
//.


// 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: PAL4Column;
begin
    Result := 0;
    if F = 0 then Exit;
    if  (Index < 0) or (Index >= PAL4Form(F).Columns.Count) then
        Exit;
    Col := PAL4Form(F).Columns.Items[Index];
    Result := Integer(Col);
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 :
	CASE C <= 0 ? ==> ;
	NATIVE @
    "var Col: PAL4Column;"
	"	 if X_C = 0 then Exit;"
    "    Col := PAL4Column(X_c);"
    "case X_W[1] of"
	"'L': RESULT := Col.Panel.Left;" 
	"'T': RESULT := Col.Panel.Top;" 
	"'W': RESULT := Col.Panel.Width;" 
	"'H': RESULT := Col.Panel.Height;"
	"end;" .

*/
*)

function Do_Get_column_width(
	X_C: Integer): Double;
var Col: PAL4Column;
begin
    Col := PAL4Column(X_C);
    Result := Pixels(Col.Panel.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: PAL4Column;
begin
    Col := PAL4Column(X_C);
    Result := Pixels(Col.Panel.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 Do_Get_parent_column_left(
	X_C: Integer): Double;
var ColPanel, C: PControl;
begin
	Result := 0;
    C := HackControl(X_C);
    ColPanel := C.Parent;
    if ColPanel <> nil then
    	Result := Pixels(ColPanel.Left);
end;

(*
/*

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 ColPanel, C: PControl;
begin
	Result := false;
    C := HackControl(X_C);
    ColPanel := C.Parent;
    if ColPanel <> nil then
    	Result := ColPanel.Visible;
end;

(*
/*
// Get column (parent to a certain control) left 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 ColPanel, C: PControl;
begin
	Result := 0;
    C := HackControl(X_C);
    ColPanel := C.Parent;
    if ColPanel <> nil then
    	Result := Pixels(ColPanel.Top);
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: PAL4Column;
begin
    Col := PAL4Column(X_C);
    Result := Col.Panel.Visible;
end;

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

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: PAL4Column;
begin
    Col := PAL4Column(X_C);
    Result := not Col.Panel.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 : @
    //"{$IFnDEF SMALLEST_CODE}"
    //"adjust_all_columns(X_F);"
    //"{$ENDIF}"
    "" .
    
FUN Get_form_mobile_config|uration(
INT F|orm_handle) ==> {Form}.{mobile_config} : .
	
FUN Set_form_mobile_config|uration(
INT F|orm_handle, {Form}.{mobile_config} MC|onfiguration_to_set): .
    
*/
*)

procedure Do_Set_column_visible(
	X_C: Integer; X_V: Boolean);
var Col: PAL4Column;
	F: PAL4Form;
begin
    Col := PAL4Column(X_C);
    if Col.Panel.Visible = X_V then Exit;
    Col.Panel.Visible := X_V;
    if X_V then
    begin
    	Adjust_control_location(Col, nil);
    	F := Col.AL4Form;
    	F.Form_resized(nil);
    end;
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: PAL4Column;
    F: PAL4Form;
    i: Integer;
begin
	if H = 0 then Exit;
    F := PAL4Form(Pointer(H));
    LastCol := F.Columns.Items[F.Columns.Count-1];
    if  LastCol.Horizontal then Exit;
    LastCol.Horizontal := TRUE;
    if  F.Columns.Count = 1 then
    begin
        //LastCol.Anchors := [];
        LastCol.Panel.Height := Points(20);
        LastCol.Panel.Width := F.Form.ClientWidth;
        //LastCol.Anchors := [akTop, akLeft, akRight];
        Exit;
    end;
    //LastCol.Anchors := [akLeft, akTop];
    LastCol.Panel.Height := Points(20);
    LastCol.Panel.Left := Points(2);
    LastCol.Panel.Top := F.Form.ClientHeight - LastCol.Panel.Height;
    for i := F.Columns.Count-2 downto 0 do
    begin
        PrevCol := F.Columns.Items[i];
        if  PrevCol.Horizontal then break;
        PrevCol.Panel.Height := LastCol.Panel.Top - PrevCol.Panel.Top;
    end;
    LastCol.Panel.Width := F.Form.ClientWidth;
    //LastCol.Anchors := [akLeft, akRight, akBottom];
end;

(*
/*

FUN Control_suspend({Control} T|he_control) : .
        
FUN Control_resume({Control} T|he_control) : .
// Destroy control object
//-----------------------

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 :
@"   if (X_Contr = 0) or (HackControl(X_Contr).RefCount < 0) then Exit;"
    "   HackControl(X_Contr).Free;" .
    
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 ColPanel: PControl;"
   "var col: PAL4Column;"
   "	if X_C.Count <= 0 then Exit;" /// very bad way, it's betterfind another solve     
   "	h := C_Control(X_C.Obj).F_Handle;" /// (problem with exception on form destroy)
   "	if h = 0 then Exit;"
   "	ColPanel := PControl(h).Parent;"
   "	col := PAL4Column(ColPanel.Tag);"
   "    RESULT := col.Alias;" .
    
*/
*)

(*
/*
// Terminate application immediately
//----------------------------------

FUN Application_terminate, NATIVE :
   @"    TerminateExecution(Applet);"
    "    //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: PAL4Form;
    W: PControl;
begin
	Result := NoneObj_C_Control.hard_link;
	if H = 0 then Exit;
    F := PAL4Form(Pointer(H));
    W := F.Form.ActiveControl;
    if  W = nil then Exit;
    Result := Pointer(W.Tag);
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: PControl;
    F: PAL4Form;
    i: Integer;
begin
	if H = 0 then Exit;
    C := HackControl(X);
    if  C.Handle <> 0 then
    begin
        F := PAL4Form(H);
        {$IFNDEF NOEXCEPTIONS}
        TRY
        {$ENDIF}
            //F.ActiveControl := C;
            for i := 1 to 100 do
            begin
                if C.ChildCount > 0 then
                   C := C.Children[0]
                else break;
            end;
            SetFocus(C.Handle);
        {$IFNDEF NOEXCEPTIONS}
        EXCEPT
        END;
        {$ENDIF}
    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: PControl;
begin
    C := HackControl(H);
    Result := Pixels(C.Left);
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: PControl;
begin
    C := HackControl(H);
    Result := Pixels(C.Top);
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: PControl;
begin
    C := HackControl(H);
    C.Left := Points(X);
    C.Top := Points(Y);
end;

(*
/*
// Is autosized ?
//---------------------------

FUN Is_autosized_control(
	INT C|ontrol_to_check_DUMMY) ==> BOOL
	:
    RESULT = TRUE .
*/
*)

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

FUN Get_control_width|_points(
{Control} C|ontrol_object) ==> REAL, NATIVE :
	INT h|andle_control = C.Handle
	CASE h == 0 ? ==> ;
	NATIVE @ "    RESULT := Do_Get_control_width(X_h);" .
*/
*)

function Do_get_control_width(
	H: Integer): Double;
var C: PControl;
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: PControl;
	B: KOL.PBitmap;
	g: PCanvas;
	sz: TSize;
begin
	C := HackControl(H);
	b := NewBitmap(1, 1);
	g := b.Canvas;
	g.Font.Assign(C.Font);
	sz := g.TextExtent(C.Caption);
	RESULT := Pixels(sz.cX);
	b.Free;
end;

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

FUN Get_control_height|_points(
{Control} C|ontrol_object) ==> REAL, NATIVE :
	INT h|andle_control = C.Handle
	CASE h == 0 ? ==> ;
	NATIVE @ "    RESULT := Do_Get_control_height(X_h);" .
*/
*)

function Do_get_control_height(
	H: Integer): Double;
var C: PControl;
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: PControl;" 
    "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: PControl;" 
    "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);" .
*/
*)
var setting_control_size: Integer;

procedure Do_Set_control_size(
	H: Integer; Width, Height: Double);
var C: PControl;
begin
    C := HackControl(H);
    inc(setting_control_size);
    C.Width := Points(Width);
    C.Height := Points(Height);
    dec(setting_control_size);
end;

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

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

var dummy_control: PControl;

function HackControl(
	H: Integer): PHackControl;
begin
	if H <> 0 then
	begin
		Result := PHackControl(H);
		Exit;
	end;
	if dummy_control = nil then
		dummy_control := NewLabel(nil, '');
	Result := PHackControl(dummy_control);
end;

procedure Do_Set_control_caption(
	H: Integer; const Text: String);
var sz: TSize;
begin
	if H = 0 then Exit;
    HackControl(H).GetWindowHandle;
    HackControl(H).Caption := Text;
    if (((HackControl(H)).fStyle.Value and BS_AUTOCHECKBOX) <> 0) and 
    	PAL4Column(HackControl(H).Parent).Horizontal then
    begin
    	sz := HackControl(H).Canvas.TextExtent(Text);
    	HackControl(H).Width := sz.cx + sz.cy * 2;
    end;
	if Assigned(HackControl(H).OnChange) then
		HackControl(H).OnChange(HackControl(H));
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;
//var C_H: Ref_obj;
begin
    //Result := '';
    //C_H := Ref_obj(HackControl(H).Tag);
    //if (C_H.Obj.Is_NONE_object) then Exit;
    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: PControl; A: TTextAlign;"
    "C := PControl(HackControl(X_h));"
    "case X_TA of"
    "0: A := taLeft;"
    "1: A := taCenter;"
    "2: A := taRight;"
    "end;"
    "C.TextAlign := 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;
begin
	Result := FALSE;
//?{Form}.disabled
    Result := not HackControl(H).Enabled;
//.
end;

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

FUN Set_control_disabled(
{Control} C|ontrol_objectl, 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);
//?{Form}.disabled
var hc: PHackControl;
//.
begin
//?{Form}.disabled
	hc := HackControl(H); 
    hc.Enabled := not B;
    {$IFNDEF SMALLEST_CODE}
    if hc.fControlClassName = 'STATIC' then Exit;
    {$ENDIF}
    //hc.Invalidate;
    if B then hc.Color := clBtnFace
    else hc.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 := FALSE;
//?{Form}.hidden
    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);
//?{Form}.hidden
var col: PControl;
	al4col: PAL4Column;
//.
begin
//?{Form}.hidden
	{$IFNDEF SMALLEST_CODE}
	if HackControl(H).Visible = not B then Exit;
	{$ENDIF}
    HackControl(H).Visible := not B;
    col := HackControl(H).Parent;
    if col <> nil then
    begin
    	al4col := Pointer(col.Tag); 
    	Adjust_control_location(al4col, nil);
    end;
//.
end;

(*
/*

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

FUN Set_control_foreground(
{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: PHackControl;"
	//"var F: PAL4Form;"
    "   C := HackControl(X_h);"
    //"	F := PAL4Form(X_fh);"
    //"	F.Form.CreateWindow;"     
    "   C.Font.Color := X_Color and $00FFFFFF;" 
    //"	C.Invalidate;"
    //"	Applet.ProcessMessages;"     
    .

FUN Get_control_background(
{Control} C|ontrol_object) ==> INT, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE
@   "var C: PHackControl;"
    "   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: PHackControl;"
    "   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: PHackControl;"
    "   C := HackControl(X_h);"
    "   RESULT := C.Font.FontName;" .

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

FUN Set_control_font_size(
{Control} C|ontrol_object, REAL Size|_set), NATIVE :
	INT h|andle_control = C.Handle
	NATIVE
@   "var C: PHackControl;"
    "   C := HackControl(X_h);"
    "   C.Font.FontHeight := -Round(Points(X_Size));" .
    
FUN Get_control_font_styles(
{Control} C|ontrol_object) ==> STR, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE
@   "var C: PHackControl;"
    "   C := HackControl(X_h);"
    "   if (fsBold in C.Font.FontStyle) then RESULT := RESULT + 'B';"
    "   if (fsItalic in C.Font.FontStyle) then RESULT := RESULT + 'I';"
    "   if (fsUnderline in C.Font.FontStyle) then RESULT := RESULT + 'U';"
    "   if (fsStrikeout in C.Font.FontStyle) 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: PHackControl;"
    "var fs: TFontStyle;"
    "var i: Integer;"
    "   C := HackControl(X_h);"
    "   fs := [];"
    "   for i := 1 to Length(X_St) do"
    "   begin"
    "       case X_St[i] of"
    "       'B': include(fs, fsBold);"
    "       'I': include(fs, fsItalic);"
    "       'U': include(fs, fsUnderline);"
    "       'S': include(fs, fsStrikeout);"
    "       end;"
    "   end;"
    "   C.Font.FontStyle := fs; " .
    
FUNCTION List_fonts_installed(
	INT Op|tions_1Mono_2True,
    STR Names|_of_fonts[]), NATIVE:
    "   Do_list_fonts(X_Op, X_Names);" .    
*/
*)

function EnumFontsProc(
	var LogFont: TLogFont; var TextMetric: TTextMetric;
	FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  DynAStr(Data).Add(MAXINT, LogFont.lfFaceName);
  Result := 1;
end;

var DC_fonts: HDC;

function EnumFixedFontsProc(
	var LogFont: TLogFont; var TextMetric: TTextMetric;
	FontType: Integer; Data: Pointer): Integer; stdcall;
var f, old: HFont;
    sz1, sz2: TSize;
begin
  if LogFont.lfPitchAndFamily and 3 = 1 then
  begin
     f := CreateFontIndirect(LogFont);
     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
            DynAStr(Data).Add(MAXINT, LogFont.lfFaceName);
     finally
        DeleteObject(f);
     end;
  end;
  Result := 1;
end;

procedure Do_list_fonts(
	Op: Integer; X_Names: DynAStr);
begin
    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;
end;

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

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

procedure Do_show_message(
	const s: String);
begin
    ShowMessage(s);
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_Text);" .

FUN Column_children_count(INT C|olumn_handle) ==> INT, NATIVE : @
   "var LastCol: PAL4Column;"
   "    LastCol := PAL4Column(X_C);"
   "RESULT := LastCol.Panel.ChildCount;" .

FUN Column_child(
INT C|olumn_handle, INT Index|_of_child) ==> {Control},NATIVE : @
   "var LastCol: PAL4Column;"
   "var	c: PControl;"     
   "    LastCol := PAL4Column(X_C);"
   "if (X_Index < 0) or (X_Index >= LastCol.Panel.ChildCount) then"
   "	c := nil"
   "else c := LastCol.Panel.Children[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;" 
   .

*/
*)

function Do_ask_yes_no(
	const s: String): Boolean;
begin
    Result := MessageBox(0, PChar(s), PChar(Applet.Caption), MB_YESNO)
           = IDYES;
end;

procedure dummy_Adjust_control_location(
	Parent: PAL4Column; C_new: PControl);
begin
end;

(*
/*

FUN Adjust_control_location(INT C|olumn_handle) : .

*/
*)



procedure Adjust_control_location_1(
	Parent: PAL4Column; C_new: PControl);
var Last: PControl;
    Column: PAL4Column;
    LWidth, NewWidth, NewHeight: Integer;
    j: Integer;
    C_C: C_Control;
    C: PControl;
    R_C: Ref_obj;
    R_Last: Ref_obj;
    last_is_label, current_is_label: Boolean;
    Last_anchor_bottom: PControl;
    total_h: Integer;
    dxy: Integer;
    {$IFnDEF SMALLER_CODE}
    hor_x, n_contr, gap, tot_w: Integer;
    hor_Last: PControl;
    {$ENDIF}
begin
	Adjust_control_location := Adjust_control_location_1;

    Column := nil;
    if Parent <> nil then Column := Parent;
    if  Column = nil then Exit;
    if Column.suspend_count > 0 then Exit;
    if not Column.auto_arrange then Exit;
    
    {$IFDEF SMALLER_CODE}
    
    if (C_new <> nil) and (Column.ListControls.IndexOf(C_new) < 0) then
        Column.ListControls.Add(C_new);
    
    dxy := 0;
    {$IFnDEF SMALLER_CODE}
    if Column.No_margins then
    	Column.Panel.HasBorder := false
    else if Column.AL4Form.Form.HasBorder then
    	dxy := Points(2);
    {$ENDIF}

	{$IFnDEF SMALLER_CODE}
        hor_Last := nil;
        tot_w := 0;
        n_contr := 0;
        for j := 0 to Parent.ListControls.Count-1 do
        begin
            C := Parent.ListControls.Items[j];
            if (C.Tag = 0) then continue;
        	if not C.ToBeVisible then continue;
            hor_Last := C;
            inc(tot_w, C.Width);
            inc(n_contr);
        end;
        
        hor_x := dxy;
        gap := 0;
        case Parent.controls_layout of
        1: hor_x := Parent.Panel.ClientWidth - tot_w - dxy * (n_contr - 1);
        2: begin // center
        		gap := (Parent.Panel.ClientWidth - tot_w - dxy * (n_contr - 1)) 
        			div (n_contr + 1);
        		if gap < 0 then gap := 0;
        		hor_x := gap;
           end;
        3: if n_contr > 1 then 
        	  gap := (Parent.Panel.ClientWidth - tot_w - dxy * (n_contr - 1)) 
        	  	mod (n_contr - 1);
        end;
        if hor_x < 0 then hor_x := 0;
        if Parent.controls_layout <> 4 then hor_Last := nil;
	{$ENDIF}

    Last := nil;
    Last_anchor_bottom := nil;
    total_h := 0;
    for j := 0 to Parent.ListControls.Count-1 do
    begin
        C := Parent.ListControls.Items[j];
        if (C.Tag = 0) then continue;
        if not C.ToBeVisible then continue;

        NewWidth := 0;
        if   (Last = nil) and not Parent.Horizontal then
        begin
            C.Left := dxy;
            C.Top := dxy;
        end;
        if (Last <> nil) or Parent.Horizontal then
        begin
            if Parent.Horizontal then
            begin
            	{$IFnDEF SMALLER_CODE}
					if C = hor_Last then
	            		C.Left := Parent.Panel.ClientWidth - C.Width - dxy
	            	else C.Left := hor_x;
	            	inc(hor_x, C.Width + dxy + gap);            
            	{$ELSE}
            		if Last <> nil then
	                	C.Left := Last.Left + Last.Width + dxy;
               	{$ENDIF}
               	C.Top := dxy;
            end
              else
            begin
               LWidth := Column.Panel.ClientWidth div 2;
               if  Column.Label_width > 0 then
                   LWidth := Column.Label_width;
               R_C := Ref_obj(C.Tag);
               R_Last := Ref_obj(Last.Tag);
               current_is_label := R_C.Obj.Tag <> 0;
               last_is_label := R_Last.Obj.Tag <> 0;
               if  not current_is_label and last_is_label and
                   (Last.Left + Last.Width <= LWidth) then
               begin
                   C.Top := Last.Top;
                   C.Left := LWidth;
               end else
               begin
                   C.Top := Last.Top + Last.Height + dxy;
                   C.Left := dxy;
               end;
               if not current_is_label then
               begin
                   NewWidth := Column.Panel.Width - dxy - dxy - C.Left;
                   if  NewWidth <> C.Width then
                       C.Width := NewWidth;
               end;
            end;
        end;
        if not Parent.Horizontal and (C.Tag <> 0) then
        begin
            R_C := Ref_obj(C.Tag);
            if  (NewWidth = 0) and (R_C.Obj.Tag = 0) then
                 NewWidth := Column.Panel.Width - dxy - dxy - C.Left;
            if  (NewWidth <> C.Width) and (NewWidth > 0) then
                C.Width := NewWidth;
        end;
        Last := C;
        if Last.Tag <> 0 then
        begin
	        C_C := C_Control(Ref_obj(Last.Tag).Obj);
	        if (C_C.F_Can_anchor_bottom and C_C.F_Anchor_bottom) then
	        begin
	        	Last_anchor_bottom := Last;
	        end;
        end;
        inc(total_h, Last.Height + dxy);
    end;
    if Parent.Horizontal and (Last <> Last_anchor_bottom) then
    	Last_anchor_bottom := nil;
    if (Last_anchor_bottom <> nil) then
    begin
        Last := Last_anchor_bottom;
        if Parent.Horizontal then
        begin
	        NewWidth := Column.Panel.Width - dxy - dxy - Last.Left;
	        if (NewWidth <> Last.Width) and (NewWidth > 0) then
	            Last.Width := NewWidth;
        end
        	else
        begin
	        NewHeight := Column.Panel.ClientHeight - dxy
	        			 - (total_h - Last.Height);
	        if (NewHeight <> Last.Height) and (NewHeight > 0) then
	            Last.Height := NewHeight;
        end;
    end;
    
    {$ELSE}
    
    unitC_Form.M_Do_adjust_controls(Column.AL4Form.AL4Object,
    		Integer(Column));
    
    {$ENDIF}
end;

procedure Set_control_events(
	Parent: PAL4Column; C: PControl);
var F: PAL4Form;
begin
    if  (Parent.AL4Form <> nil) then
    begin
        F := PAL4Form(Parent.AL4Form);
//?{Form}.click
        HackControl(Integer(C)).OnClick := F.Control_clicked;
//.
//?{Form}.resize
        HackControl(Integer(C)).OnResize := F.Control_resized;
//.

	    HackControl(Integer(C)).OnMouseMove := F.Control_mouse_move;
        HackControl(Integer(C)).OnMouseDown := F.Control_mouse_down;
        HackControl(Integer(C)).OnMouseUp := F.Control_mouse_up;
        HackControl(Integer(C)).OnMouseDblClk := F.Control_mouse_double_click;
        
//?{Form}.mouse_wheel
        HackControl(Integer(C)).OnMouseWheel := F.Control_mouse_wheel;
//.
        HackControl(Integer(C)).OnDestroy := F.Control_destroyed;
    end;
end;

procedure Set_Win_control_events(
	Parent: PAL4Column; C: PControl);
var F: PAL4Form;
begin
    if  (Parent.AL4Form <> nil) then
    begin
        F := PAL4Form(Parent.AL4Form);
//?{Form}.key_down
        C.OnKeyDown := F.Control_key_down;
//.
//?{Form}.key_up
        C.OnKeyUp := F.Control_key_up;
//.
//?{Form}.key_press
        C.OnChar := F.Control_key_press;
//.
    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);" .
*/
*)

procedure Do_begin_animation(
	X_H: Integer; X_Count: Integer; X_Interval: Integer);
//?{Control}.animation
var a: PAnimation_timer;
	i: Integer;
	C, Col: PControl;
	ACol: PAL4Column;
	F: PAL4Form;
//.
begin
//?{Control}.animation
	C := HackControl(X_H);
	Col := C.Parent;
	ACol := PointeR(Col.Tag);
	F := ACol.AL4Form;
	if F.Control_timers <> nil then
		for i := F.Control_timers.Count-1 downto 0 do
		begin
			a := F.Control_timers.Items[i];
			if a.Control_handle = X_H then
			begin
				a.Counter := 0;
				a.Last_counter := X_Count;
				a.T.Interval := X_Interval;
				Exit;
			end;
		end;
    new(a, Create(X_H, X_Count, X_Interval));
//.
end;

(*
/*

FUNCTION Capture_mouse(
	INT H|andle_control ), NATIVE :
@   "var C: PControl;"
    "//var F: PControl;"
    "    C := HackControl(X_H);"
    "    //F := C.ParentForm;"
    "    SetCapture(C.Handle);" .
    
FUNCTION Release_mouse( INT H|andle_control ), NATIVE :
@   "    ReleaseCapture;" .

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: PControl;"
	"	 if X_C = 0 then Exit;"
    "    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);" .
*/
*)

function Do_Create_label(
	P: Integer; X_L: Pointer): Integer;
//?{Label}
var Parent: PAL4Column;
    L: PControl;
    F: PAL4Form;
//.
begin
	Result := 0;
//?{Label}
	F := PAL4Form(Pointer(P));
    Parent := PAL4Column(F.Get_current_column_handle);
    L := NewLabel(Parent.Panel, '');
    L.Tag := Integer(X_L);
    PObj(X_L).Tag := DWORD(L);
    L.AutoSize(TRUE);
    Adjust_control_location_1(Parent, L);
    Set_control_events(Parent, L);
    Result := Integer(L);
//.
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) .

FUN do_create_button(INT F|orm_handle,
    {Control} B|utton_create) ==> INT, NATIVE :
    "     Result := do_create_button(X_F, X_B);" .
*/
*)

function Do_Create_button(
	P: Integer; X_B: Pointer): Integer;
//?{Button}
var Parent: PAL4Column;
    B: PControl;
    F: PAL4Form;
//.
begin
//?{Button}
    F := PAL4Form(Pointer(P));
    Parent := PAL4Column(F.Get_current_column_handle);
    B := NewButton(Parent.Panel, '');
    B.aAutoSzX := 24;
    B.Tag := Integer(X_B);
    PObj(X_B).Tag := DWORD(B);
    B.AutoSize(TRUE);
    
    Adjust_control_location_1(Parent, B);
    Set_control_events(Parent, B);
    Set_Win_control_events(Parent, B);
    Result := Integer(B);
//.
end;

(*
/*

FUN Set_form_default_button(
	INT H|andle_form, INT B|utton_handle),
    NATIVE :
	"Do_Set_form_default_button(X_H, X_B);" .
	    
FUN Set_form_cancel_button(
	INT H|andle_form, INT B|utton_handle),
    NATIVE :
	"Do_Set_form_cancel_button(X_H, X_B);" .
*/
*)

procedure Do_Set_form_default_button(
	X_H: Integer; X_B: Integer);
//?{Button}
var F: PAL4Form;
var B: PControl;
//.
begin
//?{Button}
    F := PAL4Form(X_H);
    B := HackControl(X_B);
    if F.Default_button <> nil then
       F.Default_button.DefaultBtn := FALSE;
    F.Default_button := B;
    if B <> nil then B.DefaultBtn := TRUE;
//.
end;
    
procedure Do_Set_form_cancel_button(
	X_H: Integer; X_B: Integer);
//?{Button}
var F: PAL4Form;
var B: PControl;
//.
begin
//?{Button}
    F := PAL4Form(X_H);
    B := HackControl(X_B);
    if F.Cancel_button <> nil then
       F.Cancel_button.CancelBtn := FALSE;
    F.Cancel_button := B;
    if B <> nil then B.CancelBtn := TRUE;
//.
end;

//------------------------------------------------- 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);" .
*/
*)

function Do_Create_checkbox(
	P: Integer; X_C: Pointer): Integer;
var Parent: PAL4Column;
    C: PControl;
    F: PAL4Form;
begin
    F := PAL4Form(Pointer(P));
    Parent := PAL4Column(F.Get_current_column_handle);
    C := NewCheckBox(Parent.Panel, '');
    //C.Autosize(false);
    C.Tag := Integer(X_C);
    PObj(X_C).Tag := DWORD(C);
    
    Adjust_control_location_1(Parent, C);
    Set_control_events(Parent, C);
    Set_Win_control_events(Parent, C);
    C.OnClick := PAL4Form(Parent.AL4Form).Control_changed;
    Result := Integer(C);
end;

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

FUN Get_checkbox_checked(
{Control} C|ontrol_object) ==> BOOL, NATIVE :
	INT h|andle_control = C.Handle
	NATIVE @ "    RESULT := HackControl(X_h).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
	NATIVE
@	"var hc: PControl;"
	"	 hc := HackControl(X_h);"
	"	 if hc.Checked = X_V then Exit;"
    "    hc.Checked := X_V;" .
    
// Get checkbox text 
//-------------------------------------------------------

//FUN Get_checkbox_text(
//    INT C|heckbox_handle) ==> STR, NATIVE :
//   @"    RESULT := HackControl(X_C).Text;" .

// Set checkbox text
//-------------------------------------------------------

//FUN Set_checkbox_text(
//    INT C|heckbox_handle,
//    STR T|ext_set), NATIVE :
//   @"    HackControl(X_C).Text := 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);" .
*/
*)

function Do_Create_edit(
	P: Integer; X_E: Pointer; X_Password: String; X_Readonly: Boolean): Integer;
var Parent: PAL4Column;
    E: PControl;
    F: PAL4Form;
    eo: TEditOptions;
begin
    F := PAL4Form(Pointer(P));
    Parent := PAL4Column(F.Get_current_column_handle);
    eo := [];
    if  X_Password <> '' then eo := [eoPassword];
    if  X_Readonly then include(eo, eoReadOnly);
    E := NewEditBox(Parent.Panel, eo);
    if  X_Readonly then E.Color := clBtnFace else E.Color := clWindow;
    E.Tag := Integer(X_E);
    PObj(X_E).Tag := DWORD(E);
    
    //if X_Password <> '' then E.PasswordChar := X_Password[1];
    Adjust_control_location_1(Parent, E);
    Set_control_events(Parent, E);
    Set_Win_control_events(Parent, E);
    E.OnChange := PAL4Form(Parent.AL4Form).Control_changed;
    Result := Integer(E);
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: PControl;
begin
    E := HackControl(X_E);
    Result := E.Selection;
end;

(*
/*

FUN Get_edit_selection_start(
	INT E|dit_control) ==> INT, NATIVE :
@   "var T: PControl;"
    "    T := HackControl(X_E);"
    "    RESULT := T.SelStart;" .

FUN Get_edit_selection_length(
	INT E|dit_control) ==> INT, NATIVE :
@   "var T: PControl;"
    "    T := HackControl(X_E);"
    "    RESULT := T.SelLength;" .

FUN Set_edit_selection_range(
	INT E|dit_control, INT Start|_selection,
    INT Length|_selection), NATIVE :
@   "var T: PControl;"
    "    T := HackControl(X_E);"
    "    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: PControl;
begin
    E := HackControl(X_E);
    E.ReplaceSelection(X_Text, TRUE);
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: PControl;
begin
    E := HackControl(X_E);
    //E.MaxTextSize := X_V;
    E.Perform(EM_SETLIMITTEXT, X_V, 0);
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: PControl;
begin
    E := HackControl(X_E);
    if  Length(X_V) = 0 then
        E.Style := E.Style and not ES_PASSWORD
    else E.Style := E.Style or ES_PASSWORD;
end;

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

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

FUN Create_memo({Control} M|emo_control,
	STR Op|tions_Readonly_Horizontalscroll_Verticalscroll) ==> INT
	:
    INT form|_handle = M.Form_.Handle
    RESULT = do_Create_memo(form, M, "R" IN Op, "H" !IN Op, "V" !IN Op) .
FUN do_Create_memo(INT Form|_handle, {Control} Memo|_control,
            BOOL Read|_only,
            BOOL No_h|scroll,
            BOOL No_v|scroll) ==> INT, NATIVE : @
    "   Result := do_create_memo(X_form, X_Memo, X_Read, X_No_h, X_No_v);" .
*/
*)

function Do_Create_memo(
	P: Integer; X_M: Pointer;
    X_Read, NoH, NoV: Boolean): Integer;
var Parent: PAL4Column;
    M: PControl;
    F: PAL4Form;
    eo: TEditOptions;
begin
    F := PAL4Form(Pointer(P));
    Parent := PAL4Column(F.Get_current_column_handle);
    eo := [eoMultiline];
    if X_Read then include(eo, eoReadonly);
    if NoV then include(eo, eoNoVScroll);
    if NoH then include(eo, eoNoHScroll);
    M := NewEditBox(Parent.Panel, eo);
    
    //M.ScrollBars := ssVertical;
    //M.MakeWordWrap;
    M.Tag := Integer(X_M);
    PObj(X_M).Tag := DWORD(M);
    
    Adjust_control_location_1(Parent, M);
    Set_control_events(Parent, M);
    Set_Win_control_events(Parent, M);
    M.OnChange := PAL4Form(Parent.AL4Form).Control_changed;

    Result := Integer(M);
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: PControl;
begin
    M := HackControl(X_M);
    Result := '';
    if  (Row >= 0) and (Row < M.Count) then
        Result := M.Items[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: PControl;
begin
    M := HackControl(X_M);
    if  Row = M.Count then
        M.Add(Value + #13#10)
    else
    if  (Row >= 0) and (Row < M.Count) then
        M.Items[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: PControl;
begin
    M := HackControl(X_M);
    Result := M.Selection;
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: PControl;
begin
    M := HackControl(X_M);
    M.ReplaceSelection(X_Text, TRUE);
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: PControl;
begin
    M := HackControl(X_M);
    Result := M.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: PControl;
begin
    M := HackControl(X_M);
    //M.MaxTextSize := X_V;
    M.Perform(EM_SETLIMITTEXT, X_V, 0);
end;

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

FUN Get_memo_range_sel(
INT M|emo_control) ==> {Control}.{from_to}
	:
	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: PControl;"
    "M := HackControl(X_M);"
    "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)
	:
	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: PControl;"
    "M := HackControl(X_M);"
    "M.SelStart := X_From;"
    "M.SelLength := X_To - X_From;"
    .
    
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
	CASE line_h < 0 ? line_h = -line_h ;
	//DEBUG: "line_h= " line_h #NL ;
	NATIVE@
"var M: PControl; C, LL1C, LLLC: Integer; xy: DWORD; e: TPoint;"
"M := HackControl(X_handle);"
"C := M.Perform(EM_GETLINECOUNT, 0, 0);"
"RESULT := TRUE;"     
"if C=0 then Exit;"
"if (C=1) and (Trim(M.Text) = '') then Exit;"     
"LL1C := M.Perform(EM_LINEINDEX, C-1, 0);"
"LLLC := LL1C + M.Perform(EM_LINELENGTH, LL1C, 0)-1;"     
"xy := M.Perform(EM_POSFROMCHAR, LLLC, 0);"
"e.X := xy and $FFFF;"
"e.Y := (xy shr 16) and $FFFF;"
"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, NATIVE
    :
    "     Result := Do_Create_listbox(X_L, X_Multi);" .
*/
*)

function Do_Create_listbox(
	X_L: Ref_obj; 
	X_Multiselect: Boolean): Integer;
//?{Listbox}
var Parent: PAL4Column;
    L: PControl;
    F: PAL4Form;
    Options: TListOptions;
    h: Integer;
//.
begin
	Result := 0;
//?{Listbox}
	h := C_Form(C_Listbox(X_L.Obj).F_Form_.Obj).F_Handle;
    F := PAL4Form(h);
    Parent := PAL4Column(F.Get_current_column_handle);
    
    Options := [];
    if X_Multiselect then Options := [loMultiselect];
    L := NewListBox(Parent.Panel, Options);
    L.Tag := Integer(X_L);
    PObj(X_L).Tag := DWORD(L);
   
    Adjust_control_location_1(Parent, L);
    Set_control_events(Parent, L);
    Set_Win_control_events(Parent, L);
    L.OnSelChange := PAL4Form(Parent.AL4Form).Selection_changed;
    Result := Integer(L);
//.
end;

(*
/*

FUNCTION Listbox_clear(
	INT H|andle_listbox), NATIVE :
@   "var L: PControl;"
    "    L := HackControl(X_H);"
    "    L.Clear;" .

// Return listbox item string by its index
//----------------------------------------------------------------------

FUN Get_listbox_item(
	INT L|istbox_control, INT Index|_item) ==> STR,
    NATIVE :
   @"var L: PControl;"
    "    L := HackControl(X_L);"
    "    Result := '';"
    "    if (X_Index < 0) or (X_Index >= L.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: PControl;"
    "    L := HackControl(X_L);"
    "    if (X_Index < 0) or (X_Index >= L.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: PControl;"
    "    L := HackControl(X_L);"
    "    Result := L.Count;" .
    
// Add listbox item string 
//----------------------------------------------------------------------

FUN Listbox_add_item(
	INT L|istbox_control, STR Value|_set) ==> INT,
    NATIVE :
   @"var L: PControl;"
    "    L := HackControl(X_L);"
    "    L.Add(X_Value);"
    "    Result := L.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: PControl;"
    "    L := HackControl(X_L);"
    "    Result := -1;"
    "    if (X_Index < 0) or (X_Index > L.Count) then Exit;"
    "    L.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: PControl;"
    "    L := HackControl(X_L);"
    "    if (X_Index < 0) or (X_Index >= L.Count) then Exit;"
    "    L.Delete(X_Index);" .


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

FUN Listbox_select_item(
	{Listbox} L|istbox_control, INT Index|_delete,
    BOOL Select|_or_deselect), NATIVE :
	INT h|andle_control = L.Handle
 	NATIVE @
    "var L: PControl;"
    "    L := HackControl(X_h);"
    "    if (X_Index < 0) or (X_Index >= L.Count) then Exit;"
    "    if (L.CurIndex >= 0) and (L.Style and LBS_MULTIPLESEL = 0) then"
    "       L.ItemSelected[L.CurIndex] := FALSE;"
    "    L.ItemSelected[X_Index] := X_Select;" 
    .


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

FUN Listbox_select_all(
	{Listbox} L|istbox_control), NATIVE :
	INT h|andle_control = L.Handle
 	NATIVE @
	"Do_Listbox_select_all(X_h);" .
	
*/
*)

procedure Do_Listbox_select_all(
	X_L: Integer);
//?{Listbox}
var L: PControl;
var C_L: Ref_obj;
//.
begin
//?{Listbox}
    L := HackControl(X_L);
    C_L := Ref_obj(L.Tag);
    if  (C_Listbox(C_L.Obj).F_Multiselect) then Exit;
    L.SelectAll;
//.
end;
    
(*
/*
TODO: "check if Select_all works for list box in KOL this way" .


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

FUN Listbox_select_none(
	{Listbox} L|istbox_control), NATIVE :
	INT h|andle_control = L.Handle
 	NATIVE @
    "var L: PControl;"
    "    L := HackControl(X_h);"
    "    L.CurIndex := -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: PControl;"
    "    L := HackControl(X_h);"
    "    Result := L.SelLength;" .


// Delete all selected items in listbox
//----------------------------------------------------------------------

FUN Listbox_delete_selected(
	{Listbox} L|istbox_control), NATIVE :
	INT h|andle_control = L.Handle
 	NATIVE @
    "var L: PControl;"
    "var i: Integer;"
    "    L := HackControl(X_h);"
    "    for  i := L.Count-1 downto 0 do"
    "    if (L.ItemSelected[i]) then"
    "        L.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
 	NATIVE @
	"RESULT := Do_Listbox_get_next_sel(X_h, X_From);" .
*/
*)

function Do_Listbox_get_next_sel(
	X_L: Integer; X_From: Integer): Integer;
//?{Listbox}
var L: PControl;
var i: Integer;
var C_L: Ref_obj;
//.
begin
//?{Listbox}
    L := HackControl(X_L);
    Result := -1;
    if (L.SelLength = 0) then Exit;
    C_L := Ref_obj(L.Tag);
    if not C_Listbox(C_L.Obj).F_Multiselect then
    begin
       Result := L.CurIndex;
       Exit;
    end;
    if (X_From < -1) then X_From := -1;
    for i := X_From+1 to L.Count-1 do
    if (i > X_From) and (L.ItemSelected[i]) then
    begin
       Result := i;
       Exit;
    end;
//.
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);" .
*/
*)

function Do_Create_combo(
	P: Integer; X_C: Pointer): Integer;
var Parent: PAL4Column;
    C: PControl;
    F: PAL4Form;
begin
    F := PAL4Form(Pointer(P));
    Parent := PAL4Column(F.Get_current_column_handle);
    C := NewComboBox(Parent.Panel, []);
    //C.Visible := true;
    C.Tag := Integer(X_C);
    PObj(X_C).Tag := DWORD(C);
    
    C.Style := C.Style or CBS_DROPDOWNLIST;
    Adjust_control_location_1(Parent, C);
    Set_control_events(Parent, C);
    Set_Win_control_events(Parent, C);
    C.OnChange := PAL4Form(Parent.AL4Form).Control_changed;
    C.OnSelChange := PAL4Form(Parent.AL4Form).Selection_changed;
    Result := Integer(C);
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: PControl;
    L: PStrList;
    i: Integer;
begin
    C := HackControl(X_C);
    C.BeginUpdate;
    L := NewStrList;
    TRY
        C.Clear;
        L.Text := X_V;
        for i := 0 to L.Count-1 do
            C.Add(L.Items[i]);
    FINALLY
        C.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: PControl;
begin
    C := HackControl(X_C);
    Result := C.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: PControl;
begin
    C := HackControl((X_C));
    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: PControl;
begin
    C := HackControl((X_C));
    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: PControl;
begin
    C := HackControl((X_C));
    Result := C.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: PControl;
begin
    C := HackControl((X_C));
    Result := C.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: PControl;
begin
    C := HackControl((X_C));
    C.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: PControl;
begin
    C := HackControl((X_C));
    Result := C.CurIndex;
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: PControl;
begin
    C := HackControl((X_C));
    if  (X_Index >= -1) and (X_Index < C.Count) then
    begin
        C.CurIndex := 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: PControl;
begin
    C := HackControl((X_C));
    Result := '';
    if C.CurIndex >= 0 then
       Result := C.Items[C.CurIndex];
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: PControl;
begin
    C := HackControl((X_C));
    if C.CurIndex >= 0 then
       C.Items[C.CurIndex] := X_Text;
end;

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

(*
/*
// Create progress 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);" .
*/
*)

function Do_Create_progress_bar(
	P: Integer; X_P: Pointer): Integer;
//?{Progress}
var Parent: PAL4Column;
    PB: PControl;
    F: PAL4Form;
//.
begin
//?{Progress}
    F := PAL4Form(Pointer(P));
    Parent := PAL4Column(F.Get_current_column_handle);
    PB := NewProgressbarEx(Parent.Panel, [pboSmooth]);
    PB.Tag := Integer(X_P);
    PObj(X_P).Tag := DWORD(PB);
    
    Adjust_control_location_1(Parent, PB);
    Set_control_events(Parent, PB);
    Result := Integer(PB);
//.
end;

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

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

function Do_Get_progress_bar_progress(
	X_P: Integer): Integer;
//?{Progress}
var P: PControl;
//.
begin
//?{Progress}
    P := HackControl((X_P));
    Result := P.Progress;
//.
end;

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

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

procedure Do_Set_progress_bar_progress(
	X_P: Integer; X_V: Integer);
//?{Progress}
var P: PControl;
//.
begin
//?{Progress}
    P := HackControl((X_P));
    P.Progress := X_V;
//.
end;

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

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

function Do_Get_progress_bar_maximum(
	X_P: Integer): Integer;
//?{Progress}
var P: PControl;
//.
begin
//?{Progress}
    P := HackControl((X_P));
    Result := P.MaxProgress;
//.
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, Trunc(X_V));" .
*/
*)

procedure Do_Set_progress_bar_maximum(
	X_P, X_V: Integer);
//?{Progress}
var P: PControl;
//.
begin
//?{Progress}
    P := HackControl((X_P));
    P.MaxProgress := 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.
//----------------------------------------------------------------------------


var FormWhichPopupMenu: PAL4Form;
var HookHandle: DWORD = 0;

function HookMsgProc(
Code: {$IFDEF FPC} LongInt {$ELSE} Integer {$ENDIF};
wParam: {$IFDEF FPC} LongInt {$ELSE} WPARAM {$ENDIF}; 
lParam: {$IFDEF FPC} LongInt {$ELSE} Integer {$ENDIF}): Integer;
		 stdcall;
//?{Form}.menu_item
	{$DEFINE HOOK_HANDLE}
var MInfo: TMenuItemInfo;
	sbuf: PAnsiChar;
	len, i: Integer;
	s, a: String;
	F: C_Form;
	MP: PMenuPanel;
	Item, Subitem, SubItem0: PMenu;
	L: PCWPStruct;
//.
begin
//?{Form}.menu_item
	if Code = HC_Action then
	begin
		L := PCWPStruct(Pointer(lParam));
		if (L^.message = WM_MENUSELECT) and 
		   (FormWhichPopupMenu <> nil) then
		begin
			MP := PMenuPanel(FormWhichPopupMenu.MenuPanel_to_destroy);
			if MP <> nil then 
			begin
	            a := '';
	            SubItem := nil;
	            for i := 0 to MP.MenuObject.Count-1 do
	            begin
	            	Item := MP.MenuObject.Items[i];
	                if (Item.Handle = L^.LParam) and (SubItem = nil) then
	                begin
	                    SubItem0 := Item.Items[0];
	                    if SubItem0 <> nil then
		                    SubItem := Item.Items[
		                        (L^.WParam and $FFFF) - SubItem0.Tag];
	                end;
	                if SubItem = Item then
	                begin
	                    a := MP.AliasesList.Items[i];
	                    break;
	                end;
	            end;
			    F := C_Form(FormWhichPopupMenu.AL4Object.Obj); 
			    F.F_menu_alias := a;
			    
			    operation_started(F, 6, nil);
			    {$IFnDEF NOTRY}
			    try
			    {$ENDIF}
			    unitC_Form.M_Notify_sel_change(FormWhichPopupMenu.AL4Object);
			    {$IFnDEF NOTRY}
			    except on EStop: Stop_exception do;
			    end;
			    {$ENDIF}
			    F.M_operation_ended(6);
			    
			    F.F_menu_alias := '';
			end;
		end;
	end;
	Result := CallNextHookEx(HookHandle, Code, WParam, LParam);
//.
end;


//?{Form}.selection_change
	{$DEFINE SEL_CHANGE}
//.


//?{Form}.menu_item

function Do_create_menu(
	P: Integer; X_V: DynAStr): PMenuPanel;
var Parent: PAL4Column;
    M: PMenuPanel;
    i, j: Integer;
    F: PAL4Form;
    template_s: array of String;
    template_p: array of PChar;
    s, a, aa: String;
    mi: PMenu;
    item_index: Integer;
begin
    F := PAL4Form(P);

    //-------------------------------- ''
	if  F.Main_menu_dummy <> nil then
    begin
		Free_And_Nil(F.Main_menu_dummy);
        HackControl(Integer(F.Form)).fMenuObj := nil;
    end;
    if  F.Main_menu_dummy = nil then
    begin
        F.Main_menu_dummy := NewMenu(F.Form, 0, [], nil);
        F.Main_menu_dummy.OnDestroy := F.MainMenu_destroyed;
    end;

    Parent := PAL4Column(F.Get_current_column_handle);

    //---------------------------------------- 'release old menu panel'
    if F.MenuPanel_to_destroy <> nil then
    begin
        F.MenuPanel_to_destroy.Free;
        F.MenuPanel_to_destroy := nil;
    end;

    //---------------------------- 'setup menu panel'
    new(M, Create);
    M.Form_ := F;
    F.MenuPanel_to_destroy := M;

    Result := M;

    //---------------------- now fill menu items tree
    M.AliasesList := NewStrList;

    SetLength(template_s, X_V.Count);
    SetLength(template_p, X_V.Count);
    for i := 0 to X_V.Count-1 do
    begin
        s := X_V.GetStrings(i);
        if (s = '(') or (s = ')') then
        else
        begin
            j := Pos(':', s);
            if  j > 0 then
            begin
                a := Trim(Copy(s, 1, j-1));
                if pos(',', a) > 0 then
                    a :=Trim(Copy(a, 1, pos(',', a) - 1));
                M.AliasesList.Add(a);
                s := Copy(s, j+1, MaxInt);
            end
            else M.AliasesList.Add(s);
        end;
        template_s[i] := s;
        template_p[i] := PChar(template_s[i]);
    end;

    //----------------------------------------------------- 'checked / enabled'
    M.MenuObject := NewMenu(F.Form, 4096, template_p, M.Item_click);
    item_index := -1;
    for i := 0 to X_V.Count-1 do
    begin
        s := X_V.GetStrings(i);
        if (s = '(') or (s = ')') then
        begin
        	if (s = ')') and (i > 0) and (X_V.GetStrings(i-1) = '(')
        		and (item_index >= 0) then
        	begin
        		mi := M.MenuObject.Items[item_index];
        		mi.Enabled := false;
        	end;
        end
        else
        begin
            inc(item_index);
            j := Pos(':', s);
            if  j > 0 then
            begin
                a := Copy(s, 1, j-1);
                aa := LowerCase(a);
                mi := M.MenuObject.Items[item_index];
                if pos(',d', aa) > 0 then mi.Enabled := false;
                if pos(',c', aa) > 0 then mi.Checked := true;
            end;
        end;
    end;
{$IFDEF HOOK_HANDLE}
{$IFDEF SEL_CHANGE}
	if HookHandle = 0 then
	begin
	   	HookHandle 
	   		:= SetWindowsHookExA(
	   		WH_CALLWNDPROC, @HookMsgProc, 0, GetCurrentThreadId);
	end;
{$ENDIF}
{$ENDIF}
end;

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

procedure Do_Destroy_menu(
	MP: PMenuPanel);
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)
    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);" .
*/
*)

//?{Form}.selection_change
{$DEFINE STORE_WHICH_POPUP_MENU}
//.

procedure Do_Popup_menu(
X_F: Integer; X_M: DynAStr; X_X, X_Y: Double);
//?{Form}.menu_item
var MP: PMenuPanel;
    F: PAL4Form;
    P: TPoint;
//.
begin
//?{Form}.menu_item
    MP := Do_create_menu(X_F, X_M);
    F := nil;
    if  (MP.Form_ <> nil) then
        F := PAL4Form(MP.Form_);
    MP.Ready := FALSE;
    MP.Alias := '';
    P := MakePoint(Points(X_X), Points(X_Y));
    if F <> nil then
    begin 
    	P := F.Form.Client2Screen(P);
    	{$IFDEF STORE_WHICH_POPUP_MENU}
    	FormWhichPopupMenu := F;
    	{$ENDIF}
    end
    	else
    begin
    	{$IFDEF STORE_WHICH_POPUP_MENU}
    	FormWhichPopupMenu := F;
    	{$ENDIF}
    end;
    //Writeln('Popup at: ' + IntToStr(P.X) + ' ' + IntToStr(P.Y));
    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;
//?{Form}.timer
var Parent: PAL4Column;
    TP: PTimerPanel;
    F: PAL4Form;
//.
begin
//?{Form}.timer
    F := PAL4Form(P);
    Parent := PAL4Column(F.Get_current_column_handle);
    TP := NewTimerPanel(Parent.Panel);
    TP.Visible := FALSE;
    TP.Width := 0;
    TP.Height := 0;
    TP.TimerObject := NewTimer(1000);
    TP.TimerObject.Enabled := FALSE;
    TP.TimerObject.Tag := Integer(TP);
    
    TP.TimerObject.OnTimer := F.Form_timer_tick;
    TP.Tag := Integer(X_T);
    PObj(X_T).Tag := DWORD(TP);
    
    Result := Integer(TP);
//.
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);
//?{Form}.timer
var TP: PTimerPanel;
//.
begin
//?{Form}.timer
    TP := PTimerPanel(X_T);
    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 :
    "    do_set_timer_active(X_T, X_A);" .
*/
*)

procedure Do_Set_timer_active(
	X_T: Integer; X_A: Boolean);
//?{Form}.timer
var TP: PTimerPanel;
//.
begin
//?{Form}.timer
    TP := PTimerPanel(X_T);
    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);" .
*/
*)

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

procedure Do_timeBeginPeriod(p: Integer);
begin
	timeBeginPeriod(p);
end;

procedure Do_timeEndPeriod(p: Integer);
begin
	timeEndPeriod(p);
end;

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

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

{ TAL4Column }

// Create column

constructor TAL4Column.CreateColumn;
begin
  inherited Create;
  //BevelOuter := bvNone;
  ListControls := NewList;
  auto_arrange := true;
  //BorderStyle := bsNone;
  //HasBorder := FALSE;
end;

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

procedure TAL4Column.Resize;
begin
    inherited;
    Adjust_control_location(@Self, nil);
end;


{ PAL4Form }

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

FUN Get_form_popup_point(
	INT F|orm_handle) ==> {Geometry}.{point}
	:
	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: PAL4Form;"
    "    F := PAL4Form(X_F);"
    "    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: PAL4Form;"
    "    F := PAL4Form(X_F);"
    "    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}
	:
	RESULT.X = do_Get_mouse_point(F, "X")
	RESULT.Y = do_Get_mouse_point(F, "Y") .
FUN do_Get_mouse_point(INT F|orm_handle, STR What|_coordinate) ==> REAL,
NATIVE : @
    "var F: PAL4Form;"
    "    F := PAL4Form(X_F);"
    "	if X_What = 'X' then RESULT := F.Mouse_point.f_X"
    "					else RESULT := F.Mouse_point.f_Y;" . 
    
// Get mouse button clicked
//-------------------------------------------------

FUN Form_mouse_button(
	INT F|orm_handle) ==> {Form}.{button}, NATIVE :
    "    Result := PAL4Form(X_F).Mouse_button;" .
    
// Get mouse wheel distance
//-------------------------------------------------

FUN Form_vertical_wheel(
	INT F|orm_handle) ==> REAL, NATIVE :
    "    Result := PAL4Form(X_F).Mouse_wheel_vertical;" .
    
// Get mouse wheel horizontal distance
//-------------------------------------------------

FUN Form_horizontal_wheel(
	INT F|orm_handle) ==> REAL, NATIVE :
    "    Result := PAL4Form(X_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;"
	"	 GetCursorPos(P);"
    "    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 := GetAsyncKeyState(code) < 0;" .
	
FUN Is_keyboard_key_pressed(
INT Key|_interesting) ==> BOOL, NATIVE : @
"RESULT := GetAsyncKeyState(X_Key) < 0;" .

FUN Control_click(
{Control} C|ontrol_which_click_should_be_handled)
	: C.Form_.click .
        
*/
*)


// Event: control is clicked

procedure TAL4Form.Control_clicked(
	Sender: PObj);
//?{Form}.click
var C: PControl;
    R: Ref_obj;
    P: TPoint;
    F: C_Form;
//.
begin
//?{Form}.click
    C := PControl(Sender);
    R := Pointer(C.Tag);
    P := MakePoint(0, C.Height);
    P := C.Client2Screen(P);
    P := Form.Screen2Client(P);
    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 ); 
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then Exit;
    //******************************
	{$ENDIF}
    
    operation_started(F, 0, R);
    try
    F.M_Click;
    finally
    F.M_operation_ended(0);
    end;
    
    //Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, NoneObj_C_Control);
//.
end;

procedure call_radio_select(F: C_Form; R: Ref_obj);
begin
//?{Checkbox}
    if not AL4.Is_none(AL4.As_obj(R, NoneObj_C_Checkbox.hard_link)) then
    	C_Checkbox(R.Obj).M_radio_select(R);
//.
end;

procedure TAL4Form.Control_changed(
	Sender: PObj);
var F: C_Form;
    R: Ref_obj;
	C: PControl;
//?{Form}.value_change
//.
begin
    F := C_Form( AL4Object.Obj );
    C := PControl(Sender);
    R := Pointer(C.Tag);
//?{Form}.value_change

    //Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, R.Obj);
    //F.F_sender_alias := C_Control(R.obj).F_Alias;
    
    operation_started(F, 5, R);
    try
//.
//?{Checkbox}
    call_radio_select(F, R);
//.
    F.M_value_change;
////?{Form}.value_change
    F.M_Any_change;
////.
//?{Form}.value_change
    finally
    F.M_operation_ended(5);
    end;
    
    //Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, NoneObj_C_Control);
//.
end;

(*
/*

FUNCTION Control_selection_change(
	{Control} C|ontrol_changed)
	:
    PUSH C.Form_.sender_ = C :
         //PUSH C.Form_.sender_alias = C.Alias :
              {Form}.Notify_sel_change(C.Form_)
         //;
    ; .
*/
*)

procedure TAL4Form.Selection_changed(
	Sender: PObj);
//?{Form}.selection_change
var C: PControl;
    R: Ref_obj;
    F: C_Form;
//.
begin
//?{Form}.selection_change
    C := PControl(Sender);
    R := Pointer(C.Tag);

    //Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, R.Obj);
    F := C_Form( AL4Object.Obj );
    //F.F_sender_alias := C_Control(R.obj).F_Alias;
    
    operation_started(F, 6, R);
    try
    unitC_Form.M_Notify_sel_change(AL4Object);
    finally
    F.M_operation_ended(6);
    end;
    
    //Object_assign_hard(C_Form( AL4Object.Obj ).F_sender, NoneObj_C_Control);
//.
end;

procedure TAL4Form.Listview_changed(
    Sender: PControl; IdxFrom, IdxTo: Integer; OldState, NewState: DWORD);
begin
    Control_changed(Sender);
end;

procedure TAL4Form.Form_clicked(
	Sender: PObj);
//?{Form}.click
var P: TPoint;
	F: C_Form;
//.
begin
//?{Form}.click
    GetCursorPos(P);
    P := Form.Screen2Client(P);
    Popup_point.f_X := Pixels(P.X);
    Popup_point.f_Y := Pixels(P.Y);

	F := C_Form( AL4Object.Obj );
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then Exit;
    //******************************
	{$ENDIF}
    
	operation_started(F, 0, nil);
	try
    F.M_Click;
    finally
    F.M_operation_ended(0);
    end;
//.
end;

procedure TAL4Form.Control_resized(
	Sender: PObj);
//?{Form}.resize
var C: PControl;
    R: Ref_obj;
    F: C_Form;
//.
begin
	if setting_control_size > 0 then Exit;
//?{Form}.resize
    C := PControl(Sender);
    R := Pointer(C.Tag);
	if (AL4Object = nil) then Exit;

    F := C_Form( AL4Object.Obj );
    
	operation_started(F, 7, R);
	try
    //F.M_resize;
    C_Control(R.Obj).M_resized;
    finally
    F.M_operation_ended(7);
    end;
//.
end;

procedure TAL4Form.Control_destroyed(
	Sender: PObj);
var C: PControl;
    R: Ref_obj;
    F: C_Form;
begin
    C := PControl(Sender);
    R := Pointer(C.Tag);
    if R.Obj <> nil then
    	C_Control(R.Obj).F_Handle := 0;
end;

procedure TAL4Form.Form_resized(
	Sender: PObj);
//?{Form}.resize
var F: C_Form;
//.
begin
//?{Form}.resize
	F := C_Form( AL4Object.Obj );
		{$IFnDEF SMALLEST_CODE}
		//if not was_Shown then Exit;
		//if ignore_resize then Exit;
		//adjust_all_columns(Integer(@Self));
		{$ENDIF}
	
	operation_started(F, 7, nil);
	try
    F.M_resize;
    finally
    F.M_operation_ended(7);
    end; 
//.
	Form.InvalidateEx;
end;

procedure TAL4Form.Form_moved(
	Sender: PObj);
//?{Form}.moved
var F: C_Form;
//.
begin
//?{Form}.moved
	F := C_Form( AL4Object.Obj );
	operation_started(F, 8, nil);
	try
    F.M_moved;
    finally
    F.M_operation_ended(8);
    end; 
//.
	Form.InvalidateEx;
end;


procedure prepare_info(Key:Word; Info: PSt_key_info__C_Form);
begin
    //FillChar(Info, SizeOf(Info), 0);
    Info.f_Special := 0;
    Info.f_Char := '';
    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
        Info.f_Char := '' + Char(Key);

    if Key = 0 then Info.f_Char := '';
    
    CASE Key OF
    $5B, $DB: begin Info.f_Char := '['; Key := 0; end;
    $5D, $DD: begin Info.f_Char := ']'; Key := 0; end;
    $3C, $BC: begin Info.f_Char := '<'; Key := 0; end;
    $3E, $BE: begin Info.f_Char := '>'; Key := 0; end;
    $3A, $BA: begin Info.f_Char := ';'; Key := 0; end;
    $5E, $DE: begin Info.f_Char := ''''; Key := 0; end;
    $3F, $BF: begin Info.f_Char := '/'; Key := 0; end;
    $5C, $DC: begin Info.f_Char := '\'; Key := 0; end;
    $40, $C0: begin Info.f_Char := '~'; Key := 0; end;
    END;    

    Info.f_Special := Byte(Key);
    Info.f_Caps := (GetKeyState(VK_CAPITAL) and 1) <> 0;
    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);
end;

procedure prepare_info_press(
	Key: Char; Info: PSt_key_info__C_Form);
begin
    Info.f_Special := 0;
    Info.f_Char := '';
    Info.f_Right := false;
    Info.f_Caps := false;
    Info.f_Shift := false;
    Info.f_Ctrl := false;
    Info.f_Alt := false;
    Info.f_Win := false;

    Info.f_Char := '' + Char(Key);
    Info.f_Special := Byte(Key);
    Info.f_Caps := FALSE;
    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);
    {$IFnDEF SMALLER_CODE}
    if Info.f_Ctrl and Info.f_Alt and (GetKeyState(VK_LCONTROL)<0)
    	and (GetKeyState(VK_RMENU)<0) then
    	Info.f_Ctrl := false;
    {$ENDIF}
end;


procedure TAL4Form.Prepare_mouse_point_button(
	Button: TMouseButton; 
    do_Button: Boolean; Info: PSt_Key_info__C_Form);
var P: TPoint;
    b: Integer;
    {$IFNDEF SMALLEST_CODE}
    hC: THandle;
    iI: TIconInfo;
    {$ENDIF}
begin
    GetCursorPos(P);
    //{$IFNDEF SMALLEST_CODE}
    //hC := GetCursor;
    //if (hC <> 0) and (hC = LoadCursor(0, IDC_IBEAM))
    //    and GetIconInfo(hC, iI) then
    //begin
    //    dec(P.X, iI.xHotspot);
    //    dec(P.Y, iI.yHotspot);
    //end;
    //{$ENDIF}
    P := Form.Screen2Client(P);
    Mouse_point.f_X := Pixels(P.X);
    Mouse_point.f_Y := Pixels(P.Y);

    Popup_point.f_X := Pixels(P.X);
    Popup_point.f_Y := Pixels(P.Y);
   
    if do_Button then
    begin
        CASE Button OF
        mbLeft: b := 1;
        mbRight: b := 2;
        mbMiddle: b := 3;
        else b := 0;
        END;
        Mouse_button := b;
    end;
    
    prepare_info(0, Info);
end;

procedure TAL4Form.Control_mouse_move(
	Sender: PControl; var Mouse: TMouseEventData);
var stop_handling: Boolean;
var F: C_Form;
    P: TPoint;
    C: PControl;
    R: Ref_obj;
//?{Control}.mouse_move
var CC: C_Control;
//.
begin
	stop_handling := FALSE;
    F := C_Form(AL4Object.Obj);
    Prepare_mouse_point_button(Mouse.Button, FALSE,
    	PSt_Key_info__C_Form(F.F_Key.Obj));

    C := PControl(Sender);
    R := Pointer(C.Tag);
//?{Control}.mouse_move
    CC := C_Control(R.Obj);
    CC.F_stop_handling := false;
    
	operation_started(F, 10, R);
	try
    CC.M_mouse_move;
    finally
    F.M_operation_ended(10);
    end;
    stop_handling := CC.F_stop_handling;
//.
    
//?{Form}.mouse_move
    if not stop_handling then
    begin
		operation_started(F, 10, R);
		try
        F.M_mouse_move;
	    finally
	    F.M_operation_ended(10);
	    end;
    end;
//.
end;

procedure TAL4Form.Form_mouse_move(
	Sender: PControl; var Mouse: TMouseEventData);
//?{Form}.mouse_move
var F: C_Form;
//.
begin
//?{Form}.mouse_move
    F := C_Form(AL4Object.Obj);
    Prepare_mouse_point_button(mbLeft, FALSE, PSt_Key_info__C_Form(F.F_Key.Obj));

    operation_started(F, 10, nil);
    try
    F.M_mouse_move;
    finally
    F.M_operation_ended(10);
    end; 
//.
end;

procedure TAL4Form.Control_mouse_down(
	Sender: PControl; var Mouse: TMouseEventData);
var stop_handling: Boolean;
var F: C_Form;
var C: PControl;
    R: Ref_obj;
//?{Control}.mouse_down
var CC: C_Control;
//.
begin
	stop_handling := FALSE;
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then Exit;
    //******************************
	{$ENDIF}
    Prepare_mouse_point_button(Mouse.Button, TRUE, PSt_Key_info__C_Form(F.F_Key.Obj));

    C := PControl(Sender);
    R := Pointer(C.Tag);
//?{Control}.mouse_down
    CC := C_Control(R.Obj);
    CC.F_stop_handling := false;
    
	operation_started(F, 11, R);
	try
    CC.M_mouse_down;
    finally
    F.M_operation_ended(11);
    end;
    stop_handling := CC.F_stop_handling;
	if stop_handling then
	   SetCapture(Sender.Handle);
//.
    
//?{Form}.mouse_down
    if not stop_handling then
    begin
		operation_started(F, 11, R);
		try
        F.M_mouse_down;
	    finally
	    F.M_operation_ended(11);
	    end;
    end;
//.
end;

procedure TAL4Form.Form_mouse_down(
	Sender: PControl; var Mouse: TMouseEventData);
//?{Form}.mouse_down
var F: C_Form;
//.
begin
//?{Form}.mouse_down
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then Exit;
    //******************************
	{$ENDIF}
    Prepare_mouse_point_button(Mouse.Button, TRUE, PSt_Key_info__C_Form(F.F_Key.Obj));
    operation_started(F, 11, nil);
    try
    F.M_mouse_down;
    finally
    F.M_operation_ended(11);    
    end;
//.
end;

procedure TAL4Form.Control_mouse_up(
	Sender: PControl; var Mouse: TMouseEventData);
var stop_handling: Boolean;
var F: C_Form;
var C: PControl;
    R: Ref_obj;
//?{Control}.mouse_up
var CC: C_Control;
//.
begin
	stop_handling := FALSE;
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then Exit;
    //******************************
	{$ENDIF}
    Prepare_mouse_point_button(Mouse.Button, TRUE, PSt_Key_info__C_Form(F.F_Key.Obj));

    C := PControl(Sender);
    R := Pointer(C.Tag);
//?{Control}.mouse_up
    CC := C_Control(R.Obj);
    CC.F_stop_handling := false;
    
	operation_started(F, 12, R);
	try
    CC.M_mouse_up;
    finally
    F.M_operation_ended(12);
    end;
    stop_handling := CC.F_stop_handling;
    if stop_handling then
       ReleaseCapture;
    
//.

//?{Form}.mouse_up
    if not stop_handling then
    begin
		operation_started(F, 12, R);
		try
        F.M_mouse_up;
	    finally
	    F.M_operation_ended(12);
	    end;
    end;
//.
    
    if Mouse.Button <> mbLeft then
       Control_clicked(Sender);
end;

procedure TAL4Form.Form_mouse_up(
	Sender: PControl; var Mouse: TMouseEventData);
//?{Form}.mouse_up
var F: C_Form;
//.
begin
//?{Form}.mouse_up
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then Exit;
    //******************************
	{$ENDIF}
    Prepare_mouse_point_button(Mouse.Button, TRUE, PSt_Key_info__C_Form(F.F_Key.Obj));

    operation_started(F, 12, nil);
    try
    F.M_mouse_up;
    finally
    F.M_operation_ended(12);
    end;
//.
end;

procedure TAL4Form.Control_mouse_double_click(
	Sender: PControl; var Mouse: TMouseEventData);
var F: C_Form;
	stop_handling: Boolean;
var C: PControl;
    R: Ref_obj;
//?{Control}.mouse_double_click
var CC: C_Control;
//.
begin
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then Exit;
    //******************************
	{$ENDIF}
    Prepare_mouse_point_button(Mouse.Button, FALSE, PSt_Key_info__C_Form(F.F_Key.Obj));

    C := PControl(Sender);
    R := Pointer(C.Tag);
    stop_handling := false;
//?{Control}.mouse_double_click
    CC := C_Control(R.Obj);
    CC.F_stop_handling := false;
    
	operation_started(F, 13, R);
	try
    CC.M_mouse_double_click;
    finally
    F.M_operation_ended(13);
    end;
    stop_handling := CC.F_stop_handling;
//.

//?{Form}.mouse_double_click
    if not stop_handling then
    begin
        //Object_assign_hard(F.F_sender, R.Obj);
        
        
		operation_started(F, 13, R);
		try
        F.M_mouse_double_click;
	    finally
	    F.M_operation_ended(13);
	    end;

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

procedure TAL4Form.Form_mouse_double_click(
	Sender: PControl; var Mouse: TMouseEventData);
//?{Form}.mouse_double_click
var F: C_Form;
//.
begin
//?{Form}.mouse_double_click
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then Exit;
    //******************************
	{$ENDIF}
    Prepare_mouse_point_button(Mouse.Button, FALSE, PSt_Key_info__C_Form(F.F_Key));
    
    
	operation_started(F, 13, nil);
	try
    F.M_mouse_double_click;
    finally
    F.M_operation_ended(13);
    end;
//.
end;

procedure TAL4Form.Form_mouse_wheel(
	Sender: PControl; var Mouse: TMouseEventData);
//?{Form}.mouse_wheel
var F: C_Form;
    C: PControl;
    R: Ref_obj;
    CC: C_Control;
    v: Integer;
//.
begin
//?{Form}.mouse_wheel
    F := C_Form(AL4Object.Obj);
    Prepare_mouse_point_button(mbLeft, FALSE, PSt_Key_info__C_Form(F.F_Key.Obj));
    v := SmallInt(HiWord( Mouse.Shift )); 
    Mouse_wheel_vertical := v / 120.0;
    C := Form.ActiveControl;

    R := nil;
    
    if  C <> nil then
    begin
        R := Pointer(C.Tag);
        CC := C_Control(R.Obj);
        CC.F_stop_handling := false;
        
		operation_started(F, 14, R);
		try
        CC.M_mouse_wheel;
	    finally
	    F.M_operation_ended(14);
	    end;
   
        if not CC.F_stop_handling then
        begin
			operation_started(F, 14, R);
			try
            F.M_mouse_wheel;
		    finally
		    F.M_operation_ended(14);
		    end;
            Exit;
        end;
    end;
    
	operation_started(F, 14, R);
	try
	    if (F.M_mouse_wheel) then
	    begin
	    	Mouse.StopHandling := true;
	    end;
    finally
    F.M_operation_ended(14);
    end;
//.
end;

procedure TAL4Form.Control_mouse_wheel(
	Sender: PControl; var Mouse: TMouseEventData);
var F: C_Form;
	stop_handling: Boolean;
var C: PControl;
    R: Ref_obj;
    v: Integer;
//?{Control}.mouse_wheel
var CC: C_Control;
//.
begin
	stop_handling := FALSE;
    F := C_Form(AL4Object.Obj);
    Prepare_mouse_point_button(Mouse.Button, FALSE, PSt_Key_info__C_Form(F.F_Key.Obj));
    v := SmallInt(HiWord( Mouse.Shift )); 
    Mouse_wheel_vertical := v / 120.0;

    C := PControl(Sender);
    R := Pointer(C.Tag);
//?{Control}.mouse_wheel
    CC := C_Control(R.Obj);
    CC.F_stop_handling := false;
    
	operation_started(F, 14, R);
	try
    CC.M_mouse_wheel;
    finally
    F.M_operation_ended(14);
    end;
    stop_handling := CC.F_stop_handling;
//.

//?{Form}.mouse_wheel
    if not stop_handling then
    begin
		operation_started(F, 14, R);
		try
        	if F.M_mouse_wheel then
        		Mouse.StopHandling := true;
	    finally
	    F.M_operation_ended(14);
	    end;
    end;
//.
end;

procedure TAL4Form.Control_key_down(
	Sender: PControl; var Key: Longint; sShift: DWORD);
//?{Form}.key_down
var F: C_Form;
    C: PControl;
    R: Ref_obj;
//.
begin
//?{Form}.key_down
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 2 then begin
    	Key := 0;
    	Exit;
    end;
    //******************************
	{$ENDIF}
    C := PControl(Sender);
    if not C.Parent.Enabled then Exit;
    R := Pointer(C.Tag);
    prepare_info(Key, PSt_Key_info__C_Form(F.F_Key.Obj));

	operation_started(F, 15, R);
	try
    if F.M_key_down <> 0 then Key := 0;
    finally
    F.M_operation_ended(15);
    end;
//.
end;

procedure TAL4Form.Form_key_down(
	Sender: PControl; var Key: Longint; sShift: DWORD);
//?{Form}.key_down
var F: C_Form;
	focus: THandle;
//.
begin
//?{Form}.key_down
	focus := GetFocus;
	if focus <> Form.Handle then Exit;
	 
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 2 then begin
    	Key := 0;
    	Exit;
    end;
    //******************************
	{$ENDIF}
    prepare_info(Key, PSt_Key_info__C_Form(F.F_Key.Obj));

	operation_started(F, 15, nil);
	try
    if F.M_key_down <> 0 then Key := 0;
    finally
    F.M_operation_ended(15);
    end;
//.	
end;

procedure TAL4Form.Control_key_up(
	Sender: PControl; var Key: Longint; sShift: DWORD);
//?{Form}.key_up
var F: C_Form;
    C: PControl;
    R: Ref_obj;
//.
begin
//?{Form}.key_up
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then begin
    	Key := 0;
    	Exit;
    end;
    //******************************
	{$ENDIF}
    C := PControl(Sender);
    if not C.Parent.Enabled then Exit;
    prepare_info(Key, PSt_Key_info__C_Form(F.F_Key.Obj));
    R := Pointer(C.Tag);

    operation_started(F, 16, R);
    try
    if F.M_key_up <> 0 then Key := 0;
    finally
    F.M_operation_ended(16);
    end;
//.
end;

procedure TAL4Form.Form_key_up(
	Sender: PControl; var Key: Longint; sShift: DWORD);
var C: {$IFDEF FPC} TUTF8Char {$ELSE} Char {$ENDIF};
//?{Form}.key_up
var F: C_Form;
	focus: THandle;
//.
begin	
//?{Form}.key_up
	focus := GetFocus;
	if focus <> Form.Handle then Exit;
	
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then begin
    	Key := 0;
    	Exit;
    end;
    //******************************
	{$ENDIF}
    prepare_info(Key, PSt_Key_info__C_Form(F.F_Key.Obj));
    
    operation_started(F, 16, nil);
    try
    if F.M_key_up <> 0 then Key := 0;
    finally
    F.M_operation_ended(16);
    end;
//.
end;

procedure TAL4Form.Control_key_press(
	Sender: PControl; var Key: KOLChar; sShift: DWORD);
//?{Form}.key_press
var F: C_Form;
    C: PControl;
    R: Ref_obj;
//.
begin
//?{Form}.key_press
    F := C_Form(AL4Object.Obj);
	{$IFnDEF SMALLER_CODE}
    //******************************
    if F.F_level_event > 1 then begin
    	Key := #0;
    	Exit;
    end;
    //******************************
	{$ENDIF}
    C := PControl(Sender);
    R := Pointer(C.Tag);
    prepare_info_press(Key, PSt_Key_info__C_Form(F.F_Key.Obj));

    operation_started(F, 17, R);
    try
    if F.M_key_press <> 0 then Key := #0;
    finally
    F.M_operation_ended(17);
    end;
//.
end;

procedure TAL4Form.Form_timer_tick(
	Sender: PObj);
//?{Form}.timer
var F: C_Form;
    T: PTimer;
    TP: PTimerPanel;
    R: Ref_obj;
//.
begin
//?{Form}.timer
	if not Form.Enabled then Exit;
    F := C_Form(AL4Object.Obj);
    T := PTimer(Sender);
    TP := Pointer(T.Tag);
    R := Pointer(TP.Tag);

	operation_started(F, 18, R);
	try
    F.M_timer;
    finally
    F.M_operation_ended(18);
    end;
//.
end;



// Form destructor

destructor TAL4Form.Destroy;
var F: C_Form;
begin
  if  Main_menu_dummy <> nil then
  begin
	  Free_And_Nil(Main_menu_dummy);
	  HackControl(Integer(Form)).fMenuObj := nil;
  end;
  if  (Columns <> nil) then
  begin
//?{Form}.menu_item
      if MenuPanel_to_destroy <> nil then
      begin
         MenuPanel_to_destroy.Free;
         MenuPanel_to_destroy := nil;
      end;
//.
      F := C_Form(AL4Object.Obj);
      F.F_Handle := 0;
      Free_And_Nil(Columns);
      inherited;
  end;
end;

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;

//const CM_SHOWN00 = WM_USER+2021;

procedure TAL4Form.Event_Show(
	Sender: PObj);
//?{Form}.shown
var F: C_Form;
//.
begin
	shown := true;
//?{Form}.shown
    F := C_Form( AL4Object.Obj );
    operation_started(F, 9, nil);
    try
    F.M_shown;
    finally
    F.M_operation_ended(9);
    end;
//.
    //{$IFnDEF SMALLEST_CODE}
    //    Form.PostMsg(CM_SHOWN00, GetTickCount, 0);
    //{$ENDIF}
end;

// Event: Form shown

procedure TAL4Form.Event_Close(
	Sender: PObj; var Accept: Boolean);
var F: C_Form;
	r: Ref_obj;
begin
    F := C_Form( AL4Object.Obj );
    if F = nil then Exit;
//?{Form}.closing
	operation_started(F, 1, nil);
	try
    Accept := F.M_Closing = 0;
    finally
    F.M_operation_ended(1);
    end;
//.
    
	if not Accept then Exit;
	F.F_Closed := true;
	fClosed := true;
	
//?{Form}.closed
	F.F_Handle := 0;
	r := F.hard_link; 
	operation_started(F, 2, nil);
	F.M_operation_ended(2);
	try
		F.M_closed;
	finally
	end;
//.
end;

//?{Form}.menu_item
{ TMenuPanel }

// Destroy MenuPanel together with its lists

destructor TMenuPanel.Destroy;
begin
  if destroying or AppletTerminated then Exit;
  destroying := TRUE;
  if MenuObject.Owner <> nil then
  	 MenuObject.Owner.RemoveFromAutoFree(MenuObject);
  //AllItemsList.Free;
  AliasesList.Free;
  Alias := '';
  inherited;
end;

// when item clicked, selected Alias is stored and flag "Selected" becomes TRUE

procedure TMenuPanel.Item_click(
	Sender : PMenu; Item : Integer);
 //?{Form}.menu_item
var i: Integer;
    F: C_Form;
 //.
begin
 //?{Form}.menu_item
    i := Item;
    if (i < 0) or (i >= AliasesList.Count) then Exit;
    Ready := TRUE;
    F := C_Form(Form_.AL4Object.Obj);
    Alias := AliasesList.Items[i];
    
	operation_started(F, 20, nil);
	F.F_menu_alias := Alias;
	try
    F.M_menu_item;
    finally
	F.F_menu_alias := '';
    F.M_operation_ended(20);
    end;
 //.
end;

procedure TAL4Form.MainMenu_destroyed(
	Sender: PObj);
var M: PHackMenu;
begin
    M := Pointer(Sender);
    //M.FControl.RemoveFromAutoFree(Main_menu_dummy);
    Form.RemoveFromAutoFree(Sender);
    HackControl(Integer(Form)).fMenuObj := nil;
    Main_menu_dummy := nil;
end;
//.

var handling_activation: Boolean;

function TAL4Form.Form_message(
	var M: KOL.TMsg; var Rslt: Integer): Boolean;
//?{Form}.activated
var F: C_Form;
//.
begin
    Result := false;
//?{Form}.activated
    if (M.Message = WM_ACTIVATE) and (Word(M.wParam) <> 0) then
    begin
        if not handling_activation then
        begin
            handling_activation := true;
            try
                F := C_Form(Self.AL4Object.Obj); 
				operation_started(F, 3, nil);
				try
                	F.M_activated;
			    finally
			    	F.M_operation_ended(3);
			    end;
            finally
                handling_activation := false;
            end;
        end;
    end;
//.
end;

//?{Form}.accept
procedure TAL4Form.Form_drop_files(Sender: PControl; 
	const FileList: KOL_String; const Pt: TPoint);
var F: C_Form;
	a: DynAStr;
	i, j: Integer;
	s: String;
begin
	a := New_DynAStr;
	a.Add(MAXINT, ParamStr(0));
	s := FileList;
	for i := 0 to Length(FileList) do
	begin
		if s = '' then break;
		j := pos(#13, s);
		if j <= 0 then j := Length(s);
		a.Add(MAXINT, Copy(s, 1, j));
		s := Copy(s, j+1, MAXINT);
	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(F, 26, nil);
	try
		if F.M_accept then
    		F.M_command;
    finally
    	F.M_operation_ended(26);
    end;
end;
//.

//?{Form}.timer
{ TTimerPanel }

constructor TTimerPanel.CreateTimerPanel(
	xParent: PControl);
begin
    inherited CreateParented(xParent);
end;

destructor TTimerPanel.Destroy;
begin
  Free_And_Nil(TimerObject);
  inherited;
end;

function NewTimerPanel(
	ParentForm: PControl): PTimerPanel;
begin 
    new(Result, CreateTimerPanel(ParentForm));
end;
//.


//?{Control}.animation
constructor TAnimation_timer.Create(
	X_H, X_Count, X_Interval: Integer);
var C: PControl;
    CC: C_Control;
    rF: Ref_obj;
    CF: C_Form;
begin
    C := HackControl(X_H);
    Ref_control := Pointer(C.Tag);
    Inc(Ref_control.Obj.hard_link.Count, 2);
    
    CC := C_Control(Ref_control.Obj);
    rF := CC.F_Form_;
    CF := C_Form(rF.Obj);
    
    Form := PAL4Form(CF.F_Handle);
    if Form.Control_timers = nil then   
       Form.Control_timers := NewList;
    Form.Control_timers.Add(@Self);
    
    Counter := 0;
    Last_counter := X_Count;
    Control_handle := X_H;
    
    T := NewTimer(X_Interval);
    T.OnTimer := Tick_timer;
    T.Enabled := true;
end;

procedure TAnimation_timer.Tick_timer(
	Sender: PObj);
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(CC.F_Form_.Obj);
	
	operation_started(F, 19, Ref_control);
	try
    CC.M_animation;
    finally
    F.M_operation_ended(19);
    end;
end;

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

{$IFNDEF NOEXCEPTIONS}
{$IFNDEF NOLONGOP}

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;
var F, L: C_Form;
	L_f: C_Long_operation;
	form: PAL4Form;
	Lform: PAL4Form;
	dNow, diff: Double;
begin
    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)
	    then
	    begin
	        Last_time_active := dNow;
	        L := C_Form(F.M_Long_operation().Obj);
	        Lform := PAL4Form(L.F_Handle);
	        if not Lform.Form.Visible then
	        begin
	        	form := PAL4Form(F.F_Handle);
	        	Lform.Form.Left := form.Form.Left + 100; 
	        	Lform.Form.Top := form.Form.Top + 50; 
	            Lform.Form.Show;
	        end;
	    end;
    end;
    if not L_f.Is_NONE_object and (Allow_handle_events > 0) then
    begin
    	dec(Allow_handle_events);
    	try
        	Applet.ProcessMessages();
    	finally
    		inc(Allow_handle_events);
    	end;
        if L_f.F_Cancelled then
        begin
            L_f.F_Cancelled := false;
            L_f.F_Finished := true;
            form := PAL4Form(F.F_Handle);
            form.Form.Enabled := true;
            raise Stop_exception.Create('Long operation is cancelled');
        end;
    end;
end;	
{$ENDIF}
{$ENDIF NOEXCEPTIONS}

{$IFNDEF SMALLER_CODE}
	initialization
	finalization
	
	TRY
	Free_And_Nil(Monitors_stored);
  	EXCEPT
  	END;
{$ENDIF}

end.
(*
/*
END
*/
*)


