File "ContextMenu.inc"

Path: /nimoworld/inc/ContextMenu.inc
File size: 86.44 KB
MIME-type:
Charset: 8 bit

'********************************************************************************************************************
' ContextMenu.inc offers the users of your program a standard right-click menu in order to customize all the appearance
' of a dialog (window) such as transparency, caption, systray, taskbar, always on top, colors, fonts, etc.
' Several instances for several dialogs can be handled
'********************************************************************************************************************
' To Developer : for Context Menus to work properly, do the following in your main file :
'
' 0) Add at the start of your program a #INCLUDE "ContextMenu.inc" and define the static variable $EXE:
'    [Code] $EXE = "My Program Name" [/Code]
'
' 1) Create a "DialogDescriptor" +global+ variable for your dialog (see why it needs to be global in step 5 below)
'    [Code] Global myDialogDescriptor As DialogDescriptor [/Code]
'    You can create as many of these as you have dialogs that you want a Context Menu for.
'
' 2) In your ShowDialog +Function+ create your dialog preferably without any style nor extended style.
'    You can bother defining styles and extended styles but they will be erased at initialization of the dialog,
'    so the simplest and fastest code is :
'    [Code] Dialog New hParent, "myDialog title", x, y, width, height To hDlg [/Code]
'
' 3) Then, still in your ShowDialog +Function+ define the first (default) appearance you want for your dialog. This
'    will be overwritten by further changes the user will make, but hey, that's why you are using ContextMenu.inc ;)
'    [Code]
'           myDialogDescriptor.Handler = hDlg             ' dialog handle
'           myDialogDescriptor.AllowMinimize = 0          ' icon "_" in caption (title bar) / "minimize" in context menu
'           myDialogDescriptor.AllowMaximize = 0          ' icon "[]" in caption (title bar) / "maximize" in context menu
'           myDialogDescriptor.AllowResize = 0            ' dialog can be resized by user
'           myDialogDescriptor.OnTop = 1                  ' dialog is always on top
'           myDialogDescriptor.Caption = 1                ' dialog has a caption (title bar) and a border
'           myDialogDescriptor.TaskBar = 0                ' dialog appears in Task Bar
'           myDialogDescriptor.SysTray = 0                ' dialog appears in SysTray
'           myDialogDescriptor.Transparency = 255         ' dialog transparency from 0 (invisible) to 255 (plain dialog)
'           myDialogDescriptor.FgndTrspt = 0              ' writings are completely transparent
'           myDialogDescriptor.BgndTrspt = 0              ' dialog background is completely transparent
'           myDialogDescriptor.FgndCol = %black           ' font color
'           myDialogDescriptor.BgndCol = RGB(224,223,227) ' background color
'           myDialogDescriptor.FontName  = "Tahoma"       ' font family
'           myDialogDescriptor.FontSize = 12              ' font size
'           myDialogDescriptor.FontAttr = 1               ' font attribute (0 = Normal ; 1 = Bold ...)
'           myDialogDescriptor.SettingsEntry = 0          ' enable "$EXE settings..." entry in context menu
'           CreateSystray "myDialog title", "ICONID", _   ' SysTray label and icon (icon ID from your resource file)
'                         VarPtr(myDialogDescriptor)
'    [/Code]
'
' Then you need to create several subs in your main file:
'
' 4) - Write About() to display information about your program in a simple MsgBox or any better looking GUI.
'    - Write Settings() to display the options dialog for your program (it can be left empty but the sub needs
'      to be at least declared). You also need to write the routines to read from and save to 'CfgFile' (the
'      global settings file).
'    - Write ChangeLanguage() to modify the labels of your program when the user changes the language.
'    - Write RefreshDialog() ChangeFont() DefaultFont() and DefaultColors() subs in your main file : see below
'      what these subs should contain (search the string "To Developer" in this INC file)
'
' And finally :
'
' 5) In your DialogProc +CallBack Function+ before any treatment of any message, write this (as is) :
'    [Code]
'            HandleContextCbMsg VarPtr(myDialogDescriptor), Cb.Msg, Cb.Ctl, Cb.WParam, Cb.LParam
'    [/Code]
'    This will initialize dialog appearance at first display, and handle any change the user will make after that.
'    (Note: this is why we set the DialogDescriptor as global : so that you can create it in ShowDialog Function
'    then handle and change it in DialogProc CallBack Function)
'
' That's all!
'
' (Optional) Customizable widgets now have a 'Share' functionality:
'
' If you want to share data (used by your program) when the user packages a custom widget, you can do the following:
'
' DIM and get/set the string array sharedData() with any chunk of data you want to share (image, text, etc.)
' The best place to do so is in PbMain(). E.g. :
'      [Code]
'            DIM sharedData(1 TO 3) ' when packaging a custom widget, we share: 1.a bitmap, 2.a text, 3.a wave
'            GetSharedData()        ' retrieve sharedData() packaged in this EXE if there is any
'
'            IF sharedData(1) <> "" THEN ' There is data packaged in this exe! sharedData(1) = a bitmap
'                ' Do something with this bitmap
'            ELSE
'                sharedData(1) = GetFile("myImage.bmp") ' set content with local bitmap, in case user shares this widget
'            END IF
'
'            ' Etc. do the same with sharedData(2) = text and sharedData(3) = wave
'      [/Code]
'
'********************************************************************************************************************

'------------------------------------------------------------------------------
' Initial Declares - eliminate unnecessary macros in COMMCTRL.INC
'------------------------------------------------------------------------------
%NOANIMATE         = 1  ' Animate control
%NOBUTTON          = 1  ' Button
%NOCOMBO           = 1  ' Combo box
%NOCOMBOEX         = 1  ' ComboBoxEx
%NODATETIMEPICK    = 1  ' Date/time picker
%NODRAGLIST        = 1  ' Drag list control
%NOEDIT            = 1  ' Edit control
%NOFLATSBAPIS      = 1  ' Flat scroll bar
%NOHEADER          = 1  ' Header control
%NOHOTKEY          = 1  ' HotKey control
%NOIMAGELIST       = 1  ' Image APIs
%NOIPADDRESS       = 1  ' IP Address edit control
%NOLIST            = 1  ' List box control
'%NOLISTVIEW        = 1  ' ListView control
%NOMENUHELP        = 1  ' Menu help
%NOMONTHCAL        = 1  ' MonthCal
%NOMUI             = 1  ' MUI
%NONATIVEFONTCTL   = 1  ' Native Font control
%NOPAGESCROLLER    = 1  ' Pager
%NOPROGRESS        = 1  ' Progress control
%NOREBAR           = 1  ' Rebar control
%NOSTATUSBAR       = 1  ' Status bar
%NOTABCONTROL      = 1  ' Tab control
%NOTOOLBAR         = 1  ' Tool bar
%NOTOOLTIPS        = 1  ' Tool tips
'%NOTRACKBAR        = 1  ' Track bar
%NOTRACKMOUSEEVENT = 1  ' Track Mouse Event
%NOTREEVIEW        = 1  ' TreeView
%NOUPDOWN          = 1  ' Up Down arrow control
'--------------------------------------------------------------------------------
#INCLUDE ONCE "WIN32API.INC"
#INCLUDE ONCE "COMMCTRL.INC"
#INCLUDE ONCE "INITCTRL.INC"
#INCLUDE ONCE "INC\REGISTRY.INC"
'--------------------------------------------------------------------------------

'------------------------------------------------------------------------------
' Constants used for dialogs messages
'------------------------------------------------------------------------------
%WM_SysTray         = %WM_USER +  1
%WM_CustoReady      = %WM_USER +  2
%WM_AdminBox        = %WM_USER +  3
%WM_Restart         = %WM_USER +  4
%WM_Kill            = %WM_USER +  5
%IDM_TaskBar        = %WM_USER + 501
%IDM_SysTray        = %WM_USER + 502
%IDM_Settings       = %WM_USER + 503
%IDM_WndwTrspt      = %WM_USER + 504
%IDM_FgndTrspt      = %WM_USER + 505
%IDM_BgndTrspt      = %WM_USER + 506
%IDM_FgndCol        = %WM_USER + 507
%IDM_BgndCol        = %WM_USER + 508
%IDM_DefaultCol     = %WM_USER + 509
%IDM_Sep            = %WM_USER + 510
%IDM_SetFont        = %WM_USER + 511
%IDM_DefaultFont    = %WM_USER + 512
%IDM_OnTop          = %WM_USER + 513
%IDM_InScr          = %WM_USER + 514
%IDM_About          = %WM_USER + 515
%IDM_Exit           = %WM_USER + 516
%IDM_Caption        = %WM_USER + 517
%IDM_ChangeCol      = %WM_USER + 518
%IDC_TrackBar       = %WM_USER + 519
%IDM_Minimize       = %WM_USER + 520
%IDM_Maximize       = %WM_USER + 521
%IDM_Resize         = %WM_USER + 522
%IDM_LngEN          = %WM_USER + 523
%IDM_LngFR          = %WM_USER + 524
%IDM_CustoManager   = %WM_USER + 525
%IDM_ShareWidget    = %WM_USER + 526
'--------------------------------------------------------------------------------

'------------------------------------------------------------------------------
' User Defined Types (UDTs)
'--------------------------------------------------------------------------------
TYPE CustomColors
  c(15) AS LONG
END TYPE
'--------------------------------------------------------------------------------
TYPE ExeData
  address AS DWORD
  length  AS DWORD
  desc    AS ASCIIZ * 4
END TYPE
$EXEDATA_MAGIC = "{ExDt}"
'--------------------------------------------------------------------------------
TYPE DialogDescriptor
  Handler       AS DWORD
  Language      AS ASCIIZ * 3
  AllowMinimize AS BYTE
  AllowMaximize AS BYTE
  AllowResize   AS BYTE
  OnTop         AS BYTE
  Caption       AS BYTE
  TaskBar       AS BYTE
  SysTray       AS BYTE
  Transparency  AS BYTE
  FgndTrspt     AS BYTE
  BgndTrspt     AS BYTE
  SettingsEntry AS BYTE
  FgndCol       AS LONG
  BgndCol       AS LONG
  FontName      AS ASCIIZ * %MAX_PATH
  FontSize      AS SINGLE
  FontAttr      AS BYTE
  CustomColorList AS CustomColors
  tn            AS NotifyIconData
  ' following is context menu itself
  hContext      AS DWORD
  hAppearIn     AS DWORD
  hTransparency AS DWORD
  hColors       AS DWORD
  hLng          AS DWORD
  ' position and size of dialog
  X             AS LONG ' X position
  Y             AS LONG ' Y position
  W             AS LONG ' Width
  H             AS LONG ' Height
  ' new stuff
  InScr         AS BYTE ' never off screen
END TYPE
'--------------------------------------------------------------------------------

'------------------------------------------------------------------------------
' Global variables
'--------------------------------------------------------------------------------
GLOBAL LNG              AS STRING * 2
GLOBAL dD4SB            AS DialogDescriptor POINTER
GLOBAL sharedData()     AS STRING ' when packaging a custom widget
GLOBAL CM_newCusto      AS STRING ' when importing a custo
GLOBAL CM_askShortcut   AS LONG   ' add shortcut in startup menu
GLOBAL CM_inAdminBox    AS LONG   ' we are in admin-box mode
GLOBAL CM_debugLogs     AS LONG   ' activate debug logs
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Macro functions
'--------------------------------------------------------------------------------
MACRO TaskBarHeight = 30    ' in pixels (= 20 ; 13 in dialog units)
MACRO CaptionHeight = 21
MACRO SetTransparencies(DialDesc)
  IF ISTRUE(@DialDesc.BgndTrspt) THEN
      SetLayeredWindowAttributes @DialDesc.Handler, @DialDesc.BgndCol, @DialDesc.Transparency, %LWA_Colorkey OR %LWA_ALPHA
  ELSEIF ISTRUE(@DialDesc.FgndTrspt) THEN
      SetLayeredWindowAttributes @DialDesc.Handler, @DialDesc.FgndCol, @DialDesc.Transparency, %LWA_Colorkey OR %LWA_ALPHA
  ELSE
      SetLayeredWindowAttributes @DialDesc.Handler, 0, @DialDesc.Transparency, %LWA_ALPHA
  END IF
