'********************************************************************************************************************
' 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 = ""+$SPC+MID$(e,2)
ELSEIF LEFT$(e,1) <> "<" AND RIGHT$(e,1) = ">" THEN ' closing tag
e = $SPC+LEFT$(e,-1)+$CRLF+""
ELSE
e = " "+MID$(e,2,-2)+" "
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 ' \Start Menu\Programs\Startup
%CSIDL_LOCAL_APPDATA = &H001c ' \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 ""
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 ""
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 " 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 tâches && Alt+Tab", %IDM_TaskBar, %MF_ENABLED
MENU ADD STRING, @DiDe.hAppearIn, "Zone de notification", %IDM_SysTray, %MF_ENABLED
MENU ADD STRING, @DiDe.hTransparency, "Fenêtre (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 défaut", %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 défaut", %IDM_DefaultFont, %MF_ENABLED
MENU ADD STRING, @DiDe.hLng, "Anglais", %IDM_LngEN, %MF_ENABLED
MENU ADD STRING, @DiDe.hLng, "Français", %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, "Apparaître 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 ""
END IF
LogMe ""
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 ""
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 sûr 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 réinitialiser 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 (ràz coordonnées)"), _
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 tâches && Alt+Tab"), _
15, 40, 180, 15
CONTROL ADD BUTTON, hD, 1002, IIF$(LNG="EN", _
"Fully reset widget (appearance and settings)", _
"Ràz 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 démarrage 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 débogage"), _
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 démarrage 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 ""
END IF
LNG = @DiDe.Language
' Stop init and derive to admin box if needed
IF ISTRUE CM_inAdminBox THEN
LogMe ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 ""
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 personnalisée - 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 ""
?IIF$(LNG="EN", _
"Customized widget successfully created under:", _
"La widget personnalisée a bien été créée 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 ""
ContextSettingsDo CM_newCusto, "get", DiDe
LogMe ""
' Re-apply the preserved parameters and save
@DiDe.Language = Language
@DiDe.X = X : @DiDe.Y = Y : @DiDe.W = W : @DiDe.H = H
LogMe ""
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 ""
ExitProcess(1) ' force close ourself
EXIT SUB ' and end here
CASE 1
LogMe ""
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 ""
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 ""
Restart()
'****************************************************************************************************************
' CallBack Message sent to kill this widget (usually from the AdminBox of another widget instance)
'****************************************************************************************************************
CASE %WM_Kill
LogMe ""
ExitProcess(1) ' force close ourself
'****************************************************************************************************************
' CallBack Message sent when the dialog is being destroyed
'****************************************************************************************************************
CASE %WM_DESTROY
LogMe ""
LogMe ""
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
'--------------------------------------------------------------------------------