(*
/*

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

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

interface

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

{$WARN UNIT_DEPRECATED OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$IFNDEF FPC}
	{$WARN UNSAFE_TYPE OFF}
	{$WARN UNSAFE_CAST OFF}
	{$WARN UNSAFE_CODE OFF}
{$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);

type
	TTrayHandler = class(TComponent)
		TP: TTrayPanel;
		procedure Event_mouse_up(Sender: TObject; Button: TMouseButton; 
			Shift: TShiftState; X, Y: Integer);
	end;
    
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|ray_icon_control_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): Integer;
var Parent: TAL4Column;
    TP: TTrayPanel;
    F: TAL4Form;
    //CI: C_Icon;
    //BE: TBitmapEx;
    TH: TTrayHandler;
begin
    F := form_from_handle(P);
    Parent := F.Get_current_column;
    TP := TTrayPanel.Create(Parent);
    TP.Visible := FALSE;
    TP.Form := F;
    
    //CI := C_Icon(X_Icon.Obj);
    //BE := TBitmapEx(CI.F_Handle);
    
    //TP.IconObject := BE.Ico;
    //{$IFDEF FPC}
    //	TP.ti.Icon.Assign(TP.IconObject);
    //{$ENDIF}
    TP.Visible := FALSE;
    TP.Width := 0;
    TP.Height := 0;
	
    TP.Tag := IntPtr(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}
    
	//------------------------------- 'provide handling messages'
	TH := TTrayHandler.Create(TP);
	TH.TP := TP;
	TP.ti.OnMouseUp := @TH.Event_mouse_up;
end;

procedure TTrayHandler.Event_mouse_up(Sender: TObject; Button: TMouseButton; 
			Shift: TShiftState; X, Y: Integer);
begin
	TP.HandleTrayMessage(Button, Shift);
end;

var empty_icon: DWORD;
procedure Do_replace_tray_icon(X_Handle: Integer; X_Icon: Ref_obj);
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
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		TP := TTrayPanel(All_controls[X_Handle]);
	{$ELSE}
    	TP := TTrayPanel(X_Handle);
	{$ENDIF}
    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
        //if TP.IconObject <> nil then TP.IconObject.Free;
        //if i <> nil then 
        TP.IconObject := i;
    end;
    if TP.ti.Visible and Assigned(TP.IconObject) then
    begin
    	TP.ti.Icon.Assign(TP.IconObject);
    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;"
    "    {$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "		TP := TTrayPanel(All_controls[X_Handle]);"
    "	 {$ELSE}"
    "		TP := TTrayPanel(X_Handle);"
    "	 {$ENDIF}"
    "    if not TP.Active and X_Active then"
    "    begin"
    "			TP.ti.Show;"
    "    end"
    "    else if TP.Active and not X_Active then"
    "    begin"
    "			TP.ti.Hide;"
    "    end;" .

// Set tray icon text.
//----------------------------------------------------------------------------
FUN Set_tray_icon_text( INT Handle|_tray_icon_object,
    STR S|how_text ), NATIVE :
   @"var TP: TTrayPanel;"
    "    {$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "		TP := TTrayPanel(All_controls[X_Handle]);"
    "	 {$ELSE}"
    "		TP := TTrayPanel(X_Handle);"
    "	 {$ENDIF}"
    "	 TP.ti.Hint := X_S;" .

// Destroy try icon object.
//----------------------------------------------------------------------------
FUN Destroy_tray_icon( INT Handle|_tray_icon_object), NATIVE :
   @"var TP: TTrayPanel;"
    "    {$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "		TP := TTrayPanel(All_controls[X_Handle]);"
    "	 {$ELSE}"
    "		TP := TTrayPanel(X_Handle);"
    "	 {$ENDIF}"
    "	 TP.ti.Hide;" .
    
// Destroy icon.
//----------------------------------------------------------------------------
FUN Destroy_icon( INT Handle|_icon), NATIVE :
   @"var TP: TTrayPanel;"
    "     //if X_Handle > 0 then DestroyIcon(X_Handle);"
    "    {$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "		TP := TTrayPanel(All_controls[X_Handle]);"
    "		All_controls[X_Handle] := nil;"
    "	 {$ELSE}"
    "		TP := TTrayPanel(X_Handle);"
    "	 {$ENDIF}"
   .
    
// Load icon from file.
//----------------------------------------------------------------------------
//FUN Load_icon_from_file( STR Path|_to_file_containing_icon ) ==> INT,
//    NATIVE :
//   @"    Exit;"
//   "	 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
*/
*)