END MACRO

'--------------------------------------------------------------------------------
' Subs and Functions
'--------------------------------------------------------------------------------
FUNCTION TimeStamp() AS STRING
    LOCAL e AS STRING
    e = RIGHT$(DATE$,4)+MID$(DATE$,3,2)+LEFT$(DATE$,2)+TIME$
    FUNCTION = $DQ+REMOVE$(e,ANY"-:")+$DQ
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION Locale() AS LONG
' Return the localization (language) of current Windows session from the registry
    LOCAL lcl AS STRING
    lcl = GetRegValue( %HKEY_LOCAL_MACHINE, _
            "SYSTEM\CurrentControlSet\Control\Nls\Language", _
            "Default")
    FUNCTION = VAL("&H0" & RIGHT$(lcl,2))
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB LogMe(s AS STRING)
    LOCAL ff AS LONG
    LOCAL e  AS STRING
    IF ISFALSE CM_debugLogs THEN EXIT SUB ELSE e = s
    ff = FREEFILE
    OPEN EXE.PATH$+EXE.NAME$+"-log.xml" FOR APPEND AS #ff
      IF LEFT$(e,2) = "- " THEN                               ' tag element
        e = MID$(e,2)
      ELSEIF LEFT$(e,1) = "<" AND RIGHT$(e,1) <> ">" THEN     ' opening tag
        e = "<log timestamp="+TimeStamp()+">"+$SPC+MID$(e,2)
      ELSEIF LEFT$(e,1) <> "<" AND RIGHT$(e,1) = ">" THEN     ' closing tag
        e = $SPC+LEFT$(e,-1)+$CRLF+"</log>"
      ELSE
        e = "<log timestamp="+TimeStamp()+"> "+MID$(e,2,-2)+" </log>"
      END IF
      PRINT #ff, e
    CLOSE #ff
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
DECLARE FUNCTION SHGetFolderPath LIB "Shell32.dll" _
    ALIAS "SHGetFolderPathA" (BYVAL hwnd AS DWORD, BYVAL csidl AS LONG, _
    BYVAL hToken AS DWORD, BYVAL dwFlags AS DWORD, pszPath AS ASCIIZ) AS LONG
%CSIDL_STARTUP        = &H0007 ' <user name>\Start Menu\Programs\Startup
%CSIDL_LOCAL_APPDATA  = &H001c ' <user name>\Local Settings\Application Data (non roaming)
'--------------------------------------------------------------------------------
FUNCTION StartupFolder AS STRING
    LOCAL szBaseFolder AS ASCIIZ * %MAX_PATH
    ShGetFolderPath (BYVAL 0, %CSIDL_STARTUP, BYVAL 0, BYVAL 0, szBaseFolder)
    FUNCTION = TRIM$(szBaseFolder) + "\"
END FUNCTION
'--------------------------------------------------------------------------------
FUNCTION LocalAppData AS STRING
    LOCAL szBaseFolder AS ASCIIZ * %MAX_PATH
    ShGetFolderPath (BYVAL 0, %CSIDL_LOCAL_APPDATA, BYVAL 0, BYVAL 0, szBaseFolder)
    FUNCTION = TRIM$(szBaseFolder) + "\"
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Prototypes
DECLARE FUNCTION IShellLink_Call0(BYVAL pUnk AS LONG) AS LONG
DECLARE FUNCTION IShellLink_Call1(BYVAL pUnk AS LONG, BYVAL p1 AS LONG) AS LONG
DECLARE FUNCTION IShellLink_Call2(BYVAL pUnk AS LONG, BYVAL p1 AS LONG, BYVAL p2 AS LONG) AS LONG
'--------------------------------------------------------------------------------
FUNCTION CreateShortcut( _
      BYVAL sTargetLinkName AS STRING _
    , BYVAL sSourceFileName AS STRING _
    , BYVAL sArguments      AS STRING _
    , BYVAL sWorkDir        AS STRING _
    , BYVAL nShowCmd        AS LONG _
    , BYVAL sIconFile       AS STRING _
    , BYVAL nIconIndex      AS LONG _
    , BYVAL sComment        AS STRING _
    ) AS LONG

    LOCAL CLSID_ShellLink AS STRING * 16
    LOCAL IID_IShellLink  AS STRING * 16
    LOCAL IID_Persist     AS STRING * 16
    LOCAL nResult         AS LONG
    LOCAL pShellLnk       AS DWORD PTR
    LOCAL pPersist        AS DWORD PTR

    ' IShellLink interface
    ' IID = 000214EE-0000-0000-C000-000000000046
    ' Inherited interface = IUnknown

    CLSID_ShellLink = MKL$(&H00021401) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    IID_IShellLink  = MKL$(&H000214EE) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    IID_Persist     = MKL$(&H0000010B) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    sTargetLinkName = UCODE$(sTargetLinkName)

    CALL CoInitialize(BYVAL 0&)

    IF CoCreateInstance(BYVAL VARPTR(CLSID_ShellLink), BYVAL 0&, 1, BYVAL VARPTR(IID_IShellLink), pShellLnk) = 0 THEN
        ' IShellLink::SetPath
        CALL DWORD @@pShellLnk[20] USING IShellLink_Call1(pShellLnk, STRPTR(sSourceFileName))
        ' IShellLink::SetsArguments
        CALL DWORD @@pShellLnk[11] USING IShellLink_Call1(pShellLnk, STRPTR(sArguments))
        ' IShellLink::SetWorkingDirectory
        CALL DWORD @@pShellLnk[9] USING IShellLink_Call1(pShellLnk, STRPTR(sWorkDir))
        ' IShellLink::SetnShowCmd
        CALL DWORD @@pShellLnk[15] USING IShellLink_Call1(pShellLnk, nShowCmd)
        ' IShellLink::SetDescription
        CALL DWORD @@pShellLnk[7] USING IShellLink_Call1(pShellLnk, STRPTR(sComment))
        ' Obtain persist interface (QueryInterface)
        CALL DWORD @@pShellLnk[0] USING IShellLink_Call2(pShellLnk, VARPTR(IID_Persist), VARPTR(pPersist))
         ' IShellLink::SetIconLocation
        CALL DWORD @@pShellLnk[17] USING IShellLink_Call2(pShellLnk, STRPTR(sIconFile), 0)

        IF nResult = 0 THEN
            ' Convert to unicode
            ' IPersistFile::Save
            CALL DWORD @@pPersist[6] USING IShellLink_Call2(pPersist, STRPTR(sTargetLinkName), 1)
            ' Release
            CALL DWORD @@pPersist[2] USING IShellLink_Call0(pPersist)
        END IF

        ' Release
        CALL DWORD @@pShellLnk[2] USING IShellLink_Call0(pShellLnk)
        FUNCTION = -1

    END IF

    CALL CoUninitialize()
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
MACRO CfgFile = LocalAppData & EXE.NAME$ & ".cfg"
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION IniFile(caption AS STRING) AS STRING
   FUNCTION = LocalAppData & EXE.NAME$ & "_" & caption & ".ini"
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION Exist(BYVAL fileOrFolder AS STRING) AS LONG
    LOCAL Dummy&
    Dummy& = GETATTR(fileOrFolder)
    FUNCTION = (ERRCLEAR = 0)
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION IsLaunched(caption AS STRING) AS LONG
' Tells us if an instance of program entitled 'caption' is running or not
    LOCAL PrgName AS ASCIIZ * 255
    LOCAL hInstanceMutex AS LONG
    PrgName = caption
    hInstanceMutex = CreateMutex(BYVAL %Null, 0, PrgName)
    IF hInstanceMutex = 0 THEN EXIT FUNCTION ' Error in Mutex
    FUNCTION = (GetLastError = %ERROR_ALREADY_EXISTS)
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB Restart()
  LOCAL pid AS DWORD
  pid = SHELL(EXE.FULL$, 1)
  ExitProcess 12345 ' terminate ourself
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' An 'ExeData' is a chunk of data at the end of an executable, it can be added
' at runtime. Its structure is: [CHUNK OF DATA][CHUNK SIZE][CHUNK DESC][MAGIC]
' where:
' - CHUNK OF DATA is any blob of data, text or binary
' - CHUNK SIZE is the hexadecimal length (on 8 bytes) of this blob of data
' - CHUNK DESC is a descriptor (on 3 bytes) of this blob of data, it can be
'   anything such as: JPG, CFG, TXT, WAV etc.
' - MAGIC is the ExeData magic value: "{ExDt}"
'--------------------------------------------------------------------------------
SUB ParseExeData(BYVAL file AS STRING, BYREF ExDt() AS ExeData)
' Parse an executable and fill the info of its ExeData() parts
    LOCAL a AS STRING
    LOCAL i, n AS LONG

    IF NOT Exist(file) THEN EXIT SUB ELSE a = GetFile(file)
    LogMe "<Parsing ExeData of file "+file+" ("+FORMAT$(LEN(a),"#,")+" Bytes)"

    WHILE RIGHT$(a, LEN($EXEDATA_MAGIC)) = $EXEDATA_MAGIC
        INCR n
        IF ISFALSE ARRAYATTR(ExDt(),0) THEN ' Array not DIMensioned
            DIM ExDt(1 TO 1)
        ELSE
            REDIM PRESERVE ExDt(1 TO UBOUND(ExDt)+1)
        END IF
        i = UBOUND(ExDt)
        a = LEFT$(a, -LEN($EXEDATA_MAGIC))        ' magic value
        ExDt(i).desc = RIGHT$(a, 3) + $NUL
        a = LEFT$(a, -3)                          ' descriptor (3 Bytes)
        ExDt(i).length = VAL("&H0"+RIGHT$(a,8))
        a = LEFT$(a, - (ExDt(i).length + 8))      ' length (8 Bytes)
        ExDt(i).address = LEN(a) + 1
        LogMe "- Found a chunk of data, of type '"+ExDt(i).desc _
             +"', at address "+FORMAT$(ExDt(i).address,"#,")+" (" _
             +"length: "+FORMAT$(ExDt(i).length,"#,")+" Bytes)"
    WEND

    FOR i = 1 TO UBOUND(ExDt) \ 2  ' sort 'ExeData' array
        IF i = UBOUND(ExDt) / 2 THEN EXIT FOR
        SWAP ExDt(i).desc, ExDt(UBOUND(ExDt)-i+1).desc
        SWAP ExDt(i).length, ExDt(UBOUND(ExDt)-i+1).length
        SWAP ExDt(i).address, ExDt(UBOUND(ExDt)-i+1).address
    NEXT
    LogMe FORMAT$(n)+" chunk(s) of data found>"

END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION ClearExeData(BYVAL file AS STRING) AS STRING
' Return the 'exe' part of an executable, w/o any of its ExeData
    LOCAL a  AS STRING
    LOCAL ln AS DWORD

    IF NOT Exist(file) THEN EXIT FUNCTION ELSE a = GetFile(file)
    LogMe "<Clearing ExeData from file "+file+" ("+FORMAT$(LEN(a),"#,")+" Bytes)"

    WHILE RIGHT$(a, LEN($EXEDATA_MAGIC)) = $EXEDATA_MAGIC
        a = LEFT$(a, - (LEN($EXEDATA_MAGIC) + 3)) ' remove magic value + 3B descriptor
        ln = VAL("&H0"+RIGHT$(a,8))
        a = LEFT$(a, - (ln + 8))                  ' remove 8B length + data blob
    WEND
    FUNCTION = a
    LogMe "Done. Clean file is "+FORMAT$(LEN(a),"#,")+" Bytes>"

