(*
/*

CLASS {AL4_tray|_VCL}, NATIVE, UNTESTED :
IMPORT: {Control}, {String_functions} .     
IMPORT, ANYWAY: {Icon} . 

NATIVE:@"uses AL4_form, AL4_tray"
		", Forms, Controls, StdCtrls"
		" {$IFDEF LINUX}"
		" {$ELSE}"
		"		,Windows "
		" {$ENDIF} ;" .
		
NATIVE: "///copy AL4_tray.pas" .
*/
*)
unit AL4_tray;

interface

{$I AL4_options.inc}

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

function Do_create_tray_icon(P: Integer; X_T: Pointer//; X_Icon: Ref_obj
	): Integer;
procedure Do_replace_tray_icon(X_Handle: Integer; X_Icon: Ref_obj);
    
implementation

uses SysUtils, unitC_Control, AL4_drawing;

//------------------------------------------------------------ T R A Y
(*
/*
// Create tray icon component.
//----------------------------------------------------------------------------
FUN Create_tray_icon(
    {Control} T|ray_icon_object, 
    {Icon} Icon|_handle) ==> INT
    :
    RESULT = do_create_tray_icon(T.Form_.Handle, T, Icon) .

FUN do_create_tray_icon( INT F|orm_handle,
    {Control} T|imer_create, {Icon} Ico|n_handle) ==> INT, NATIVE :
@   "   RESULT := Do_Create_tray_icon(X_F, X_T); //, X_Ico);" 
    "   Do_replace_tray_icon(RESULT, X_Ico);" .
*/
*)
var Last_ID_Tray_icon: Integer;

function Do_Create_tray_icon(
P: Integer; X_T: Pointer//; X_Icon: Ref_obj
	): Integer;
var Parent: TAL4Column;
    TP: TTrayPanel;
    F: TAL4Form;
begin
    F := form_from_handle(P);
    Parent := F.Get_current_column;
    TP := TTrayPanel.Create(Parent);
    TP.Visible := FALSE;
    inc(Last_ID_Tray_icon);
    TP.ID := Last_ID_Tray_icon;
    TP.Form := F;
    
    TP.Visible := FALSE;
    TP.Width := 0;
    TP.Height := 0;

    TP.Tag := Integer(X_T);
    TP.Parent := Parent;
    if F.TrayIcons = nil then
        F.TrayIcons := TList.Create;
    F.TrayIcons.Add(TP);
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(TP);
    {$ELSE}
    	Result := Integer(TP);
    {$ENDIF}
end;

var empty_icon: DWORD;

procedure Do_replace_tray_icon(
X_Handle: Integer; X_Icon: Ref_obj);
//?{Icon}
var TP: TTrayPanel;
    ico: C_Icon;
    b: TBitmap_Ex;
    i: TIcon;
    ih: Integer;
    bits: array[0..32] of Byte;
    mask: array[0..32] of Byte;
//.
begin
//?{Icon}
	    TP := TTrayPanel(X_Handle);
	    ico := C_Icon(X_Icon.Obj);
	    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
	    	b := TBitmap_Ex(All_bitmaps[ico.F_Handle]);
	    {$ELSE}
	    	b := TBitmap_Ex(ico.F_Handle);
	    {$ENDIF}
	    if b <> nil then begin
	                     i := b.Ico;
	                     end
	                else i := nil;
	    if TP.IconObject <> i then
	    begin
	        TP.IconObject := i;
	    end;
	    if TP.Active then
	    begin
	        if TP.IconObject <> nil then ih := TP.IconObject.Handle
	        else begin
	             if empty_icon = 0 then
	             begin
	                FillChar(bits, SizeOf(bits), $FF);
	                FillChar(mask, SizeOf(mask), 0);
	                
	                empty_icon := CreateIcon(0 {hInstance}, 16, 16, 1, 1, 
	                    @bits[0], @mask[0]);
	             end;
	             ih := empty_icon;
	             end;
	        Nim_operation(TP.Form.Handle, TP.ID, 'c', ih, TP.tp_Text);
	    end;
//.
end;

(*
/*
// Create tray icon component.
//----------------------------------------------------------------------------

FUN Set_tray_icon_active( INT Handle|_tray_icon_object, 
    BOOL Active|_value ), NATIVE :
   @"var TP: TTrayPanel;"
    "var h, ih: THandle;"
    "    TP := TTrayPanel(X_Handle);"
    "	 if TP.Active = X_Active then Exit;"     
    "    if X_Active then"
    "    begin"
    "       	TP.Active := true;"
    "       	ih := 0;"
    "       	if TP.IconObject <> nil then ih := TP.IconObject.Handle;"
    "       	Nim_operation(TP.Form.Handle, TP.ID, 'a', ih, TP.tp_Text);"
    "    end"
    "    else"
    "    begin"
    "       	TP.Active := false;"
    "       	h := 0;"
    "       	if TP.Form.HandleAllocated then h := TP.Form.Handle;"
    "       	Nim_operation(h, TP.ID, 'd', TP.IconObject.Handle, TP.tp_Text);"
    "    end;"
    .

// Set tray icon text.
//----------------------------------------------------------------------------

FUN Set_tray_icon_text( INT Handle|_tray_icon_object,
    STR S|how_text ), NATIVE :
   @"var TP: TTrayPanel;"
    "    TP := TTrayPanel(X_Handle);"
    "    TP.tp_Text := X_S{$IFDEF FPC}.Value{$ENDIF};"
    "    if TP.Active and Assigned(TP.IconObject) then"
    "       Nim_operation(TP.Form.Handle, TP.ID, 'c',"
    "           TP.IconObject.Handle, TP.tp_Text);" .

// Destroy try icon object.
//----------------------------------------------------------------------------

FUN Destroy_tray_icon(
INT Handle|_tray_icon_object), NATIVE :
   @"var TP: TTrayPanel;"
    "    TP := TTrayPanel(X_Handle);"
    "    if not TP.Active then Exit;"
    "    TP.Active := false;"
    "    Nim_operation(TP.Form.Handle, TP.ID, 'd',"
    "       TP.IconObject.Handle, TP.tp_Text);" . 
    
// Destroy icon.
//----------------------------------------------------------------------------

FUN Destroy_icon( INT Handle|_icon), NATIVE :
   @"     //if X_Handle > 0 then DestroyIcon(X_Handle);" .
    
// Load icon from file.
//----------------------------------------------------------------------------
//FUN Load_icon_from_file( STR Path|_to_file_containing_icon ) ==> INT,
//    NATIVE :
//   @"    try"
//    "       Result := LoadImage(0, PChar(X_Path), IMAGE_ICON, 0, 0,"
//    "       LR_LOADFROMFILE);"
//    "    except on E: Exception do begin"
//    "           Any_exception(E);"
//    "           Result := 0;"
//    "           end;"
//    "    end;" .

// Replace tray icon by another icon object
//----------------------------------------------------------------------
FUN Replace_tray_icon( INT Handle|_tray_icon_object,
    {Icon} Value|_icon_to_set ), NATIVE :
@   "   Do_replace_tray_icon(X_Handle, X_Value);" .
*/
*)
        
end.
(*
/*
END
*/
*)