END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION FindExeData(BYVAL desc AS STRING, BYREF ExDt() AS ExeData, _
         OPTIONAL BYVAL start AS LONG) AS LONG
' Return the ExeData() index containing descriptor 'desc' ; or 0 if not found
    LOCAL st, i AS LONG
    IF start > 1 THEN st = start ELSE st = 1
    FUNCTION = 0
    FOR i = st TO UBOUND(ExDt)
        IF TRIM$(UCASE$(ExDt(i).desc)) = TRIM$(UCASE$(desc)) THEN
            FUNCTION = i
            EXIT FUNCTION
        END IF
    NEXT
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION GetExeData(BYVAL file AS STRING, BYREF ExDtElt AS ExeData) AS STRING
' Return the ExeData(i) part (data chunk) from the executable 'file'
    LOCAL a  AS STRING
    IF NOT Exist(file) THEN EXIT FUNCTION ELSE a = GetFile(file)
    IF ExDtElt.address + ExDtElt.length > LEN(a) THEN EXIT FUNCTION ' out-of-bound
    FUNCTION = MID$(a, ExDtElt.address, ExDtElt.length)
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION AddExeData(src AS STRING, desc AS STRING, chunk AS STRING) AS STRING
' Add 'chunk' data of type 'desc' to the exe (or data) 'src' and return the result
    LOCAL a, d  AS STRING

    IF LEN(src) < %MAX_PATH AND MID$(src, 2, 2) = ":\" THEN
        IF NOT Exist(src) THEN EXIT FUNCTION ELSE a = GetFile(src)
        LogMe "<Adding ExeData to file "+src+" ("+FORMAT$(LEN(a),"#,")+" Bytes)"
    ELSE
        a = src
        LogMe "<Adding ExeData to unnamed executable ("+FORMAT$(LEN(a),"#,")+" Bytes)"
    END IF
    LogMe "- Trying to add a chunk of data, of type '"+desc _
         +"' and length "+FORMAT$(LEN(chunk),"#,")+" Bytes"

    IF LEN(chunk) = 0 OR LEN(desc) > 3 THEN ' empty chunk or illegal descriptor
        FUNCTION = a
        LogMe "Failed. Original file unchanged>"
        EXIT FUNCTION
    END IF
    a += chunk
    a += HEX$(LEN(chunk),8)
    a += SPACE$(3-LEN(TRIM$(desc))) + TRIM$(desc)
    a += $EXEDATA_MAGIC
    FUNCTION = a
    LogMe "Done. New file is "+FORMAT$(LEN(a),"#,")+" Bytes>"

END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB GetSharedData() ' sharedData() needs to be DIMed before calling this sub
    LOCAL i0, i1, i AS LONG

    i0 = LBOUND(sharedData)
    i1 = UBOUND(sharedData)
    REDIM PRESERVE sharedData(i0 TO i1)

    DIM xd(i0 TO i1) AS ExeData
    ParseExeData EXE.FULL$, xd()

    IF UBOUND(xd) > 0 THEN ' found some ExeData in the current executable
        DIM iXD(i0 TO i1) AS LONG ' indexes to the ExeData chunks
        FOR i = i0 TO i1
            iXD(i) = FindExeData(FORMAT$(i,"000"), xd())
            IF iXD(i) > 0 THEN sharedData(i) = GetExeData( EXE.FULL$, xd(iXD(i)) )
        NEXT
    END IF

END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB SetFile(dat AS STRING, file AS STRING)
    LOCAL ff AS LONG
    KILL file
    ff = FREEFILE
    OPEN file FOR BINARY ACCESS WRITE LOCK READ AS #ff
      PUT$ #ff, dat
    CLOSE #ff
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION GetFile(file AS STRING) AS STRING
    LOCAL ff AS LONG
    LOCAL aa AS STRING
    IF NOT Exist(file) THEN EXIT FUNCTION
    ff = FREEFILE
    OPEN file FOR BINARY ACCESS READ LOCK WRITE AS #ff
      GET$ #ff, LOF(#ff), aa
    CLOSE #ff
    FUNCTION = aa
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB SetDialogIconFromDll(hDlg AS DWORD, windll AS STRING, iconId AS LONG)
    LOCAL hIconBig   AS DWORD
    LOCAL hIconSmall AS DWORD

    ExtractIconEx((windll), iconId, BYVAL VARPTR(hIconBig), BYVAL VARPTR(hIconSmall), 1)
    SetClassLong hDlg, %GCL_HICONSM, hIconSmall
    SetClassLong hDlg, %GCL_HICON, hIconBig
    SendMessage  hDlg, %WM_SETICON, %ICON_SMALL, hIconSmall
    SendMessage  hDlg, %WM_SETICON, %ICON_BIG, hIconBig
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB SetLViconFromDll(hDlg AS DWORD, ctl AS LONG, windll AS STRING, iconId AS LONG)
' Display an icon from a DLL inside an Icon ListView
    LOCAL hImgLst AS DWORD
    LOCAL hIcon AS LONG

    hIcon = ExtractIcon(BYVAL 0, (windll), iconId)

    IMAGELIST NEW ICON 32, 32, 24, 1 TO hImgLst ' width, height, depth, initial
    LISTVIEW SET IMAGELIST  hDlg, ctl, hImgLst, %LVSIL_NORMAL
    IMAGELIST ADD ICON      hImgLst, hIcon
    LISTVIEW INSERT ITEM    hDlg, ctl, 1, 1, ""

    DestroyIcon hIcon
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION FontSelect(BYVAL DiDe AS DialogDescriptor POINTER) AS LONG
   LOCAL fName AS STRING, fPoints, fStyle, fColor, CharSet AS LONG

   DISPLAY FONT @DiDe.Handler, -50, -150, @DiDe.FontName, @DiDe.FontSize, 0, _
     %CF_SCREENFONTS OR %CF_FORCEFONTEXIST OR _
     %CF_NOSCRIPTSEL OR %CF_NOSIMULATIONS TO _
     fName, fPoints, fStyle, fColor, CharSet

   IF LEN(fName) THEN
      @DiDe.FontName = fName
      @DiDe.FontSize = fPoints
      @DiDe.FontAttr = fStyle
      FUNCTION = 1
   END IF
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION SelectColor(WhereTo$, BYVAL DiDe AS DialogDescriptor POINTER) AS LONG

   LOCAL startcolor, othercolor, ColorResult AS LONG

   IF LCASE$(WhereTo$) = "foreground" THEN
     startcolor = @DiDe.FgndCol
     othercolor = @DiDe.BgndCol
   ELSEIF LCASE$(WhereTo$) = "background" THEN
     startcolor = @DiDe.BgndCol
     othercolor = @DiDe.FgndCol
   END IF

   DISPLAY COLOR @DiDe.Handler, -50, -150, startcolor, @DiDe.CustomColorList ,0 TO ColorResult

   IF ColorResult = -1 OR ColorResult = othercolor THEN ' we prevent same color for fonts and background because it could
     FUNCTION = startcolor                              ' make dialog unusable if both fonts and bg are transparent
   ELSE
     FUNCTION = ColorResult
   END IF
   SetFocus @DiDe.Handler

END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB CreateSystray(STLabel AS STRING, STIcon AS STRING, BYVAL DiDe AS DialogDescriptor POINTER)

  LOCAL nid AS NotifyIconData

  nid.cbsize = SIZEOF(nid)
  nid.hwnd = @DiDe.Handler
  nid.uid = GetModuleHandle(BYVAL %NULL)
  nid.uflags = %nif_icon OR %nif_message OR %nif_tip
  nid.ucallbackmessage = %WM_SysTray
  nid.hicon = LoadIcon(GetModuleHandle(""), TRIM$(STIcon))
  nid.sztip = STLabel

  @DiDe.tn = nid

END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB CreateContextMenu(BYVAL DiDe AS DialogDescriptor POINTER)

    ' Creating Context Menu
    MENU NEW POPUP TO @DiDe.hContext
    MENU NEW POPUP TO @DiDe.hAppearIn
    MENU NEW POPUP TO @DiDe.hTransparency
    MENU NEW POPUP TO @DiDe.hColors
    MENU NEW POPUP TO @DiDe.hLng

    SELECT CASE LNG
        CASE "FR"
            MENU ADD STRING, @DiDe.hAppearIn, "Barre des tches && Alt+Tab",  %IDM_TaskBar,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hAppearIn, "Zone de notification",  %IDM_SysTray,  %MF_ENABLED

            MENU ADD STRING, @DiDe.hTransparency, "Fentre (choisir %)",  %IDM_WndwTrspt,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hTransparency, "-", %IDM_Sep, 0
            MENU ADD STRING, @DiDe.hTransparency, "Ecritures transparentes",  %IDM_FgndTrspt,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hTransparency, "Fond transparent",  %IDM_BgndTrspt,  %MF_ENABLED

            MENU ADD STRING, @DiDe.hColors, "Couleur des critures",  %IDM_FgndCol,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hColors, "Couleur du fond",  %IDM_BgndCol,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hColors, "Couleurs par dfaut",  %IDM_DefaultCol,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hColors, "-", %IDM_Sep, 0
            MENU ADD STRING, @DiDe.hColors, "Choisir police d'criture",  %IDM_SetFont,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hColors, "Police par dfaut",  %IDM_DefaultFont,  %MF_ENABLED

            MENU ADD STRING, @DiDe.hLng, "Anglais",  %IDM_LngEN,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hLng, "Franais", %IDM_LngFR,  %MF_ENABLED

            MENU ADD STRING, @DiDe.hContext, "Toujours au dessus",  %IDM_OnTop,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "Jamais hors de l'cran",  %IDM_InScr,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "Barre de titre && bordure",  %IDM_Caption,  %MF_ENABLED
            MENU ADD POPUP,  @DiDe.hContext, "Apparatre dans", @DiDe.hAppearIn, %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "-", %IDM_Sep, 0
            MENU ADD STRING, @DiDe.hContext, "Gestionnaire d'apparence", %IDM_CustoManager, %MF_ENABLED
            MENU ADD POPUP,  @DiDe.hContext, "Couleurs && Polices", @DiDe.hColors, %MF_ENABLED
            MENU ADD POPUP,  @DiDe.hContext, "Transparence", @DiDe.hTransparency, %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "Partager cette widget !", %IDM_ShareWidget, %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "-", %IDM_Sep, 0
            IF ISTRUE(@DiDe.SettingsEntry) THEN MENU ADD STRING, @DiDe.hContext, "Options de " + $EXE + "...",  %IDM_Settings,  %MF_ENABLED
            MENU ADD POPUP,  @DiDe.hContext, "Langue",  @DiDe.hLng,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "A propos",  %IDM_About,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "-", %IDM_Sep, 0
            IF ISTRUE(@DiDe.AllowMinimize) THEN MENU ADD STRING, @DiDe.hContext, "Minimiser",  %IDM_Minimize,  %MF_ENABLED
            IF ISTRUE(@DiDe.AllowMaximize) THEN MENU ADD STRING, @DiDe.hContext, "Maximiser",  %IDM_Maximize,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "Quitter",  %IDM_Exit,  %MF_ENABLED
            MENU SET STATE   @DiDe.hContext, BYCMD %IDM_LngFR, 8

        '===================================================================================================================================
        CASE "EN"
            MENU ADD STRING, @DiDe.hAppearIn, "Taskbar && Alt+Tab",  %IDM_TaskBar,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hAppearIn, "Systray",  %IDM_SysTray,  %MF_ENABLED

            MENU ADD STRING, @DiDe.hTransparency, "Window (choose %)",  %IDM_WndwTrspt,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hTransparency, "-", %IDM_Sep, 0
            MENU ADD STRING, @DiDe.hTransparency, "Transparent fonts",  %IDM_FgndTrspt,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hTransparency, "Transparent background",  %IDM_BgndTrspt,  %MF_ENABLED

            MENU ADD STRING, @DiDe.hColors, "Foreground color",  %IDM_FgndCol,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hColors, "Background color",  %IDM_BgndCol,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hColors, "Default colors",  %IDM_DefaultCol,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hColors, "-", %IDM_Sep, 0
            MENU ADD STRING, @DiDe.hColors, "Choose font",  %IDM_SetFont,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hColors, "Default font",  %IDM_DefaultFont,  %MF_ENABLED

            MENU ADD STRING, @DiDe.hLng, "English", %IDM_LngEN,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hLng, "French",  %IDM_LngFR,  %MF_ENABLED

            MENU ADD STRING, @DiDe.hContext, "Always on top",  %IDM_OnTop,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "Never off the screen",  %IDM_InScr,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "Title bar && border",  %IDM_Caption,  %MF_ENABLED
            MENU ADD POPUP,  @DiDe.hContext, "Show in", @DiDe.hAppearIn, %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "-", %IDM_Sep, 0
            MENU ADD STRING, @DiDe.hContext, "Customization Manager", %IDM_CustoManager, %MF_ENABLED
            MENU ADD POPUP,  @DiDe.hContext, "Colors && Font", @DiDe.hColors, %MF_ENABLED
            MENU ADD POPUP,  @DiDe.hContext, "Transparency", @DiDe.hTransparency, %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "Share this widget!", %IDM_ShareWidget, %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "-", %IDM_Sep, 0
            IF ISTRUE(@DiDe.SettingsEntry) THEN MENU ADD STRING, @DiDe.hContext, $EXE + " settings...",  %IDM_Settings,  %MF_ENABLED
            MENU ADD POPUP,  @DiDe.hContext, "Language",  @DiDe.hLng,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "About",  %IDM_About,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "-", %IDM_Sep, 0
            IF ISTRUE(@DiDe.AllowMinimize) THEN MENU ADD STRING, @DiDe.hContext, "Minimize",  %IDM_Minimize,  %MF_ENABLED
            IF ISTRUE(@DiDe.AllowMaximize) THEN MENU ADD STRING, @DiDe.hContext, "Maximize",  %IDM_Maximize,  %MF_ENABLED
            MENU ADD STRING, @DiDe.hContext, "Exit",  %IDM_Exit,  %MF_ENABLED
            MENU SET STATE   @DiDe.hContext, BYCMD %IDM_LngEN, 8

    END SELECT

    MENU SET STATE @DiDe.hContext, BYCMD %IDM_OnTop,     8 * @DiDe.OnTop
    MENU SET STATE @DiDe.hContext, BYCMD %IDM_InScr,     8 * @DiDe.InScr
    MENU SET STATE @DiDe.hContext, BYCMD %IDM_Caption,   8 * @DiDe.Caption
    MENU SET STATE @DiDe.hContext, BYCMD %IDM_TaskBar,   8 * @DiDe.TaskBar
    MENU SET STATE @DiDe.hContext, BYCMD %IDM_SysTray,   8 * @DiDe.SysTray
    MENU SET STATE @DiDe.hContext, BYCMD %IDM_FgndTrspt, 8 * @DiDe.FgndTrspt
    MENU SET STATE @DiDe.hContext, BYCMD %IDM_BgndTrspt, 8 * @DiDe.BgndTrspt

END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB ResetXYinIniFile(file AS STRING, w AS LONG, h AS LONG)
' Used when starting a widget packed with an INI coming from a <> screen size
' Also used by AdminBox
    LOCAL hDC AS LONG
    LOCAL dx AS LONG, dy AS LONG
    hDC = GetDC(GetDesktopWindow)          ' Get "DESKTOP WINDOW" resolution
    dx  = GetDeviceCaps(hDC, %HORZRES)     ' (the screen with Start menu and
    dy  = GetDeviceCaps(hDC, %VERTRES)     '  menubar in case of dual screens)
    WritePrivateProfileString "Coord", "Left", STR$((dx-w)\2), (file)
    WritePrivateProfileString "Coord", "Top",  STR$((dy-h)\2), (file)
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB ResetTaskbarInIniFile(file AS STRING)   ' Used by AdminBox
    WritePrivateProfileString "All", "TaskBar", STR$(1), (file)
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB MuteAskShortcut(file AS STRING)         ' Used by AdminBox
    WritePrivateProfileString "Shortcut", "Ask", STR$(-1), (file)
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB SaveDebugLogsStatus(file AS STRING)     ' Used by AdminBox
    WritePrivateProfileString "Debug", "Logs", STR$(CM_debugLogs), (file)
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' save settings of the app (uses an ini file to store the data) : on top, colors,
' transparency, etc. and restore these settings the next time the app starts
'--------------------------------------------------------------------------------
SUB ThisContextSettings(Task$, BYVAL DiDe AS DialogDescriptor POINTER)
    LOCAL e AS STRING
    DIALOG GET TEXT @DiDe.Handler TO e : e = REMOVE$(e, ANY " :/;,\") : e = IniFile(e)
    IF Exist(EXE.PATH$ & MID$(e, INSTR(e,"\")+1)) THEN ' Force an init from local
      KILL e
      NAME EXE.PATH$ & MID$(e, INSTR(e,"\")+1) AS e
      ResetXYinIniFile(e, @DiDe.W, @DiDe.H) ' imported INI > adapt to current screen size
    END IF
    ContextSettingsDo((e), Task$, BYVAL DiDe)
END SUB
'--------------------------------------------------------------------------------
SUB ContextSettingsDo(file AS STRING, Task$, _ ' Task$ "get"/"save"
   BYVAL DiDe AS DialogDescriptor POINTER)

   LOCAL i AS INTEGER
   LOCAL tempAsciiZ AS ASCIIZ * %MAX_PATH
   LOCAL x, y, w, h AS LONG

   ' Get "VIRTUAL SCREEN" resolution (i.e. including all dual screens if any)
   'vx = GetSystemMetrics(%SM_CXVIRTUALSCREEN)
   'vy = GetSystemMetrics(%SM_CYVIRTUALSCREEN)
   'Dialog Pixels @DiDe.Handler, vx, vy To Units vx, vy

   ' Get "DESKTOP WINDOW" resolution (the screen with Start menu and menubar in case of dual screens)
   'local hDC as long
   'Local dx As Long, dy As Long
   'hDC = GetDC(GetDesktopWindow)
   'dx  = GetDeviceCaps(hDC&, %HORZRES)
   'dy  = GetDeviceCaps(hDC&, %VERTRES)

   'MsgBox "Desktop window resolution is " & Str$(dx) & "x" & Str$(dy) & $crlf & _
   '       "Virtual screen resolution is " & Str$(vx) & "x" & Str$(vy)

   ' Get dialog position and size
   DIALOG GET LOC @DiDe.Handler TO x, y
   DIALOG GET SIZE @DiDe.Handler TO w, h

   IF Task$ = "get" THEN
     IF NOT Exist(file) THEN
       @DiDe.X = x : @DiDe.Y = y
       @DiDe.W = w : @DiDe.H = h
       EXIT SUB
     END IF
     Getprivateprofilestring "Debug", "Logs", "0", tempAsciiZ, %MAX_PATH, (file)
     IF ISFALSE CM_debugLogs AND ISTRUE VAL(tempAsciiZ) THEN
       CM_debugLogs = 1
       LogMe "<Widget instance #"+IIF$(ISTRUE CM_inAdminBox,"2","1")+" started!>"
     END IF
     LogMe "<Opening "+TRIM$(file)+" for GET"
     GetPrivateProfileString "Coord", "Left", FORMAT$(x, "0"), tempAsciiZ, %MAX_PATH, (file)
     @DiDe.X = VAL(tempAsciiZ) : LogMe "- Read 'Left': "+TRIM$(tempAsciiZ)
     GetPrivateProfileString "Coord",  "Top", FORMAT$(y, "0"), tempAsciiZ, %MAX_PATH, (file)
     @DiDe.Y = VAL(tempAsciiZ) : LogMe "- Read 'Top': "+TRIM$(tempAsciiZ)
     GetPrivateProfileString "Coord", "Width", FORMAT$(w, "0"), tempAsciiZ, %MAX_PATH, (file)
     @DiDe.W = VAL(tempAsciiZ) : LogMe "- Read 'Width': "+TRIM$(tempAsciiZ)
     GetPrivateProfileString "Coord",  "Height", FORMAT$(h, "0"), tempAsciiZ, %MAX_PATH, (file)
     @DiDe.H = VAL(tempAsciiZ) : LogMe "- Read 'Height': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "Language", "", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.Language = TRIM$(tempAsciiZ) : LogMe "- Read 'Language': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "OnTop", "0", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.OnTop = VAL(tempAsciiZ) : LogMe "- Read 'OnTop': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "Caption", "1", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.Caption = VAL(tempAsciiZ) : LogMe "- Read 'Caption': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "TaskBar", "1", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.TaskBar = VAL(tempAsciiZ) : LogMe "- Read 'TaskBar': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "SysTray", "0", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.SysTray = VAL(tempAsciiZ) : LogMe "- Read 'SysTray': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "Transparency", "255", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.Transparency = VAL(tempAsciiZ) : LogMe "- Read 'Transparency': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "FgndTrspt", "0", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.FgndTrspt = VAL(tempAsciiZ) : LogMe "- Read 'FgndTrspt': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "BgndTrspt", "0", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.BgndTrspt = VAL(tempAsciiZ) : LogMe "- Read 'BgndTrspt': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "FgndCol", STR$(%BLACK), tempAsciiZ, %MAX_PATH, (file)
     @DiDe.FgndCol = VAL(tempAsciiZ) : LogMe "- Read 'FgndCol': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "BgndCol", STR$(%WHITE), tempAsciiZ, %MAX_PATH, (file)
     @DiDe.BgndCol = VAL(tempAsciiZ) : LogMe "- Read 'BgndCol': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "FontName", "MS Sans Serif", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.FontName = tempAsciiZ : LogMe "- Read 'FontName': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "FontSize", "10", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.FontSize = VAL(tempAsciiZ) : LogMe "- Read 'FontSize': "+TRIM$(tempAsciiZ)
     Getprivateprofilestring "All", "FontAttr", "0", tempAsciiZ, %MAX_PATH, (file)
     @DiDe.FontAttr = VAL(tempAsciiZ) : LogMe "- Read 'FontAttr': "+TRIM$(tempAsciiZ)
     FOR i = 0 TO 15
       Getprivateprofilestring "Custom", "CustomColorC" + FORMAT$(i,"00"), "", tempAsciiZ, %MAX_PATH, (file)
       @DiDe.CustomColorList.c(i) = VAL(tempAsciiZ) : LogMe "- Read 'CustomColor("+FORMAT$(i)+")': "+TRIM$(tempAsciiZ)
     NEXT i
     Getprivateprofilestring "Shortcut", "Ask", "1", tempAsciiZ, %MAX_PATH, (file)
     CM_askShortcut = VAL(tempAsciiZ) : LogMe "- Read 'AskShortcut': "+TRIM$(tempAsciiZ)

   '==================================================================================================================
   ELSEIF Task$ = "save" THEN
     LogMe "<Opening "+TRIM$(file)+" for SAVE"
     IF ISFALSE(IsIconic(@DiDe.Handler) OR IsZoomed(@DiDe.Handler)) THEN
       IF ISTRUE(@DiDe.Caption) THEN
         IF ISTRUE(@DiDe.TaskBar) THEN
           x = @DiDe.X + 2 : y = @DiDe.Y + TaskBarHeight
           w = @DiDe.W + 2 : h = @DiDe.H + TaskBarHeight
         ELSE
           x = @DiDe.X + 2 : y = @DiDe.Y + CaptionHeight
           w = @DiDe.W + 2 : h = @DiDe.H + CaptionHeight
         END IF
       END IF
       WritePrivateProfileString "Coord", "Left", STR$(x), (file) : LogMe "- Write 'Left': "+FORMAT$(x)
       WritePrivateProfileString "Coord", "Top", STR$(y), (file) : LogMe "- Write 'Top': "+FORMAT$(y)
       WritePrivateProfileString "Coord", "Width", STR$(w), (file) : LogMe "- Write 'Width': "+FORMAT$(w)
       WritePrivateProfileString "Coord", "Height", STR$(h), (file) : LogMe "- Write 'Height': "+FORMAT$(h)
     END IF
     tempAsciiZ = TRIM$(LNG) : LogMe "- Write 'Language': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "Language", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.OnTop) : LogMe "- Write 'OnTop': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "OnTop", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.Caption) : LogMe "- Write 'Caption': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "Caption", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.TaskBar) : LogMe "- Write 'TaskBar': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "TaskBar", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.SysTray) : LogMe "- Write 'SysTray': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "SysTray", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.Transparency) : LogMe "- Write 'Transparency': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "Transparency", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.FgndTrspt) : LogMe "- Write 'FgndTrspt': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "FgndTrspt", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.BgndTrspt) : LogMe "- Write 'BgndTrspt': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "BgndTrspt", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.FgndCol) : LogMe "- Write 'FgndCol': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "FgndCol", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.BgndCol) : LogMe "- Write 'BgndCol': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "BgndCol", tempASCIIZ, (file)
     tempAsciiZ = $SPC & @DiDe.FontName : LogMe "- Write 'FontName': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "FontName", tempAsciiZ, (file)
     tempAsciiZ = STR$(@DiDe.FontSize) : LogMe "- Write 'FontSize': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "FontSize", tempASCIIZ, (file)
     tempAsciiZ = STR$(@DiDe.FontAttr) : LogMe "- Write 'FontAttr': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "All", "FontAttr", tempAsciiZ, (file)
     FOR i = 0 TO 15
       tempAsciiZ = STR$(@DiDe.CustomColorList.c(i)) : LogMe "- Write 'CustomColor("+FORMAT$(i)+")': "+TRIM$(tempAsciiZ)
       WritePrivateProfileString "Custom", "CustomColorC" + FORMAT$(i,"00"), tempAsciiZ, (file)
     NEXT i
     tempAsciiZ = STR$(CM_askShortcut) : LogMe "- Write 'AskShortcut': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "Shortcut", "Ask", tempAsciiZ, (file)
     tempAsciiZ = STR$(CM_debugLogs) : LogMe "- Write 'DebugLogs': "+TRIM$(tempAsciiZ)
     WritePrivateProfileString "Debug", "Logs", tempAsciiZ, (file)

   END IF
   LogMe "Operation Complete>"
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcTransparencyTrackBar

  SELECT CASE CB.MSG

    ' Dialog has lost focus : simulate press on "x" button
    CASE %WM_NCACTIVATE
      IF ISFALSE(CBWPARAM) THEN CONTROL SEND CB.HNDL, %IDCANCEL, %CB_SHOWDROPDOWN, %True, 0

    CASE %WM_COMMAND
      ' The user selected the CLOSE button
      IF CB.CTL = %IDCANCEL THEN
        LogMe "<Need to save new transparency chosen from trackbar>"
        ThisContextSettings "save", dD4SB ' save new transparency
        DIALOG END CB.HNDL, 0
      END IF

    ' User changed TrackBar
    CASE %WM_VSCROLL
      SELECT CASE LOWRD(CB.WPARAM)
        CASE %TB_THUMBTRACK, %TB_THUMBPOSITION ' Mouse / Mousewheel activity
          @dD4SB.Transparency = 280 - HIWRD(CB.WPARAM)
          SetTransparencies(dD4SB)
        CASE %TB_TOP ' Keyboard Home
          @dD4SB.Transparency = 255
          SetTransparencies(dD4SB)
        CASE %TB_BOTTOM ' Keyboard End
          @dD4SB.Transparency = 25
          SetTransparencies(dD4SB)
        CASE %TB_PAGEUP ' Keyboard PageUp
          @dD4SB.Transparency = MIN(255, @dD4SB.Transparency + 10)
          SetTransparencies(dD4SB)
        CASE %TB_LINEUP ' Keyboard Up key
          @dD4SB.Transparency = MIN(255, @dD4SB.Transparency + 1)
          SetTransparencies(dD4SB)
        CASE %TB_PAGEDOWN ' Keyboard PageDown
          @dD4SB.Transparency = MAX(25, @dD4SB.Transparency - 10)
          SetTransparencies(dD4SB)
        CASE %TB_LINEDOWN ' Keyboard Down key
          @dD4SB.Transparency = MAX(25, @dD4SB.Transparency - 1)
          SetTransparencies(dD4SB)
      END SELECT

  END SELECT

END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION ShowTransparencyTrackBar(BYVAL DiDe AS DialogDescriptor POINTER) AS LONG

    LOCAL hDlg AS DWORD
    LOCAL lRslt AS LONG
    LOCAL PA AS POINTAPI

    SetTransparencies(DiDe)

    GetCursorPos PA
    DIALOG NEW PIXELS, %HWND_DESKTOP, "Transparency TrackBar", PA.X - 13, PA.Y - 36, 26, 96 TO hDlg

    SetWindowLong hDlg, %GWL_style, GetWindowLong(hDlg, %GWL_style) XOR %WS_CAPTION XOR %WS_BORDER OR %WS_EX_TOOLWINDOW
    SetWindowLong hDlg, %GWL_EXstyle, GetWindowLong(hDlg, %GWL_EXstyle) OR %WS_EX_TOOLWINDOW

    CONTROL ADD BUTTON, hDlg, %IDCANCEL, "x", 3, 3, 20, 20

    CONTROL ADD "msctls_trackbar32", hDlg, %IDC_TrackBar, "", 0, 24, 26, 108, _
              %WS_CHILD OR %WS_VISIBLE OR %BS_NOTIFY OR %TBS_VERT OR %TBS_BOTH OR %TBS_NOTICKS
    CONTROL SEND hDlg, %IDC_TrackBar, %TBM_SETRANGE, %TRUE, MAKDWD(25, 255)
    CONTROL SEND hDlg, %IDC_TrackBar, %TBM_SETPAGESIZE, 0, 10
    CONTROL SEND hDlg, %IDC_TrackBar, %TBM_SETPOS, %TRUE, 280 - @DiDe.Transparency

    dD4SB = DiDe
    DIALOG SHOW MODELESS hDlg, CALL ProcTransparencyTrackBar TO lRslt

    FUNCTION = lRslt
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcCustoManager
    LOCAL e AS STRING
    LOCAL i AS LONG
    IF CB.MSG = %WM_COMMAND THEN
        SELECT CASE AS LONG CB.CTL
            CASE  999                                   ' CLICK ON "RESET APPEARANCE AND RESTART" ZONE
                DIALOG GET TEXT @dD4SB.Handler TO e
                e = REMOVE$(e, ANY " :/;,\")
                KILL IniFile(e)
                KILL CfgFile
                Restart()
                DIALOG END @dD4SB.handler
            CASE 1001                                   ' DOUBLE-CLICK ON LISTBOX > SIMULATE OK BUTTON
                IF CB.CTLMSG = %LBN_DBLCLK THEN
                    DIALOG POST CB.HNDL, %WM_COMMAND, MAKDWD(%IDOK,1), 0
                END IF
            CASE %IDOK                                  ' CLICK ON OK BUTTON
                LISTBOX GET SELECT CB.HNDL, 1001 TO i
                IF i > 0 THEN ' a widget is selected
                    LISTBOX GET TEXT CB.HNDL, 1001, i TO CM_newCusto
                    CM_newCusto = LocalAppData + CM_newCusto
                    DIALOG POST @dD4SB.Handler, %WM_CustoReady, 0, 0
                END IF
                DIALOG END CB.HNDL
            CASE %IDCANCEL                              ' CLICK ON CANCEL BUTTON
                DIALOG END CB.HNDL
                EXIT FUNCTION
        END SELECT
    ELSEIF CB.MSG = %WM_VKEYTOITEM THEN
        LISTBOX GET SELECT CB.HNDL, 1001 TO i
        IF LOWRD(CB.WPARAM) = %VK_DELETE AND i > 0 THEN ' TRAP DEL KEY TO DELETE A CUSTO
            LISTBOX GET TEXT CB.HNDL, 1001, i TO e
            e = LocalAppData + e
            IF MessageBox(CB.HNDL, IIF$(LNG="EN", _
                "Are you sure you want to delete widget custo", _
                "tes vous sr de supprimer la perso de la widget") _
                +$CR+e+" ?", EXE.NAME$, %MB_YESNO) = %IDYES THEN
                KILL e
                LISTBOX DELETE CB.HNDL, 1001, i
            END IF ' end of answered 'Yes' to delete msgbox
            FUNCTION = -2 ' listbox should ignore, we took care of actions
        ELSE
            FUNCTION = -1 ' listbox should perform default action
        END IF ' end of treating DEL key
    END IF
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB PopulateCustos(BYVAL hDlg AS DWORD, BYVAL lID AS LONG)
    LOCAL e AS STRING
    e = DIR$(LocalAppData + "*.ini")
    WHILE e <> ""
        IF INSTR(e, "_") <> 0 THEN LISTBOX ADD hDlg, lID, e
        e = DIR$(NEXT)
    WEND
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB ShowCustoManager(BYVAL DiDe AS DialogDescriptor POINTER)
    LOCAL hD  AS DWORD

    DIALOG NEW @DiDe.handler, $EXE, -50, -50, 259, 159, _
      %DS_MODALFRAME OR %WS_CAPTION OR %WS_POPUP OR %WS_SYSMENU, TO hD

    SetDialogIconFromDll hD, "Shell32.dll", 22

    CONTROL ADD LABEL,   hD,  999, IIF$(LNG="EN", _
        "Click here to fully reset this widget appearance", _
        "Cliquez ici pour rinitialiser totalement l'apparence de la widget"), _
        5, 5, 244, 15, %SS_NOTIFY OR %SS_CENTER OR _
        %SS_CENTERIMAGE OR %SS_SUNKEN, _
        %WS_EX_WINDOWEDGE OR %WS_EX_STATICEDGE
    CONTROL SET COLOR    hD,  999, %RED, -1

    CONTROL ADD LABEL,   hD, 1000, IIF$(LNG="EN", _
        "Or import a widget appearance from:", _
        "Ou importer une apparence de widget depuis :"), _
        5, 24, 160, 10

    CONTROL ADD LISTBOX, hD, 1001, , 5, 35, 250, 100, _
        %LBS_NOTIFY OR %WS_TABSTOP OR %WS_VSCROLL _
        OR %LBS_USETABSTOPS OR %LBS_WANTKEYBOARDINPUT, _
        %WS_EX_CLIENTEDGE

    CONTROL ADD BUTTON,  hD, %IDCANCEL, IIF$(LNG="EN","Cancel","Annuler"), 130, 140, 55, 15

    CONTROL ADD BUTTON,  hD, %IDOK, IIF$(LNG="EN","Import","Importer"), 205, 140, 50, 15

    dD4SB = DiDe
    PopulateCustos       hD, 1001
    DIALOG SHOW MODAL    hD, CALL ProcCustoManager
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcAdminBox
    IF CB.MSG = %WM_COMMAND THEN DIALOG END CB.HNDL, IIF(CB.CTL=%IDCANCEL, 0, CB.CTL-999)
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
FUNCTION ShowAdminBox() AS LONG
    LOCAL hD   AS DWORD
    LOCAL lRes AS LONG

    DIALOG NEW 0, $EXE+" admin box",,, 210, 140, _
      %DS_MODALFRAME OR %WS_CAPTION OR %WS_POPUP OR %WS_SYSMENU, TO hD

    DIALOG SET ICON       hD, "ICO1"

    CONTROL ADD LABEL,    hD, 998, IIF$(LNG="EN","Instance:","Session : "), 5, 5, 35, 10
    CONTROL ADD TEXTBOX,  hD, 999, EXE.NAMEX$, 40, 5, 155, 10, %WS_CHILD OR _
      %WS_VISIBLE OR %WS_DISABLED OR %WS_TABSTOP OR %ES_LEFT OR _
      %ES_AUTOHSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
      %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR

    CONTROL ADD BUTTON,   hD, 1000, IIF$(LNG="EN", _
        "Re-center widget on screen (reset position)", _
        "Recentrer la widget  l'cran (rz coordonnes)"), _
        15, 20, 180, 15

    CONTROL ADD BUTTON,   hD, 1001, IIF$(LNG="EN", _
        "Force widget to show in Taskbar && Alt+Tab", _
        "Forcer apparition ds barre des tches && Alt+Tab"), _
        15, 40, 180, 15

    CONTROL ADD BUTTON,   hD, 1002, IIF$(LNG="EN", _
        "Fully reset widget (appearance and settings)", _
        "Rz complet widget (apparence et options)"), _
        15, 60, 180, 15

    CONTROL ADD TEXTBOX,  hD, 1003, IIF$(LNG="EN", _
        "KILL THE WIDGET", _
        "TUER LA WIDGET"), _
        15, 85, 45, 25, %ES_READONLY OR %ES_CENTER OR _
        %ES_MULTILINE OR %WS_BORDER, _
        %WS_EX_WINDOWEDGE OR %WS_EX_STATICEDGE
    CONTROL SET COLOR     hD, 1003, %RED, -2

    CONTROL ADD CHECKBOX, hD, 1004, IIF$(LNG="EN", _
        "Run at Windows startup", _
        "Lancer au dmarrage de Windows"), _
        70, 85, 130, 10
    IF Exist(StartupFolder & EXE.NAME$ & ".lnk") THEN CONTROL SET CHECK hD, 1004, 1

    CONTROL ADD CHECKBOX, hD, 1005, IIF$(LNG="EN", _
        "Activate debug logs", _
        "Activer les logs de dbogage"), _
        70, 100, 130, 10
    IF ISTRUE CM_debugLogs THEN CONTROL SET CHECK hD, 1005, 1

    CONTROL ADD BUTTON,   hD, %IDCANCEL, IIF$(LNG="EN","Cancel","Annuler"), 140, 120, 55, 15

    DIALOG SHOW MODAL     hD, CALL ProcAdminBox TO lRes
    FUNCTION = lRes
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB MakeStartupShortcut
    KILL StartupFolder & EXE.NAME$ & ".lnk"
    CreateShortcut _
      StartupFolder & EXE.NAME$ & ".lnk", _ ' 1. the link file to be created
      EXE.FULL$,                          _ ' 2. the file/document where the shortcut should point to
      "",                                 _ ' 3. command-line parameters
      EXE.PATH$,                          _ ' 4. the folder where the executable file should start in
      %SW_SHOW,                           _ ' 5. %SW_SHOW, %SW_HIDE etc.
      EXE.FULL$,                          _ ' 6. icon file or executable file containing an icon
      0,                                  _ ' 7. icon index in the aforementioned file
      "http://mougino.free.fr"              ' 8. any comment (stored in the shortcut)
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
CALLBACK FUNCTION ProcShortcutBox
    IF CB.MSG = %WM_COMMAND THEN
      IF CB.CTL = %IDCANCEL OR CB.CTL = %IDOK THEN
        CONTROL GET CHECK CB.HNDL, 1000 TO CM_askShortcut : CM_askShortcut = 1 - CM_askShortcut
        IF CB.CTL = %IDCANCEL THEN DIALOG END CB.HNDL : EXIT FUNCTION
        MakeStartupShortcut()
        DIALOG END CB.HNDL
      END IF
    END IF
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
SUB ShowShortcutBox()
    LOCAL hD  AS DWORD

    DIALOG NEW PIXELS, 0, EXE.NAME$, , , 302, 124 TO hD

    CONTROL ADD LISTVIEW,  hD, 998, "", -8, 8, 56, 36, _
      %LVS_ICON OR %WS_DISABLED OR %LVS_NOSCROLL
    LISTVIEW INSERT COLUMN hD, 998, 1, "icon", 32, 0
    LISTVIEW INSERT COLUMN hD, 998, 2, "icon", 32, 0

    SetLViconFromDll       hD, 998, "Shell32.dll", 23 ' question mark

    CONTROL ADD LABEL,     hD, 999, IIF$(LNG="EN", _
      "Do you want to run this widget at Windows startup?", _
      "Lancer cette widget au dmarrage de Windows ?"), _
      80, 20, 208, 32
    CONTROL ADD CHECKBOX,  hD, 1000, IIF$(LNG="EN", _
      "Do not ask me again", _
      "Ne plus me le demander"), _
      80, 64, 208, 16
    CONTROL ADD BUTTON,    hD, %IDOK, IIF$(LNG="EN","Yes","Oui"), 224, 96, 64, 24
    CONTROL ADD BUTTON,    hD, %IDCANCEL, IIF$(LNG="EN","No","Non"), 136, 96, 64, 24

    DIALOG SHOW MODAL      hD, CALL ProcShortcutBox
END SUB
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' HandleContextCbMsg handles the CallBack Messages linked to Context Menu.
'   Parameters are Dialog Descriptor (containing CallBack Handle), CallBack Message,
'   CallBack Control, CallBack WParameter and CallBack LParameter
'--------------------------------------------------------------------------------
SUB HandleContextCbMsg(BYVAL DiDe AS DialogDescriptor POINTER, CbMs AS LONG, CbCt AS LONG, CbPa AS LONG, CbP2 AS LONG)
  LOCAL Language, caption, newCfgFile, sharedWidget, xdata AS STRING
  LOCAL x, y, w, h AS LONG
  LOCAL mX, mY AS LONG
  LOCAL PA AS POINTAPI

  ' Get mouse position
  GetCursorPos PA
  mX = PA.X : mY = PA.Y

  ' Start handling CallBack Messages
  SELECT CASE CbMs

    '****************************************************************************************************************
    ' CallBack Message sent right before the dialog is displayed
    '****************************************************************************************************************
    CASE %WM_INITDIALOG
      ' Allow only one instance of program?
      IF ISTRUE(%ALLOW_ONLY_ONE_INSTANCE) THEN
        CM_inAdminBox = IsLaunched(EXE.NAME$) ' another instance of program already launched
      END IF

      ' Get previously saved parameters
      ThisContextSettings "get", DiDe

      ' Set program language
      IF TRIM$(@DiDe.Language) = "" THEN
          x = Locale()
          IF x = %LANG_FRENCH THEN @DiDe.Language = "FR" ELSE @DiDe.Language = "EN"
          LogMe "<Locale undefined: read language '"+@DiDe.Language+"' (0x"+HEX$(x,2)+") from registry>"
      END IF
      LNG = @DiDe.Language

      ' Stop init and derive to admin box if needed
      IF ISTRUE CM_inAdminBox THEN
        LogMe "<Launching AdminBox to manage widget instance #1>"
        DIALOG POST @DiDe.Handler, %WM_AdminBox, 0, 0
        EXIT SUB
      END IF

      ' Is the current application packed with an Appearance file
      ' and/or a Settings file and missing one in LocalAppData?
      DIALOG GET TEXT @DiDe.Handler TO caption : caption = REMOVE$(caption, ANY " :/;,\")
      LogMe "<Preparing to display dialog #"+FORMAT$(@DiDe.Handler)+" captioned "+$DQ+caption+$DQ+">"
      IF NOT Exist(IniFile(caption)) THEN
        DIM xd(-1) AS ExeData
        ParseExeData EXE.FULL$, xd()
        IF UBOUND(xd) > 0 THEN ' found some ExeData
            LOCAL iXD, cXD AS LONG
            iXD = FindExeData("INI", xd())
            cXD = FindExeData("CFG", xd())
            IF iXD > 0 THEN
                SetFile GetExeData(EXE.FULL$, xd(iXD)), IniFile(caption) ' widget may be imported from a screen with
                ResetXYinIniFile(IniFile(caption),@DiDe.W,@DiDe.H)       ' different resolution -> reset its position
            END IF
            IF cXD > 0 THEN SetFile GetExeData(EXE.FULL$, xd(cXD)), CfgFile
            Restart() ' Restart widget to take these files into account
            DIALOG END @DiDe.handler
        END IF
      END IF

      ' Create the Context Menu
      CreateContextMenu DiDe

      ' Initialize Styles and Extended Styles of dialog
      ShowWindow @DiDe.Handler, %SW_HIDE
      SetWindowLong @DiDe.Handler, %GWL_style, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME _
                    OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
                    OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR %WS_CAPTION
      SetWindowLong @DiDe.Handler, %GWL_EXstyle, %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT _
                    OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR OR %WS_EX_TOOLWINDOW

      ' Minimize, Maximize, Resizable capabilities
      IF ISTRUE(@DiDe.AllowMinimize) THEN SetWindowLong @DiDe.Handler, %GWL_style, GetWindowLong(@DiDe.Handler, %GWL_style) OR %WS_MINIMIZEBOX
      IF ISTRUE(@DiDe.AllowMaximize) THEN SetWindowLong @DiDe.Handler, %GWL_style, GetWindowLong(@DiDe.Handler, %GWL_style) OR %WS_MAXIMIZEBOX
      IF ISTRUE(@DiDe.AllowResize)   THEN SetWindowLong @DiDe.Handler, %GWL_style, GetWindowLong(@DiDe.Handler, %GWL_style) OR %WS_THICKFRAME

      ' Set Always On Top
      SetWindowPos @DiDe.Handler, IIF(@DiDe.OnTop, %HWND_TOPMOST, %HWND_NOTOPMOST), 0, 0, 0, 0, %SWP_NOMOVE OR %SWP_NOSIZE
      ShowWindow @DiDe.Handler, %SW_SHOW

      ' Set Caption
      IF ISFALSE(@DiDe.Caption) THEN
        SetWindowLong @DiDe.Handler, %GWL_style, GetWindowLong(@DiDe.Handler, %GWL_style) XOR %WS_CAPTION
      END IF

      ' Set TaskBar
      IF ISTRUE(@DiDe.TaskBar) THEN
        ShowWindow @DiDe.Handler, %SW_HIDE
        SetWindowLong @DiDe.Handler, %GWL_EXstyle, GetWindowLong(@DiDe.Handler, %GWL_EXstyle) XOR %WS_EX_TOOLWINDOW
        ShowWindow @DiDe.Handler, %SW_SHOW
      END IF

      ' Set Dialog position and size (caption and taskbar have an impact on them!)
      IF ISTRUE(@DiDe.Caption) THEN
        IF ISTRUE(@DiDe.TaskBar) THEN
          @DiDe.X -= 2 : @DiDe.Y -= TaskBarHeight
          @DiDe.W -= 2 : @DiDe.H -= TaskBarHeight
        ELSE
          @DiDe.X -= 2 : @DiDe.Y -= CaptionHeight
          @DiDe.W -= 2 : @DiDe.H -= CaptionHeight
        END IF
      END IF
      DIALOG SET LOC @DiDe.Handler, @DiDe.X, @DiDe.Y
      DIALOG SET SIZE @DiDe.Handler, @DiDe.W, @DiDe.H
      ShowWindow @DiDe.Handler, %SW_SHOW

      ' Set SysTray
      Shell_NotifyIcon IIF(@DiDe.SysTray, %nim_add, %nim_delete), @DiDe.tn

      ' Call RefreshDialog for the first time: create font, set FG & BG Colors
      RefreshDialog DiDe
      ' To Developer : define a "RefreshDialog()" sub in your main file in order
      ' to refresh your dialog at creation, or after a font or color change
      ' e.g. :
      ' Global hFont As Dword
      ' Sub RefreshDialog(byval DiDe as DialogDescriptor Pointer)
      '   If @DiDe.Handler = myDialogDescriptor.Handler Then ' Treat differently for each Dialog having a Context Menu
      '     If hFont = 0 Then Font New @DiDe.FontName, @DiDe.FontSize, @DiDe.FontAttr To hFont
      '     Control Set Font  @DiDe.Handler, %IDC_MYCONTROL1, hFont
      '     Control Set Color @DiDe.Handler, %IDC_MYCONTROL1, @DiDe.FgndCol, @DiDe.BgndCol
      '     Control Set Text  @DiDe.Handler, %IDC_MYCONTROL1, "My Text"
      '     Dialog ReDraw @DiDe.Handler
      '   End If
      ' End Sub

      ' Set Dialog Transparency / Transparent Font / Transparent Background
      SetWindowLong @DiDe.Handler, %GWL_EXSTYLE, GetWindowLong(@DiDe.Handler, %GWL_EXstyle) OR %WS_EX_LAYERED
      SetTransparencies(DiDe)

      ' Call ShortcutBox if shortcut does not exist in Startup menu (and user did not choose "do not ask me again")
      IF NOT Exist(StartupFolder & EXE.NAME$ & ".lnk") AND CM_askShortcut > 0 THEN ShowShortcutBox()
      IF CM_askShortcut = -1 THEN CM_askShortcut = 1


    '****************************************************************************************************************
    ' CallBack Message sent when dialog has been moved or resized
    '****************************************************************************************************************
    CASE %WM_SIZE, %WM_EXITSIZEMOVE
      IF CbPa = %SIZE_MAXIMIZED OR CbPa = %SIZE_RESTORED AND ISFALSE CM_inAdminBox THEN
        DIALOG GET LOC @DiDe.Handler TO x, y
        DIALOG GET SIZE @DiDe.Handler TO w, h
        @DiDe.X = x : @DiDe.Y = y
        @DiDe.W = w : @DiDe.H = h
        LogMe "<Need to save new widget position or size>"
        ThisContextSettings "save", DiDe ' save new position
      END IF


    '****************************************************************************************************************
    ' CallBack Message sent when screen resolution is changed (or user plugged/unplugged 2nd screen...)
    '****************************************************************************************************************
    CASE %WM_DISPLAYCHANGE
      IF @DiDe.InScr = 0 THEN EXIT SUB
      ' Get "VIRTUAL SCREEN" resolution (i.e. including all dual screens if any)
      x = GetSystemMetrics(%SM_CXVIRTUALSCREEN)
      y = GetSystemMetrics(%SM_CYVIRTUALSCREEN)
      DIALOG PIXELS @DiDe.Handler, x, y TO UNITS x, y
      IF @DiDe.X > x - @DiDe.W THEN @DiDe.X = x - @DiDe.W
      IF @DiDe.Y > y - @DiDe.H THEN @DiDe.Y = y - @DiDe.H
      DIALOG SET LOC @DiDe.Handler, @DiDe.X, @DiDe.Y


    '****************************************************************************************************************
    ' CallBack Message sent when user right-clicks or presses 'Context' key
    '****************************************************************************************************************
    CASE %WM_ContextMenu
      TrackPopupMenu @DiDe.hContext, %TPM_LEFTALIGN OR %TPM_TOPALIGN, mX , mY , 0, @DiDe.Handler, BYVAL %null


    '****************************************************************************************************************
    ' CallBack Message sent when user scrolls mouse wheel -> change transparency
    '****************************************************************************************************************
    CASE %WM_MOUSEWHEEL
      SELECT CASE HIINT(CbPa)
        CASE > 0 : @DiDe.Transparency = MIN(255, @DiDe.Transparency + 10)
        CASE < 0 : @DiDe.Transparency = MAX(25, @DiDe.Transparency - 10)
      END SELECT
      SetTransparencies(DiDe)


    '****************************************************************************************************************
    ' User made a right-click or double-click on program icon in SysTray
    '****************************************************************************************************************
    CASE %WM_SysTray
      IF CbP2 = %WM_RBUTTONDOWN OR CbP2 = %WM_LBUTTONDBLCLK THEN
        TrackPopupMenu @DiDe.hContext, %TPM_BOTTOMALIGN OR %TPM_RIGHTALIGN, mX, mY, 0, @DiDe.Handler, BYVAL %null
        PostMessage @DiDe.Handler, %WM_NULL, 0, 0
      END IF


    '****************************************************************************************************************
    ' CallBack Message is a Mouse or Keyboard event
    ' including an event generated by Context Menu itself
    '****************************************************************************************************************
    CASE %WM_COMMAND
      SELECT CASE CbCt

        ' User selected "Change Font" in Context menu, and selected a new valid font in the font picker
        CASE %IDM_SetFont
          IF FontSelect(DiDe) = 1 THEN ' no user cancel
            ChangeFont DiDe
            RefreshDialog DiDe
            LogMe "<Need to save user choice of a new font>"
            ThisContextSettings "save", DiDe ' save new font
          END IF
          ' To Developer : define a "ChangeFont()" sub in your main file in order to handle a font change
          ' e.g. :
          ' Global hFont as Dword
          ' Sub ChangeFont(byval DiDe as DialogDescriptor Pointer)
          '   If @DiDe.Handler = myDialogDescriptor.Handler Then ' Treat differently for each Dialog having a Context Menu
          '     Font End hFont : hFont = 0
          '   End If
          ' End Sub

        ' User selected "Default Font" in Context menu
        CASE %IDM_DefaultFont
          DefaultFont DiDe
          ChangeFont DiDe
          RefreshDialog DiDe
          LogMe "<Need to save user choice to go back to default font>"
          ThisContextSettings "save", DiDe ' save font
          ' To Developer : define a "DefaultFont()" sub in your main file in order to set the default font values
          ' e.g. :
          ' Sub DefaultFont(byval DiDe as DialogDescriptor Pointer)
          '   If @DiDe.Handler = myDialogDescriptor.Handler Then ' Treat differently for each Dialog having a Context Menu
          '     @DiDe.FontName = "Tahoma"
          '     @DiDe.FontSize = 12
          '     @DiDe.FontAttr = 1 ' 1 = "Bold"
          '   End If
          ' End Sub

        ' User selected "Default Colors" in Context menu
        CASE %IDM_DefaultCol
          DefaultColors DiDe
          RefreshDialog DiDe
          LogMe "<Need to save user choice to go back to default colors>"
          ThisContextSettings "save", DiDe ' save colors
          ' To Developer : define a "DefaultColors()" sub in your main file in order to set default colors values
          ' e.g. :
          ' Sub DefaultColors(byval DiDe as DialogDescriptor Pointer)
          '   If @DiDe.Handler = myDialogDescriptor.Handler Then ' Treat differently for each Dialog having a Context Menu
          '     @DiDe.FgndCol = %black
          '     @DiDe.BgndCol = RGB(224,223,227)
          '   End If
          ' End Sub
          SetTransparencies(DiDe)

        ' User changed language to ENGLISH in Context menu
        CASE %IDM_LngEN
          IF LNG <> "EN" THEN
            LNG = "EN"
            MENU SET STATE @DiDe.hContext, BYCMD %IDM_LngEN, 8
            MENU SET STATE @DiDe.hContext, BYCMD %IDM_LngFR, 0
            ChangeLanguage(DiDe)
            ' To Developer : define a "ChangeLanguage()" sub in your main file in order to change labels to a specified language
            ' The value of the language the user just chose is in the variable +LNG+ in the form of 2 characters (EN, FR...)
            ' e.g. :
            ' Sub ChangeLanguage(byval DiDe as DialogDescriptor Pointer)
            '   If @DiDe.Handler = myDialogDescriptor.Handler Then ' Treat differently for each Dialog having a Context Menu
            '     CONTROL SET TEXT @DiDe.Handler, %IDC_LABEL_1, "Language changed to " & LNG
            '   End If
            ' End Sub
            DestroyMenu @DiDe.hContext
            DestroyMenu @DiDe.hAppearIn
            DestroyMenu @DiDe.hTransparency
            DestroyMenu @DiDe.hColors
            DestroyMenu @DiDe.hLng
            ' Create new Context Menu in the good language
            CreateContextMenu DiDe
            LogMe "<Need to save user choice to switch widget to english>"
            ThisContextSettings "save", DiDe ' save new language
          END IF

        ' User changed language to FRENCH in Context menu
        CASE %IDM_LngFR
          IF LNG <> "FR" THEN
            LNG = "FR"
            MENU SET STATE @DiDe.hContext, BYCMD %IDM_LngEN, 0
            MENU SET STATE @DiDe.hContext, BYCMD %IDM_LngFR, 8
            ChangeLanguage(DiDe)
            DestroyMenu @DiDe.hContext
            DestroyMenu @DiDe.hAppearIn
            DestroyMenu @DiDe.hTransparency
            DestroyMenu @DiDe.hColors
            DestroyMenu @DiDe.hLng
            ' Create new Context Menu in the good language
            CreateContextMenu DiDe
            LogMe "<Need to save user choice to switch widget to french>"
            ThisContextSettings "save", DiDe ' save new language
          END IF

        ' User selected "$EXE Settings" in Context menu
        CASE %IDM_Settings
          Settings()

        ' User selected "About" in Context menu
        CASE %IDM_About
          About()

        ' User selected "Minimize" in Context menu
        CASE %IDM_Minimize
          SetWindowLong @DiDe.Handler, %GWL_style, GetWindowLong(@DiDe.Handler, %GWL_style) OR %WS_MINIMIZE

        ' User selected "Maximize" in Context menu
        CASE %IDM_Maximize
          SetWindowLong @DiDe.Handler, %GWL_style, GetWindowLong(@DiDe.Handler, %GWL_style) OR %WS_MAXIMIZE

        ' User selected "Exit" in Context menu
        CASE %IDM_Exit
          DIALOG END @DiDe.Handler

        ' User selected "Always on top" in Context menu
        CASE %IDM_OnTop
          @DiDe.OnTop = @DiDe.OnTop XOR 1
          MENU SET STATE @DiDe.hContext, BYCMD %IDM_OnTop, @DiDe.OnTop * 8
          SetWindowPos @DiDe.Handler, IIF(@DiDe.OnTop, %HWND_TOPMOST, %HWND_NOTOPMOST), 0, 0, 0, 0, %SWP_NOMOVE OR %SWP_NOSIZE
          LogMe "<Need to save user change of 'always on top' option>"
          ThisContextSettings "save", DiDe ' save new setting

        ' User selected "Never off the screen" in Context menu
        CASE %IDM_InScr
          @DiDe.InScr = @DiDe.InScr XOR 1
          MENU SET STATE @DiDe.hContext, BYCMD %IDM_InScr, @DiDe.InScr * 8
          LogMe "<Need to save user change of 'never off the screen' option>"
          ThisContextSettings "save", DiDe ' save new setting

        ' User selected "Show Caption" in Context menu
        CASE %IDM_Caption
          @DiDe.Caption = @DiDe.Caption XOR 1
          MENU SET STATE @DiDe.hContext, BYCMD %IDM_Caption, @DiDe.Caption * 8
          ShowWindow @DiDe.Handler, %SW_HIDE
          SetWindowLong @DiDe.Handler, %GWL_style, GetWindowLong(@DiDe.Handler, %GWL_style) XOR %WS_CAPTION
          IF ISTRUE (@DiDe.TaskBar) THEN
            @DiDe.X -= 2 * (@DiDe.Caption - 0.5) * 2 : @DiDe.Y -= 2 * (@DiDe.Caption - 0.5) * TaskBarHeight
            @DiDe.W += 2 * (@DiDe.Caption - 0.5) * 2 : @DiDe.H += 2 * (@DiDe.Caption - 0.5) * TaskBarHeight
          ELSE
            @DiDe.X -= 2 * (@DiDe.Caption - 0.5) * 2 : @DiDe.Y -= 2 * (@DiDe.Caption - 0.5) * CaptionHeight
            @DiDe.W += 2 * (@DiDe.Caption - 0.5) * 2 : @DiDe.H += 2 * (@DiDe.Caption - 0.5) * CaptionHeight
          END IF
          DIALOG SET LOC @DiDe.Handler, @DiDe.X, @DiDe.Y
          RefreshDialog DiDe
          ShowWindow @DiDe.Handler, %SW_SHOW
          LogMe "<Need to save user change of 'show caption' option>"
          ThisContextSettings "save", DiDe ' save new setting

        ' User selected "Show in Task Bar" in Context menu
        CASE %IDM_TaskBar
          @DiDe.TaskBar = @DiDe.TaskBar XOR 1
          MENU SET STATE @DiDe.hContext, BYCMD %IDM_TaskBar, @DiDe.TaskBar * 8
          ShowWindow @DiDe.Handler, %SW_HIDE
          SetWindowLong @DiDe.Handler, %GWL_EXstyle, GetWindowLong(@DiDe.Handler, %GWL_EXstyle) XOR %WS_EX_TOOLWINDOW
          IF ISTRUE(@DiDe.Caption) THEN
            @DiDe.Y -= 2 * (@DiDe.TaskBar - 0.5) * 8
            @DiDe.H += 2 * (@DiDe.TaskBar - 0.5) * 8
            DIALOG SET LOC @DiDe.Handler, @DiDe.X, @DiDe.Y
            DIALOG SET SIZE @DiDe.Handler, @DiDe.W, @DiDe.H
          END IF
          RefreshDialog DiDe
          ShowWindow @DiDe.Handler, %SW_SHOW
          LogMe "<Need to save user change of 'show in taskbar' option>"
          ThisContextSettings "save", DiDe ' save new setting

        ' User selected "Show in SysTray" in Context menu
        CASE %IDM_SysTray
          @DiDe.SysTray = @DiDe.SysTray XOR 1
          MENU SET STATE @DiDe.hContext, BYCMD %IDM_SysTray, @DiDe.SysTray * 8
          Shell_NotifyIcon IIF(@DiDe.SysTray, %nim_add, %nim_delete), @DiDe.tn
          LogMe "<Need to save user change of 'show in systray' option>"
          ThisContextSettings "save", DiDe ' save new setting

        ' User selected "Set window transparency" in Context menu
        CASE %IDM_WndwTrspt
          ShowTransparencyTrackBar DiDe

        ' User selected "Set fonts as transparent" in Context menu
        CASE %IDM_FgndTrspt
          @DiDe.FgndTrspt = @DiDe.FgndTrspt XOR 1
          MENU SET STATE @DiDe.hContext, BYCMD %IDM_FgndTrspt, @DiDe.FgndTrspt * 8
          IF ISTRUE(@DiDe.BgndTrspt) THEN
            @DiDe.BgndTrspt = 0
            MENU SET STATE @DiDe.hContext, BYCMD %IDM_BgndTrspt, @DiDe.BgndTrspt * 8
          END IF
          SetTransparencies(DiDe)
          LogMe "<Need to save user choice of 'set font as transparent' option>"
          ThisContextSettings "save", DiDe ' save new setting

        ' User selected "Set background as transparent" in Context menu
        CASE %IDM_BgndTrspt
          @DiDe.BgndTrspt = @DiDe.BgndTrspt XOR 1
          MENU SET STATE @DiDe.hContext, BYCMD %IDM_BgndTrspt, @DiDe.BgndTrspt * 8
          IF ISTRUE(@DiDe.FgndTrspt) THEN
            @DiDe.FgndTrspt = 0
            MENU SET STATE @DiDe.hContext, BYCMD %IDM_FgndTrspt, @DiDe.FgndTrspt * 8
          END IF
          SetTransparencies(DiDe)
          LogMe "<Need to save user choice of 'set background as transparent' option>"
          ThisContextSettings "save", DiDe ' save new setting

        ' User selected "Change foreground color" in Context menu
        CASE %IDM_FgndCol
          @DiDe.FgndCol = SelectColor("Foreground", DiDe)
          RefreshDialog DiDe
          SetTransparencies(DiDe)
          LogMe "<Need to save user change of widget foreground color>"
          ThisContextSettings "save", DiDe ' save new color

        ' User selected "Change background color" in Context menu
        CASE %IDM_BgndCol
          @DiDe.BgndCol = SelectColor("Background", DiDe)
          RefreshDialog DiDe
          SetTransparencies(DiDe)
          LogMe "<Need to save user change of widget background color>"
          ThisContextSettings "save", DiDe ' save new color

        ' User selected "Customization Manager" in Context menu
        CASE %IDM_CustoManager
          ShowCustoManager(DiDe)

        ' User selected "Share this widget" in Context menu
        CASE %IDM_ShareWidget
          DISPLAY SAVEFILE @DiDe.Handler, -100, 0, _
            IIF$(LNG="EN","Share customized widget - Save As", _
            "Partager la widget personnalise - Sauver Sous"), _
            $NUL, CHR$("Windows Executable", 0, "*.exe", 0), _
            IIF$(LNG="EN","Custo ","Perso ")+EXE.NAMEX$, ".exe", _
            %OFN_PATHMUSTEXIST OR %OFN_OVERWRITEPROMPT TO sharedWidget
          IF sharedWidget = "" THEN EXIT SUB
          KILL sharedWidget
          LogMe "<Creating customized widget..."
          DIALOG GET TEXT @DiDe.Handler TO caption : caption = REMOVE$(caption, ANY " :/;,\")
          xdata = AddExeData( ClearExeData(EXE.FULL$), "INI", GetFile(IniFile(caption)) )
          xdata = AddExeData( xdata,                   "CFG", GetFile(CfgFile) )
          FOR x = LBOUND(sharedData) TO UBOUND(sharedData)
            xdata = AddExeData( xdata, FORMAT$(x,"000"), sharedData(x) )
          NEXT
          SetFile xdata, sharedWidget
          LogMe $DQ+sharedWidget+$DQ+" created! ("+FORMAT$(LEN(xdata))+" Bytes)>"
          ?IIF$(LNG="EN", _
            "Customized widget successfully created under:", _
            "La widget personnalise a bien t cre sous :") _
            +$CR+sharedWidget,%MB_ICONINFORMATION,EXE.NAME$


      END SELECT

    '****************************************************************************************************************
    ' CallBack Message sent when importing an appearance from another program
    '****************************************************************************************************************
    CASE %WM_CustoReady
        ' Preserve some (current) parameters
        Language = @DiDe.Language
        X = @DiDe.X : Y = @DiDe.Y : W = @DiDe.W : H = @DiDe.H
        ' Import all parameters from other program
        LogMe "<Reading custo of "+CM_newCusto+">"
        ContextSettingsDo CM_newCusto, "get", DiDe
        LogMe "<Appearance successfully imported!>"
        ' Re-apply the preserved parameters and save
        @DiDe.Language = Language
        @DiDe.X = X : @DiDe.Y = Y : @DiDe.W = W : @DiDe.H = H
        LogMe "<Need to save this appearance for ourself>"
        ThisContextSettings "save", DiDe
        ' Import user settings as well
        x = INSTR(-1, CM_newCusto, "\")
        newCfgFile = LEFT$(MID$(CM_newCusto, x+1), -4)
        newCfgFile = LocalAppData + LEFT$(newCfgFile, (LEN(newCfgFile)-1) \ 2) + ".cfg"
        IF Exist(newCfgFile) THEN KILL CfgFile : FILECOPY newCfgFile, CfgFile
        ' Restart current widget
        Restart()
        DIALOG END @DiDe.handler


    '****************************************************************************************************************
    ' CallBack Message sent when another widget instance is running > run AdminBox
    '****************************************************************************************************************
    CASE %WM_AdminBox
        DIALOG GET TEXT @DiDe.Handler TO caption : caption = REMOVE$(caption, ANY " :/;,\")
        DIALOG SHOW STATE @DiDe.Handler, %SW_HIDE
        x = ShowAdminBox()
        SELECT CASE x
          CASE 0
            LogMe "<Canceling AdminBox>"
            ExitProcess(1) ' force close ourself
            EXIT SUB       ' and end here
          CASE 1
            LogMe "<AdminBox says: reset widget position"
            ResetXYinIniFile(IniFile(caption),@DiDe.W,@DiDe.H)
            ' ...and continue with the instructions after the 'END SELECT'
          CASE 2
            LogMe "<AdminBox says: force taskbar + alt-tab"
            ResetTaskbarInIniFile(IniFile(caption))
            ' ...and continue with the instructions after the 'END SELECT'
          CASE 3
            LogMe "<AdminBox says: reset widget ini & cfg"
            KILL IniFile(caption)
            KILL CfgFile
            ' ...and continue with the instructions after the 'END SELECT'
          CASE 4
            LogMe "<AdminBox says: kill widget>"
            h = FindWindow("#32770", EXE.NAME$) ' handle to first widget instance (already running)
            PostMessage h, %WM_Kill, 0, 0       ' kill it!
            ExitProcess(1)                      ' force close ourself
            EXIT SUB                            ' and end here
          CASE 5
            LogMe "<AdminBox says: switch run at startup"
            IF Exist(StartupFolder & EXE.NAME$ & ".lnk") THEN
              LogMe "- (disable it)"
              KILL StartupFolder & EXE.NAME$ & ".lnk"
            ELSE
              LogMe "- (enable it)"
              MakeStartupShortcut()
            END IF
            ' ...and continue with the instructions after the 'END SELECT'
          CASE 6
            LogMe "<AdminBox says: swicth debug logs"
            LogMe "- ("+IIF$(ISTRUE CM_debugLogs,"dis","en")+"able them)"
            CM_debugLogs = 1 - CM_debugLogs
            SaveDebugLogsStatus(IniFile(caption))
            ' ...and continue with the instructions after the 'END SELECT'
        END SELECT
        IF CM_askShortcut = 1 THEN
            LogMe "- and temporarily mute popup asking to run widget at startup"
            MuteAskShortcut(IniFile(caption))
        END IF
        LogMe "then send 'Restart' signal to widget instance #1, and kill ourself>"
        h = FindWindow("#32770", EXE.NAME$) ' handle to first widget instance (already running)
        PostMessage h, %WM_Restart, 0, 0    ' restart it!
        ExitProcess(1)                      ' force close ourself


    '****************************************************************************************************************
    ' CallBack Message sent to restart this widget (usually from the AdminBox of another widget instance)
    '****************************************************************************************************************
    CASE %WM_Restart
        LogMe "<Widget instance #1 received the 'Restart' signal from an AdminBox!>"
        Restart()


    '****************************************************************************************************************
    ' CallBack Message sent to kill this widget (usually from the AdminBox of another widget instance)
    '****************************************************************************************************************
    CASE %WM_Kill
        LogMe "<Widget instance #1 received the 'Kill' signal from an AdminBox!>"
        ExitProcess(1) ' force close ourself


    '****************************************************************************************************************
    ' CallBack Message sent when the dialog is being destroyed
    '****************************************************************************************************************
    CASE %WM_DESTROY
      LogMe "<Widget instance #1 closed by user>"
      LogMe "<Saving appearance before quitting>"
      ThisContextSettings "save", DiDe
      DestroyMenu @DiDe.hContext
      DestroyMenu @DiDe.hAppearIn
      DestroyMenu @DiDe.hTransparency
      DestroyMenu @DiDe.hColors
      DestroyMenu @DiDe.hLng
      Shell_NotifyIcon %nim_delete, @DiDe.tn

  END SELECT

END SUB
'--------------------------------------------------------------------------------