Option Explicit '(c)2001-2010 by Louis. (Spell-checked 2015-12-26.) ' 'TODO: verify FileTrash, TAG2Trash is read, formatted & written correctly in step 4 and 8 and 11 ' Const ProgramDebugModeSwitch As Boolean = False ' 'IMPORTANT: search for '#Const' and verify compiling flags before 'shipping'! ' 'NOTE: aliasing is used. ' 'NOTE: within the Toricxs code never use DoEvents, use System_DoEventsEx 'instead, only at locations it is really necessary (as windows stay gray etc.). ' 'NOTE: use DirSave() instead of Dir$() in Mfrm and GFSkinEnginemod, except 'in the General Function sections. ' 'NOTE: the UseMnemonic property of all labels that display cd names and 'paths is set to False. ' 'NOTE: 'On Error [...]' is to be used in any sub/function that uses Kill. ' 'NOTE: open PopUpMenus only at MouseUp() event, NOT at MouseDown() 'event as otherwise WM_RBUTTONUP messages will 'get lost', what leads 'to heavy errors. ' 'NOTE: when Integer values are used as largest number a loop can reach 'then pay attention that the Integer values do not exceed 32766, NOT 32767. 'When the loop is left then 32767 would become 32768, what led to an 'overflow error. 'Make sure that the overflow error can also not appear in the original 'General Function code (update it when the opportunity is given). ' 'NOTE: the Fun sound system is disabled. 'The 'Play Sound' menu item in 'Program Options' is disabled and hidden. 'Any call of Fun_PlaySound() is disabled. 'The ProgramResourceFile mustn't contain any sound file. 'The InfoTrailer does not mention any data about sound. ' 'NOTE: the sorting- and removing algorithms are slow. '-when sorting, we should store the index of the largest element instead of searching for it again (D'oh!) '-when removing, we should do the removing outside the loop and save that If-statement (D'oh!) 'To avoid the ultimate super-horror bug after having changed all the corresponding code locations 'we continue using the crappy algorithms (computers are fast nowadays)... ' 'IMPORTANT: to save memory, AutoRedraw was set to False at many locations. That means 'we must redraw some controls on demand (when the Paint-event fires). 'For redrawing use the sub/function originally used for redrawing. Those redrawing procedures 'should use ProgramLockWindowUpdate() to avoid flickering when clearing and redrawing. 'NOTE: no, failed. Didn't save memory but led to many errors. AutoRedraw enabled again. ' 'NOTE: a FORM GARBAGE COLLECTOR was implemented. 'SystemForms_GarbageCollect will permanently unload all forms that are not visible. 'To make this possible, pay attention to the following rules: '-don't center Mfrm in Form_Unload() event when the centering form isn't visible ' (of course you must hide the centering form AFTER checking if it's visible) '-the GFSubClass code supports automatic re-subclassing 'Notes: ' The GFSubClass_ReSubClass code is used. ' Every skinned form that is unloaded (except Mfrm, it is not loaded any more) ' must call GFSubClass_ReSubClass_UnSubClass([form name]); when the form is loaded again ' it must call GFSubClass_ReSubClassByTargetObjectDescriptionPrefix([form name]) '-do not use Cancel = True in Form_Unload() event '-don't do fading if form isn't visible (see first point) '-some forms must eventually be re-initialized, do this every time when showing them 'Notes: ' GFContextHelp: Pmod permanently calls Mfrm.DefineContextHelp ' GFMsgBox: Pmod permanently calls Mfrm.DefineGFMsgBox ' Loginfrm: Pmod permanently calls Mfrm.DefineLogoLine ' CDfrm has vars in UnloadRetainmod to avoid having to initialize permanently (important, saves cd descriptions) ' SGfrm has vars in UnloadRetainmod to avoid having to initialize permanently ' Call Load Me before calling GFSubClass_ReSubClass... (important, or form won't be in Forms collection) ' '***MFRM API DECLARATIONS*** ' 'GFWindowTransparency_DoFade Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long 'System_IsProgramFormFocused; one or more other location(s) Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long 'GFPMS_ReceiveEventEx Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 'GUI1Search_Scan Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 'DefineGUI10TreeView Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long 'GUI11_Rename Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long 'GUI11_DeleteEmptySourceFolders Private Declare Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long 'GUIC_Refresh Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long 'GUICurtain_Show Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long 'MousePointer_Move Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 'Idle_Tick 'Private Declare Function GetTickCount Lib "kernel32" () As Long 'Form_Unload Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long) 'other Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) ' '***END OF MFRM API DECLARATIONS*** '***GENERAL FUNCTION API DECLARATIONS*** 'NOTE: the following API declarations are sorted by their 'popularity', 'the function used the most frequent in other applications comes at last. ' 'GFMoveMinimizedWindow Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long 'GFStartStation Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long) Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long Private Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Long) 'GFStartStation (icon handling and drawing) Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function DrawIcon Lib "user32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long 'Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long 'Program_EnableMenuBitmaps Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long 'GFSetPriorityClass Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal Flags As Long, ByVal ProcessID As Long) As Long 'http://tokyo.cool.ne.jp/masapico/api_CreateToolhelp32Snapshot.html Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, ByRef ProcessEntry As PROCESSENTRY32) As Long 'http://tokyo.cool.ne.jp/masapico/api_Process32First.html Private Declare Function Process32Next Lib "kernel32" (ByVal hSnap As Long, ByRef ProcessEntry As PROCESSENTRY32) As Long 'http://tokyo.cool.ne.jp/masapico/api_Process32Next.html Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long 'GFReceiveFile (GFSubClassWindowProc) 'Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd As Long, ByVal fAccept As Long) 'Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long 'Private Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Long) 'GFCDGetFileName Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long 'GFSelectDirectory Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long 'GFCreateDirectory Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long 'GFShrinkFile Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 'GFGetDriveInfo Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long 'GetDiskSerialNumber (source: www.vb-world.net) Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long 'GFTimeRemaining Private Declare Function GetTickCount Lib "kernel32" () As Long 'GFMouseGuide Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 'Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long 'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'GFPlayWaveFile Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long 'GFSetWindowStyle[Ex] 'Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 'Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 'GFSetWindowOnTop Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long 'GFGetTaskBar[Height/Width] Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 'GFListHScroll Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 'GF[H/V]Scroll 'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 'GetFormatted[Time/Date]$ Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) 'ProgramOpenPopUpMenu 'Private Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As Long) As Long 'source: VB sample 'CallDlls' 'Private Declare Function GetSubMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPos As Long) As Long Private Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lpReserved As Any) As Long 'ProgramGetMousePos[X, Y] 'Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long ' '***END OF GENERAL FUNCTION API DECLARATIONS*** '***MFRM CONSTANTS*** Private Const VK_LBUTTON = &H1 '***END OF MFRM CONSTANTS*** '***GENERAL FUNCTION CONSTANTS*** ' 'GFWindowTransparency_DoFade Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_LAYERED As Long = &H80000 Private Const LWA_ALPHA As Long = &H2 'GFMoveMinimizedWindow Private Const WPF_SETMINPOSITION = &H1 Private Const SW_SHOWNA = 8 'GFStartStation Const GFSTARTSTATION_FILE As Integer = 1 Const GFSTARTSTATION_DIRECTORY As Integer = 2 'GFSetPriorityClass 'possible Win32 priorities Const NORMAL_PRIORITY_CLASS = &H20 Const IDLE_PRIORITY_CLASS = &H40 Const HIGH_PRIORITY_CLASS = &H80 Const REALTIME_PRIORITY_CLASS = &H100 'end of priorities Const TH32CS_SNAPPROCESS = &H2 Const PROCESS_SET_INFORMATION = &H200 'WINNT.H Const MAX_PATH = 260 'GFReceiveFile (GFSubClassWindowProc) Const WM_DROPFILES = &H233 'GFPlayWaveFile Const SND_SYNC = &H0 'play synchronously (default) Const SND_ASYNC = &H1 'play asynchronously Const SND_NODEFAULT = &H2 'silence not default, if sound not found 'GFPlayWaveFile Const SND_ABORT As String = "" 'self-made Const SND_SILENCE As String = SND_ABORT 'self-made 'GFSetWindowOnTop Const HWND_TOPMOST = -1 Const HWND_NOTOPMOST = -2 Const SWP_NOSIZE = &H1 Const SWP_NOMOVE = &H2 'GFSetWindowStyle[Ex] Const GWL_STYLE As Long = (-16) 'Const GWL_EXSTYLE As Long = (-20) 'NOTE: some constants have been removed to save memory. Const WS_SYSMENU = &H80000 'GFSetWindowStyleEx Private Const WS_EX_DLGMODALFRAME As Long = &H1 Private Const WS_EX_NOPARENTNOTIFY As Long = &H4 Private Const WS_EX_TOPMOST As Long = &H8 Private Const WS_EX_ACCEPTFILES As Long = &H10 Private Const WS_EX_TRANSPARENT As Long = &H20 Private Const WS_EX_MDICHILD As Long = &H40 Private Const WS_EX_TOOLWINDOW As Long = &H80 Private Const WS_EX_WINDOWEDGE As Long = &H100 Private Const WS_EX_CLIENTEDGE As Long = &H200 Private Const WS_EX_CONTEXTHELP As Long = &H400 Private Const WS_EX_RIGHT As Long = &H1000 Private Const WS_EX_LEFT As Long = &H0 Private Const WS_EX_RTLREADING As Long = &H2000 Private Const WS_EX_LTRREADING As Long = &H0 Private Const WS_EX_LEFTSCROLLBAR As Long = &H4000 Private Const WS_EX_RIGHTSCROLLBAR As Long = &H0 Private Const WS_EX_CONTROLPARENT As Long = &H10000 Private Const WS_EX_STATICEDGE As Long = &H20000 Private Const WS_EX_APPWINDOW As Long = &H40000 'GFShrinkFile Const OFS_MAXPATHNAME = 128 Const OF_READWRITE = &H2 Const FILE_BEGIN = 0 'GFSelectDirectory 'Const MAX_PATH = 260 Const ERROR_SUCCESS As Long = 0 Const CSIDL_DESKTOP As Long = &H0 Const BIF_RETURNONLYFSDIRS As Long = &H1 Const BIF_STATUSTEXT As Long = &H4 Const BIF_RETURNFSANCESTORS As Long = &H8 'GFGetDriveInfo Private Const DRIVE_UNKNOWN = 0& 'Winbase.h Private Const DRIVE_NO_ROOT_DIR = 1& 'Winbase.h Private Const DRIVE_REMOVABLE = 2& Private Const DRIVE_FIXED = 3& Private Const DRIVE_REMOTE = 4& Private Const DRIVE_CDROM = 5& Private Const DRIVE_RAMDISK = 6& 'GFListHScroll Const LB_SETHORIZONTALEXTENT = &H194 'GF[H/V]Scroll Const WM_HSCROLL = &H114 Const WM_VSCROLL = &H115 Const SB_LINEUP = 0 Const SB_LINEDOWN = 1 Const SB_LINELEFT = 0 Const SB_LINERIGHT = 1 Const SB_PAGEUP = 2 Const SB_PAGEDOWN = 3 Const SB_PAGELEFT = 2 Const SB_PAGERIGHT = 3 Const SB_THUMBPOSITION = 4 'GFSubClassWindowProc Const WM_MOUSEMOVE = &H200 Const WM_LBUTTONDOWN = &H201 Const WM_LBUTTONUP = &H202 Const WM_LBUTTONDBLCLK = &H203 Const WM_RBUTTONDOWN = &H204 Const WM_RBUTTONUP = &H205 Const WM_RBUTTONDBLCLK = &H206 Const WM_MBUTTONDOWN = &H207 Const WM_MBUTTONUP = &H208 Const WM_MBUTTONDBLCLK = &H209 ' '***END OF GENERAL FUNCTION CONSTANTS*** '***GENERAL FUNCTION STRUCTURES*** ' 'GFMoveMinimizedWindow Private Type POINTAPI X As Long Y As Long End Type 'GFMoveMinimizedWindow Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type 'GFMoveMinimizedWindow Private Type WINDOWPLACEMENT Length As Long Flags As Long showCmd As Long ptMinPosition As POINTAPI ptMaxPosition As POINTAPI rcNormalPosition As RECT End Type 'GFStartStationControlStruct - general configuration (partially saved in registry) Private Type GFStartStationControlStruct RegMainKey As String RegRootKey As String BrowseApplicationName As String 'application to browse directories, by default 'explorer.exe', if not found then user is asked once to enter path of browse application FolderIconFile As String FolderIconIndex As Integer ExecutableIconFile As String ExecutableIconIndex As Integer End Type Dim GFStartStationControlStructVar As GFStartStationControlStruct 'GFStartStationStruct Private Type GFStartStationStruct StartApplicationType As Integer 'type of what was dropped StartApplicationTypeDescription As String 'file type description of what was dropped StartApplicationCommand As String 'path to what was dropped StartApplicationName As String 'program to launch when command is pressed StartAplicationIconFile As String StartAplicationIconIndex As Integer IconHandle As Long End Type Dim GFStartStationStructNumber As Integer Dim GFStartStationStructArray() As GFStartStationStruct 'Program_EnableMenuBitmaps Private Type MENUITEMINFO cbSize As Long fMask As Long fType As Long fState As Long wID As Long hSubMenu As Long hbmpChecked As Long hbmpUnchecked As Long dwItemData As Long dwTypeData As String cch As Long End Type 'GFSetPriorityClass Private Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * MAX_PATH End Type 'GFCDGetFileName Private Type OPENFILENAME lStructSize As Long hWndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type 'GFSelectDirectory Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type 'GFCreateDirectory Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type 'GFGetDriveInfo Private Type DRIVEINFO DriveName As String 'e.g. 'd:\' DriveSerialNumber As String DriveTypeDescription As String 'i.e. 'hd', 'cdrom', 'network' etc. End Type 'GFTimeRemainingStruct Private Type GFTimeRemainingStruct ProcessStartedFlag As Boolean 'if data below is valid ProcessStartTickCount As Long ProcessValueCurrent As Double ProcessValueMax As Double SecondsRemainingMin As Long End Type Dim GFTimeRemainingStructVar As GFTimeRemainingStruct 'GFMouseGuide 'Private Type POINTAPI ' x As Long ' y As Long 'End Type 'GFGetTaskBar[Height/Width] 'Private Type RECT ' Left As Long ' Top As Long ' Right As Long ' Bottom As Long 'End Type 'GFShrinkFile Private Type OFSTRUCT cBytes As Byte fFixedDisk As Byte nErrCode As Integer Reserved1 As Integer Reserved2 As Integer szPathName(OFS_MAXPATHNAME) As Byte End Type 'GetFormatted[Time/Date]$ Private Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type 'ProgramOpenPopUpMenu 'Private Type RECT 'Rect ??? ' Left As Integer ' Top As Integer ' Right As Integer ' Bottom As Integer 'End Type 'ProgramGetMousePos[X, Y] 'Private Type POINTAPI ' x As Long ' y As Long 'End Type 'GFTextMarker Private Type GFTextMarkerStruct MarkText As String MarkTextLength As Long MarkNumber As Integer 'number of different marks MarkPointer As Integer 'which mark is to be used for next marking UseMarkPointerFlag As Boolean 'if a mark is to be set or removed MarkDescriptionArray() As String MarkColorArray() As Long MarkSelectionNumber As Integer MarkSelectionArray() As Integer 'UBound() = Len(MarkText), contains reference to a MarkNumber or 0 for every char CursorPos As Integer '1-Len(MarkText) CursorMoveDirectionOld As Integer 'vbKeyLeft or vbKeyRight SpaceKeyPressedFlag As Boolean EffectsEnabledFlag As Boolean End Type Dim GFTextMarkerStructVar As GFTextMarkerStruct ' '***END OF GENERAL FUNCTION STRUCTURES*** '***GENERAL FUNCTION VARS*** ' 'Program_EnableMenuBitmaps Const MF_BITMAP = &H4& 'GFCDGetFileName Const OFN_HIDEREADONLY = &H4 Dim NULLARRAYSTRING(0 To 0) As String 'disable if already existing in target project 'GFCreateDirectory Dim GFCreateDirectorySubCallNumber As Integer 'GFDirectoryList Dim GFDirectoryList4Number As Long Dim GFDirectoryList4Array() As String Dim GFDirectoryList4CancelFlag As Boolean ' '***END OF GENERAL FUNCTION VARS*** '***STEP SPECIFIC CONSTANTS*** 'NOTE: it follows step-specific constants. ' 'GUI1Search_Scan Const LB_DIR = &H18D 'Const LB_SETHORIZONTALEXTENT = &H194 Const DDL_READWRITE = &H0 Const DDL_READONLY = &H1 Const DDL_HIDDEN = &H2 Const DDL_SYSTEM = &H4 Const DDL_DIRECTORY = &H10 Const DDL_ARCHIVE = &H20 'GUI1DirList_AddItem Private Const DIRLISTADDITEM_ADDED As Integer = -1 'True for success Private Const DIRLISTADDITEM_ALREADY_ADDED As Integer = 2 Private Const DIRLISTADDITEM_INVALID As Integer = 3 'directory to add is invalid Private Const DIRLISTADDITEM_OVERFLOW = 4 'more than 8000/32766 directories/files are to be added Private Const DIRLISTADDITEM_ABORTED = 5 'user aborted 'GUI4_ControlGroup_Indices Const GUI4_CONTROLGROUP_BEFOREREAD As Integer = 1 Const GUI4_CONTROLGROUP_READ As Integer = 2 Const GUI4_CONTROLGROUP_FORMAT As Integer = 3 Const GUI4_CONTROLGROUP_SORT As Integer = 4 Const GUI4_CONTROLGROUP_REMOVEFILENUMERATION As Integer = 5 Const GUI4_CONTROLGROUP_AFTERSORT As Integer = 6 Const GUI4_CONTROLGROUP_USERMOVE As Integer = 7 'FileInfoStruct_Define (called by GUI4 code) Const READ_OK As Integer = 1 Const READ_ERROR As Integer = 2 Const READ_RESET As Integer = 3 Const READ_RESET_AND_GOTO_STEP_1 As Integer = 4 Const READ_NEWFILE As Integer = 5 Const READ_NEWDIR As Integer = 6 Const READ_FINISHED As Integer = 7 'AfterTouchTypes (used by GUI8 code) Const AFTERTOUCHTYPE_DIRECTORYLEVELREPLACE As Integer = 1 'GUI11Rename constants - return values of the GUI11_RenameSub-functions Const RENAME_OK As Integer = 1 Const RENAME_ERROR As Integer = 2 Const RENAME_ABORT As Integer = 3 Const RENAME_MOVED As Integer = 4 Const RENAME_COPIED As Integer = 5 Const RENAME_LEFT As Integer = 6 Const RENAME_DELETED As Integer = 7 Const RENAME_VIRTUALLY_DELETED As Integer = 8 'GUI11RenameType constants - used to describe rename type Const GUI11RENAMETYPE_LOCALMACHINE_MOVE As Integer = 1 Const GUI11RENAMETYPE_LOCALMACHINE_COPY As Integer = 2 Const GUI11RENAMETYPE_NETWORKMACHINE_MOVE As Integer = 3 Const GUI11RENAMETYPE_NETWORKMACHINE_COPY As Integer = 4 'GUI11_Rename Const MOVEFILE_REPLACE_EXISTING = &H1 ' '***END OF STEP SPECIFIC CONSTANTS*** '***GUIX STRUCTURES*** 'NOTE: the following structures are 'GUIXStructs', 'they save step-specific data. There is maximal one GUIXStruct per step. ' 'GUI1Struct Private Type GUI1Struct UseDefaultMoveOrCopyFlag As Boolean 'automatically reset after use DefaultMoveOrCopyFlag As Boolean HighFileCountWarningMessageDisplayedFlag As Boolean 'if user has been informed about slow-downs GUI1StructInitializedFlag As Boolean 'if GUI1DirListFromReg has been called at least once GUI1DirListToRegLockedFlag As Boolean 'if True then related sub will not be called FromRegKey As String 'key that was used by GUI1DirListFromReg ReadNewInfoMessageDisplayedFlag As Boolean UseMegaScanTypeBits As Boolean MegaScanTypeBits As Integer UseMegaScanMoveOrCopy As Boolean MegaScanMoveOrCopy As Integer FunFormQuakeDisabledFlag As Boolean 'if form quake effect is disabled (use if it doesn't work at right point of time because message queue not allocated) End Type Dim GUI1StructVar As GUI1Struct 'GUI2Struct Private Type GUI2Struct FilterStructInitializedFlag As Boolean 'if FilterStructFromReg has been called at least once FilterChangeInfoMessageDisplayedFlag As Boolean 'if the user was yet shown the info message that the TAG data should be re-read after a change of the FileNameFilters FromRegKey As String 'key that was used by FilterStructFromReg ImportDefaultDirectory As String End Type Dim GUI2StructVar As GUI2Struct 'GUI3Struct Private Type GUI3Struct CutStructInitializedFlag As Boolean 'True if GUI3FromReg has been called at least once ReplaceStructInitializedFlag As Boolean 'True if GUI3FromReg has been called at least once NoUCaseStructInitializedFlag As Boolean 'True if GUI3FromReg has been called at least once NoLCaseStructInitializedFlag As Boolean 'True if GUI3FromReg has been called at least once ExpressionStructInitializedFlag As Boolean 'True if GUI3FromReg has been called at least once CutTextUnchanged As String ReplaceTextUnchanged As String NoUCaseTextUnchanged As String NoLCaseTextUnchanged As String ExpressionTextUnchanged As String FromRegKey As String 'reg sub key that was used by GUI3FromReg ImportDefaultDirectory As String End Type Dim GUI3StructVar As GUI3Struct 'GUI5Struct - information about GUI5 Private Type GUI5Struct CheckItemType As Integer ANTHelpEnabledFlag As Boolean 'if ANT help is to be displayed when GUI5DefaultList is reloaded End Type Dim GUI5StructVar As GUI5Struct 'GUI6Struct - information about GUI6 Private Type GUI6Struct CheckItemType As Integer End Type Dim GUI6StructVar As GUI6Struct 'GUI8Struct Private Type GUI8Struct RecreateInfoMessageEnabledFlag As Boolean RecreateInfoMessageDisplayedFlag As Boolean FromRegKey As String 'reg sub key that was used by GUI8FromReg FileFormatTextUnchanged As String DirFormatTextUnchanged As String NumerateOrOverwriteFlagUnchanged As Boolean RetainAllFileNamesFlag As Boolean RetainLongFileNamesFlag As Boolean 'if any v1 tag item used for file name >= 30 chars FormatRetainedFileNamesFlag As Boolean 'capitalize, cut or so, see code WriteTAGsFlag As Boolean 'if v1, v2.3 TAGs are to be written End Type Dim GUI8StructVar As GUI8Struct 'GUI9Struct Private Type GUI9Struct LWCfrmClosedBySystemFlag As Boolean 'if LWCfrm has been closed automatically because of a palette change ImportDefaultDirectory As String End Type Dim GUI9StructVar As GUI9Struct 'GUI10StructVar - mainly information for control reloading Private Type GUI10Struct GUI10TreeViewReselectItemName As String 'item that is to be reselected when TreeView is reloaded, cleared after first usage GUI10TreeViewReselectItemNameOld As String 'for SaveAppearance_ChangeItemName() GUI10ListViewReselectItemIndex As Integer 'ignored and cleared if GUI10TreeViewReselectItemName has been used GUI10TreeView_ProcessDrop_ErrorFlag As Boolean 'if GUI10TreeView_EndDrop_[...] is to be called End Type Dim GUI10StructVar As GUI10Struct 'GUI11StructVar Private Type GUI11Struct CancelRenamingFlag As Boolean MfrmMinimizedFlag As Boolean BytesProcessed As Double 'used by GUI11_RenameSub_RefreshStatistics() End Type Dim GUI11StructVar As GUI11Struct ' '***END OF GUIX STRUCTURES*** '***STEP SPECIFIC STRUCTURES*** 'NOTE: the following structures are used besides the GUIXStructs 'in a special step. The structures are sorted by the step they are used in ' 'Step 1 ' 'GUI1MoveDirListSearchStruct - contains data for searching the GUI1MoveDirList texts Private Type GUI1MoveDirListSearchStruct SearchString As String End Type Dim GUI1MoveDirListSearchStructVar As GUI1MoveDirListSearchStruct 'GUI1CopyDirListSearchStruct - contains data for searching the GUI1CopyDirList texts Private Type GUI1CopyDirListSearchStruct SearchString As String End Type Dim GUI1CopyDirListSearchStructVar As GUI1CopyDirListSearchStruct 'GUI1 other Dim GUI1CopyDirListIndexNumber As Integer Dim GUI1CopyDirListIndexArray() As Integer 'points to a FileSystemStructVar.SourceDirArray() element Dim GUI1MoveDirListIndexNumber As Integer Dim GUI1MoveDirListIndexArray() As Integer 'points to a FileSystemStructVar.SourceDirArray() element ' 'Step 2 ' 'SampleStruct - stores sample song/artist names Private Type SampleStruct SampleSongName As String SampleArtistName As String SampleAlbumName As String SampleYearName As String SampleComment As String SampleTrash As String End Type Dim SampleStructNumber As Integer Dim SampleStructArray() As SampleStruct 'BorderStringFrquencyStruct ' 'NOTE: use a large FILTERSTRUCT_BYTESTRINGLENGTH because if the user creates 'the file name 'Louis' Files - %artist% - %song%.mp3 then the first '-' MUST be included 'within the filter or '-*2*' divides song- and artist name but is not found as it's missing 'within the file name (or so). ' Const FILTERSTRUCT_BYTESTRINGLENGTH As Long = MAX_PATH 'up to how long a Filter string can be Private Type BorderStringFrquencyStruct BorderString(1 To FILTERSTRUCT_BYTESTRINGLENGTH) As Byte BorderStringFrquency As Long 'how often border string appears in one filter struct element (use the var type Long for compability reasons) End Type 'FilterStruct - used to get song and artist name out of file name Private Type FilterStruct StartStringArray(CONST_SONGNAME To CONST_TRASH) As String EndStringArray(CONST_SONGNAME To CONST_TRASH) As String End Type Dim FilterStructNumber As Integer Dim FilterStructArray() As FilterStruct Dim ChangeDedectFilterStructNumber As Integer 'see GUI2ChangeDedect code Dim ChangeDedectFilterStructArray() As FilterStruct 'FilterStructByte - like FilterStruct, but with byte arrays to increase processing speed Private Type FilterStructByte SongNameStartString() As Byte 'byte string - no ending 'Array' SongNameStartStringLength As Long SongNameEndString() As Byte ArtistNameStartString() As Byte ArtistNameStartStringLength As Long ArtistNameEndString() As Byte AlbumNameStartString() As Byte AlbumNameStartStringLength As Long AlbumNameEndString() As Byte YearNameStartString() As Byte YearNameStartStringLength As Long YearNameEndString() As Byte CommentStartString() As Byte CommentStartStringLength As Long CommentEndString() As Byte TrashStartString() As Byte TrashStartStringLength As Long TrashEndString() As Byte BorderStringFrquencyStructNumber As Integer BorderStringFrquencyStructArray() As BorderStringFrquencyStruct End Type Dim FilterStructByteNumber As Integer Dim FilterStructByteArray() As FilterStructByte 'GetSampleStruct - used in GUI2_GetSample() Private Type GetSampleStruct BorderStringUnchanged As String 'i.e. [*2* BorderString As String 'i.e. [ BorderStringIndex As Integer 'i.e. 2 BorderStringItemType As Integer 'i.e. CONST_SONGNAME BorderStringStartOrEndStringFlag As Boolean End Type 'GUI2FilterList - stuff about GUI2FilterList Private Type GUI2FilterListStruct SampleStructVar As SampleStruct 'current example stuff in list End Type Dim GUI2FilterListStructVar As GUI2FilterListStruct ' 'Step 3 ' 'CutStruct - contains chars that may not appear in TAG data Private Type CutStruct CutCharByteString(1 To MAX_PATH) As Byte 'data copied from file names to here so use MAX_PATH to avoid buffer overrun End Type Dim CutStructNumber As Integer Dim CutStructArray() As CutStruct Dim FileSongNameCutStructNumber As Integer Dim FileSongNameCutStructArray() As CutStruct Dim FileArtistNameCutStructNumber As Integer Dim FileArtistNameCutStructArray() As CutStruct Dim FileAlbumNameCutStructNumber As Integer Dim FileAlbumNameCutStructArray() As CutStruct Dim FileYearNameCutStructNumber As Integer Dim FileYearNameCutStructArray() As CutStruct Dim FileCommentCutStructNumber As Integer Dim FileCommentCutStructArray() As CutStruct 'CutContainedStruct Private Type CutContainedStruct ContainedFlagArray(0 To 255) As Boolean UseCutStructFlag As Boolean 'if related CutStructArray() element is to be used (CutContainedStructNumber is always equal to CutContainedStructNumber) End Type Dim CutContainedStructNumber As Integer Dim CutContainedStructArray() As CutContainedStruct 'ReplaceStruct - contains chars that are to be replaced in TAG data Private Type ReplaceStruct 'NOTE: use MAX_PATH as sometimes data from file names is copied into these structure members. ReplaceSourceByteString(1 To MAX_PATH) As Byte 'FILEINFOSTRUCT_FILETAGSTRINGLENGTH previously used, MAYBE crash therefore ReplaceTargetByteString(1 To MAX_PATH) As Byte 'FILEINFOSTRUCT_FILETAGSTRINGLENGTH previously used, MAYBE crash therefore ReplaceSourceStringStartPos As Long 'at which position the source string is included in the target string ReplaceTargetStringLength As Long 'length of source string End Type Dim ReplaceStructNumber As Integer Dim ReplaceStructArray() As ReplaceStruct Dim FileSongNameReplaceStructNumber As Integer Dim FileSongNameReplaceStructArray() As ReplaceStruct Dim FileArtistNameReplaceStructNumber As Integer Dim FileArtistNameReplaceStructArray() As ReplaceStruct Dim FileAlbumNameReplaceStructNumber As Integer Dim FileAlbumNameReplaceStructArray() As ReplaceStruct Dim FileYearNameReplaceStructNumber As Integer Dim FileYearNameReplaceStructArray() As ReplaceStruct Dim FileCommentReplaceStructNumber As Integer Dim FileCommentReplaceStructArray() As ReplaceStruct 'NoUCaseStruct - contains words that are to be written in non-capital letters only Private Type NoUCaseStruct NoUCaseByteString(1 To MAX_PATH) As Byte 'FILEINFOSTRUCT_FILETAGSTRINGLENGTH previously used, MAYBE crash therefore End Type Dim NoUCaseStructNumber As Integer Dim NoUCaseStructArray() As NoUCaseStruct 'NoLCaseStruct - contains words that are to be written in capital letters only Private Type NoLCaseStruct NoLCaseByteString(1 To MAX_PATH) As Byte 'FILEINFOSTRUCT_FILETAGSTRINGLENGTH previously used, MAYBE crash therefore End Type Dim NoLCaseStructNumber As Integer Dim NoLCaseStructArray() As NoLCaseStruct 'ExpressionStruct - contains words that include a border string but are not to be split Private Type ExpressionStruct ExpressionByteString(1 To MAX_PATH) As Byte 'FILEINFOSTRUCT_FILETAGSTRINGLENGTH previously used, MAYBE crash therefore End Type Dim ExpressionStructNumber As Integer Dim ExpressionStructArray() As ExpressionStruct Dim ExpressionStorageStructNumber As Integer Dim ExpressionStorageStructArray() As ExpressionStruct 'GUI3SearchStruct - contains data for searching the GUI3 texts Private Type GUI3SearchStruct SearchTextIndex As Integer SearchString As String End Type Dim GUI3SearchStructVar As GUI3SearchStruct ' 'Step 4 ' 'DefineSubStruct - used by FileInfoStruct_Define() and sub functions Private Type DefineSubStruct ReadDirFileIndex As Integer ReadDirFileCount As Integer ReadDirFileCountTotal As Integer ReadDirIndex As Integer ReadDir As String ReadDirSerialNumber As String OldDir As String OldDirSerialNumber As String End Type 'GUI4 Dim GUI4TreeView As New GFTreeViewcls ' 'Step 5 ' 'SpellingErrorStruct - see Mmod Dim SpellingErrorStructNumber As Integer Dim SpellingErrorStructArray() As SpellingErrorStruct Dim GUI5ControlGroupEnabledFlag As Boolean Dim GUI5PaletteNumber As Integer 'spelling error palette ' 'Step 6 ' 'InclusionStruct - see Mmod Dim InclusionStructNumber As Integer Dim InclusionStructArray() As InclusionStruct Dim GUI6ControlGroupEnabledFlag As Boolean Dim GUI6PaletteNumber As Integer 'inclusion (error) palette ' 'Step 7 ' 'SwapCheckErrorStruct - contains references to a group of files with items swapped Private Type SwapCheckErrorStruct ErrorItem(1 To FILEINFOSTRUCT_TAGSTRINGLENGTH) As Byte FileInfoStructPointerNumber As Integer FileInfoStructPointerArray() As Integer End Type Dim SwapCheckErrorStructNumber As Integer Dim SwapCheckErrorStructArray() As SwapCheckErrorStruct 'GUI7 Dim GUI7ListView As New GFReportViewcls Dim GUI7ListViewPaletteNumber As Integer Dim GUI7ListViewPointerArray() As Integer 'points to a FileInfoStructArray() element Dim GUI7ControlGroupEnabledFlag As Boolean ' 'Step 8 ' 'AfterTouchStruct - see code annotations Private Type AfterTouchStruct AfterTouchType As Integer AfterTouchFileInfoStructIndex As Integer AfterTouchByteStringPos As Long AfterTouchByteString(1 To MAX_PATH) As Byte End Type Dim AfterTouchStructNumber As Integer Dim AfterTouchStructArray() As AfterTouchStruct ' 'Step 10 ' 'GUI10SizeChangeStruct Private Type GUI10SizeChangeStruct SizeChangeEnabledFlag As Boolean SizeChangeDeltaXPos As Long SizeChangeDeltaYPos As Long SizeChangeLabelXPosUnchanged As Long SizeChangeLabelYPosUnchanged As Long End Type Dim GUI10SizeChangeStructVar As GUI10SizeChangeStruct 'GUI10TreeViewSearchStruct - contains data for searching the GUI10TreeView texts Private Type GUI10TreeViewSearchStruct SearchString As String End Type Dim GUI10TreeViewSearchStructVar As GUI10TreeViewSearchStruct 'GUI10 Dim GUI10TreeView As New GFTreeViewcls Dim GUI10TreeViewSelectedItemNameOld As String Dim GUI10ListView As New GFReportViewcls Dim GUI10ListViewPointerArray() As Integer ' 'Step 11 ' 'RenameFileStruct - used during the renaming process Private Type RenameFileStruct RenameSourceDir As String RenameSourceDirSerialNumber As String RenameSourceFileName As String RenameSourceName As String RenameSourceDrive As String RenameTargetDir As String RenameTargetFileName As String RenameTargetName As String MoveOrCopyFlag As Boolean 'True if a file is to be moved, False if it is to be copied OnSameDriveFlag As Boolean 'True if source and target file is on same drive, False if not End Type 'RenameStatisticsStruct - used during the renaming process Private Type RenameStatisticsStruct RenameCopyNumber As Integer 'how many files were copied RenameMoveNumber As Integer 'how many files were moved RenameLeftNumber As Integer 'how many files stayed at current position (as source and target path is equal) RenameDeleteNumber As Integer 'how many files were deleted RenameErrorNumber As Integer 'how many files could not be completely moved/copied RenameUnprocessedNumber As Integer 'if user canceled RenameStatisticsString As String End Type 'GUI11 Dim GUI11RenameTypeOld As Integer ' '***END OF STEP SPECIFIC CONSTANTS*** '***MISC VARIABLES*** ' 'E Dim EFileInfoStructArray(1 To 1) As FileInfoStruct 'contains data about file to edit 'GUI4ReadTrackingProgressBar Dim GUI4ReadTrackingProgressBar As New GFProgressBarcls 'Window_FilterMessage Private Const WM_SIZE = &H5 Private Const SIZE_MAXHIDE = 4 Private Const SIZE_MAXIMIZED = 2 Private Const SIZE_MAXSHOW = 3 Private Const SIZE_MINIMIZED = 1 Private Const SIZE_RESTORED = 0 ' '***END OF MISC VARIABLES*** '***MISC STRUCTURES*** ' 'NOTE: the following structures cannot be allocated to any large sub system. ' 'SkinDataFileReloadStruct - stores data needed when the SkinDataFile is reloaded Private Type SkinDataFileReloadStruct ReloadingFlag As Boolean 'if SkinDataFile is currently reloaded RecoursiveReloadingFlag As Boolean 'if SDF is reloaded after skin updating (see GUI8RetainAllFileNamesCheck) WindowStickEnabledFlagUnchanged As Boolean 'if GFWindowStick system was enabled before reloading SDF MfrmDataValidFlag As Boolean 'if following three values have been set correctly MfrmWindowStateUnchanged As Integer 'if Mfrm was maximized or restored before the skin has been changed MfrmSizeUnchanged As POINTAPI MfrmPosUnchanged As POINTAPI MfrmVisibleFlagUnchanged As Boolean 'hidden when SDF reloaded QPfrmVisibleFlagUnchanged As Boolean 'window is temporary hidden when SDF is changed LWCfrmVisibleFlagUnchanged As Boolean 'window is temporary hidden when SDF is changed TAGfrmVisibleFlagUnchanged As Boolean 'window is temporary hidden when SDF is changed End Type Dim SkinDataFileReloadStructVar As SkinDataFileReloadStruct 'IdleStruct Private Type IdleStruct ProgramMousePosXCurrent As Long ProgramMousePosYCurrent As Long ProgramMousePosXOld As Long ProgramMousePosYOld As Long TickCountCurrent As Long 'value returned by GetTickCount() TickCountOld As Long IsSystemIdleFlag As Boolean IsSystemIdleFlagOld As Boolean KeyPressedFlag As Boolean 'to be set by non-idle code MousePressedFlag As Boolean 'to be set by non-idle code Idle_GotFocus_TickCount As Long 'latest value Idle_LostFocus_TickCount As Long 'latest value IdleAnimationPlayedFlag As Boolean End Type Dim IdleStructVar As IdleStruct 'ControlGroupStruct - general ControlGroup data Private Type ControlGroupStruct GUI1_SearchControlGroup_EnabledFlag As Boolean GUI1_SearchControlGroup_VisibleFlag As Boolean GUI1_SearchControlGroup_AnyFormDisabledFlag As Boolean 'if SystemForms_Disable() was called GUI4_ControlGroup_Old As Integer 'type (index) of control group shown before UserMove control group was shown GUI4_ControlGroup_Current As Integer 'type (index) of control group displayed through GUI4_ControlGroup_ShowEx GUI5_ControlGroup_EnabledFlag As Boolean GUI5_ControlGroup_VisibleFlag As Boolean GUI6_ControlGroup_EnabledFlag As Boolean GUI6_ControlGroup_VisibleFlag As Boolean GUI7_ControlGroup_EnabledFlag As Boolean GUI7_ControlGroup_VisibleFlag As Boolean ControlGroupDisabledFlag As Boolean 'if current control group has been disabled (already, important for setting values above, not used by every ControlGroup) ControlGroupHiddenFlag As Boolean 'if current control group has been hidden End Type Dim ControlGroupStructVar As ControlGroupStruct 'ConfigSetStruct Private Type ConfigSetStruct ConfigSetChangingFlag As Boolean ConfigSetCreatingFlag As Boolean ConfigSetDeletingFlag As Boolean ConfigSetRenamingFlag As Boolean End Type Dim ConfigSetStructVar As ConfigSetStruct 'SGStruct - information for SG system Private Type SGStruct ReadEnabledFlag As Boolean 'if user applied reading SGFile End Type Dim SGStructVar As SGStruct 'CopyPasteStruct - see code annotations Private Type CopyPasteStruct GUIXListViewIndex As Integer 'where string comes from or goes to GUIXListViewSubIndex As Integer 'where string comes from or goes to CopyPasteStringStored As String 'stored string CopyPasteString1 As String CopyPasteString2 As String End Type Dim CopyPasteStructVar As CopyPasteStruct 'ActionPlayMenuStruct - function similar to ProgramPopUpMenuStruct Private Type ActionPlayMenuStruct SourceDescription As String SourceObject As Object MP3File As String 'file an action from ActionPlayMenu is to be used on End Type Dim ActionPlayMenuStructVar As ActionPlayMenuStruct ' 'ActionTrackStruct - contains information what functions the user made use of ' 'NOTE: for almost every step there is a flag that can be used if the user 'made use of an important step-specific action. 'See ActionTrack sub system code for details. 'ActionTrackStruct consists of flags that identify if the user has already done 'a special action which requires to display help text the first time it is done. ' Private Type ActionTrackStruct ActionTrackDisabledFlag As Boolean 'set through user reaction on an ActionTrack message MegaScanUsedFlag As Boolean 'if the GUI1MegaScanCommand has been pressed FileNameFilterCreatedFlag As Boolean 'if the GUI2OkCommand has been pressed GUI3ChangedFlag As Boolean 'if the user changed any data in at least one of the GUI3 texts SpellingErrorCheckUsedFlag As Boolean 'if the GUI5CheckCommand has been pressed InclusionCheckUsedFlag As Boolean 'if the GUI6CheckCommand has been pressed SwapCheckUsedFlag As Boolean 'if the GUI7CheckCommand has been pressed RenameProcessFinishedFlag As Boolean 'if all renaming sub functions have been successfully executed MP3ListFileCreatedFlag As Boolean 'if the user pressed the GUI12CreateCommand UserMoveInfoDisplayedFlag As Boolean 'if a WizardHelp about the UserMove was displayed UserMoveCopyInfoDisplayedFlag As Boolean 'if the request to copy the BaseSkin was displayed TitleBarChangeInfoDisplayedFlag As Boolean 'if already a message about title bars was displayed DelayedAccessInfoDisplayedFlag As Boolean 'if an info was displayed that files will not be physically accessed before step 11 (flag also saved in registry, displayed once only (at all)) End Type Dim ActionTrackStructVar As ActionTrackStruct 'ActionTrackDisplayedStruct - stores information for what steps an ActionTrack message was displayed Private Type ActionTrackDisplayedStruct DisplayedFlagArray(1 To 12) As Boolean WizardHelp1050DisplayedFlag As Boolean End Type Dim ActionTrackDisplayedStructVar As ActionTrackDisplayedStruct 'WindowStateRestoreStruct - for restoring the window state at current run of MP3 Renamer 2 Private Type WindowStateRestoreStruct MWindowStateCatchedFlag As Boolean MWindowState As Integer MVisibleFlagCatchedFlag As Boolean MVisibleFlag As Boolean QPWindowStateCatchedFlag As Boolean QPWindowState As Integer QPVisibleFlagCatchedFlag As Boolean QPVisibleFlag As Boolean LWCWindowStateCatchedFlag As Boolean LWCWindowState As Integer LWCVisibleFlagCatchedFlag As Boolean LWCVisibleFlag As Boolean End Type Dim WindowStateRestoreStructVar As WindowStateRestoreStruct 'StartStationStruct - MP3 Renamer specific type that contains data to check if a STS command must be recreated Private Type StartStationRefreshStruct SystemForeColorOld As Long SystemBackColorOld As Long SystemFont As FontStruct CommandWidthOld As Long CommandHeightOld As Long CommandCaptionUnchangedOld As String End Type Dim StartStationRefreshStructNumber As Integer Dim StartStationRefreshStructArray() As StartStationRefreshStruct 'UpdateFileCollectStruct - used by Update system Private Type UpdateFileCollectStruct FileInfoStructPointerNumber As Integer FileInfoStructPointerArray() As Integer End Type Dim UpdateFileCollectStructVar As UpdateFileCollectStruct 'UpdateStruct - general information about the Update sub system Private Type UpdateStruct UpdateUsedFlag As Boolean 'if any file has been updated using the Update system since the call of Update_ResetUsedFlag End Type Dim UpdateStructVar As UpdateStruct 'MfrmSizeStruct - used to detect size changes of Mfrm (see GFSubClassWindowProc()) Private Type MfrmSizeStruct MfrmSizedOnceFlag As Boolean 'if values below are valid MfrmWidthOld As Single MfrmHeightOld As Single MfrmWindowStateOld As Integer End Type Dim MfrmSizeStructVar As MfrmSizeStruct 'WindowFadeStruct - information for fading windows (when being opened/closed) Private Type WindowFadeStruct FadingEnabledFlag As Boolean End Type Dim WindowFadeStructVar As WindowFadeStruct 'ZoomSlideStruct Private Type ZoomSlideStruct ZoomSlideDisabledFlag As Boolean 'sometimes required ZoomWindowControlStructIndex As Integer MoveWindowControlStructIndex As Integer MoveWindowXPosOld As Long MoveWindowYPosOld As Long MoveWindowXPosNew As Long MoveWindowYPosNew As Long End Type Dim ZoomSlideStructVar As ZoomSlideStruct 'EnabledStruct - stores information if a control was originally enabled before temporary being enabled Private Type EnabledStruct ControlObject As Object ControlEnabledFlagUnchanged As Boolean ControlEnabledFlagChangedNumber As Integer 'control state is restored when this number has been decreased to 1 again ControllerDescriptionNumber As Integer 'see code annotations ControllerDescriptionArray() As String End Type Dim EnabledStructNumber As Integer Dim EnabledStructArray() As EnabledStruct 'VisibleStruct - stores information if a control was originally visible before temporary being shown Private Type VisibleStruct ControlObject As Object ControlVisibleFlagUnchanged As Boolean ControlVisibleFlagChangedNumber As Integer 'control state is restored when this number has been decreased to 1 again ControllerDescriptionNumber As Integer 'see code annotations ControllerDescriptionArray() As String End Type Dim VisibleStructNumber As Integer Dim VisibleStructArray() As VisibleStruct 'ByteStringBuffer Private Type ByteStringBufferStruct ByteString(1 To MAX_PATH) As Byte End Type Dim ByteStringBufferStructNumber As Integer Dim ByteStringBufferStructArray() As ByteStringBufferStruct Dim ByteStringBufferHashTable As New HashTable 'ByteStringCountBuffer Private Type ByteStringCountBufferStruct ByteString(1 To MAX_PATH) As Byte ByteStringCount As Long End Type Dim ByteStringCountBufferStructNumber As Integer Dim ByteStringCountBufferStructArray() As ByteStringCountBufferStruct 'SystemMessageStruct - information for displaying a system message correctly Private Type SystemMessageStruct StepLabelCaptionTemp As String 'message to display StepLabelCaptionUnchangedStoredFlag As Boolean 'if values below is valid StepLabelCaptionUnchanged As String End Type Dim SystemMessageStructVar As SystemMessageStruct 'SystemManualMessageStruct 'used to allow showing a message that must be hidden manually Private Type SystemManualMessageStruct StepLabelCaptionTemp As String 'message to display StepLabelCaptionUnchangedStoredFlag As Boolean 'if values below is valid StepLabelCaptionUnchanged As String End Type Dim SystemManualMessageStructVar As SystemManualMessageStruct 'ExtendedHelpStruct - information about the extended help system 'NOTE: the extended help system is enabled if ProgramCommandStructVar.ExtendedHelpEnabledFlag is True. Private Type ExtendedHelpStruct GUI5SolvingTipGivenFlag As Boolean 'if usage of GUI5DefaultList has been explained yet GUI6SolvingTipGivenFlag As Boolean 'if usage of GUI6DefaultList has been explained yet GUI7SolvingTipGivenFlag As Boolean 'you know... End Type Dim ExtendedHelpStructVar As ExtendedHelpStruct 'SpaceRequiredStruct - contains drive names and related space the new files will access Private Type SpaceRequiredStruct DriveName As String DriveSpaceRequiredTotal As Double End Type 'FileNameListStruct - contains information about files of the FileSystemStructVar directories Private Type FileNameListStruct File As String 'full path FileSerialNumber As String 'important if File is saved on a cdrom End Type 'ItemListStruct - contains song names or artist names etc. Private Type ItemListStruct ByteString(1 To FILEINFOSTRUCT_TAGSTRINGLENGTH) As Byte End Type 'TagListStruct - all song/artist/album etc. names in one list Private Type TagListStruct ByteString(1 To FILEINFOSTRUCT_TAGSTRINGLENGTH) As Byte ItemType As Integer End Type 'DoubledFilesStruct - contains the original names of files that will be existing more than once after renaming Private Type DoubledFilesStruct FileInfoStructIndex As Integer End Type 'NoWriteAccessStruct - contains directories in which the system cannot write any file Private Type NoWriteAccessStruct DirectoryNameByte(1 To MAX_PATH) As Byte End Type 'MP3ListFileStruct - saves information for creating the mp3 list file Private Type MP3ListFileStruct IncludeDescriptionFlag As Boolean IncludeDateFlag As Boolean IncludeNewFileNamesFlag As Boolean IncludeOldFileNamesFlag As Boolean IncludeTAGFlag As Boolean IncludeFileSizeFlag As Boolean Author As String Comment As String MP3ListFile As String End Type 'GUICurtainStruct Private Type GUICurtainStruct GUICurtain_ShowSubCallNumber As Integer End Type Dim CurtainStructVar As GUICurtainStruct 'ProgramPopUpMenuStruct - information to save the 'source' of the pop up menu Private Type ProgramPopUpMenuStruct SourceDescription As String SourceObject As Object Tag As String End Type Dim ProgramPopUpMenuStructVar As ProgramPopUpMenuStruct ' '***END OF MISC STRUCTURES*** '***GUIX STRUCTURES**** ' 'GUIXListViewStruct - general information with equal use for all list views Private Type GUIXListViewStruct SortItemTypeOld As Integer 'item type the user sorted files by at last SearchItemTypeOld As Integer 'allows using F3 to continue searching End Type Dim GUIXListViewStructVar As GUIXListViewStruct 'GUIXListViewSearchStruct Private Type GUIXListViewSearchStruct SearchString As String ListViewSubItemIndex As Integer 'song name: 1, artist name: 2 etc., set when updating pop up menu End Type Dim GUIXSongNameSearchStructVar As GUIXListViewSearchStruct Dim GUIXArtistNameSearchStructVar As GUIXListViewSearchStruct Dim GUIXAlbumNameSearchStructVar As GUIXListViewSearchStruct Dim GUIXYearNameSearchStructVar As GUIXListViewSearchStruct Dim GUIXCommentSearchStructVar As GUIXListViewSearchStruct 'GUIXItemListStruct Private Type GUIXItemListStruct ItemType As Integer ItemTypeDescription As String ItemPlayedLastFileName As String 'full path of file that was played last ItemPlayedLastFileSerialNumber As String 'serial number of the drive the file played last is saved on ReselectItemName As String 'item that is to be marked after reloading ReselectItemType As Integer 'item type that makes ReselectItemName valid End Type Dim GUIXItemListStructVar As GUIXItemListStruct 'GUIXItemListSearchStruct - contains data for searching the GUIXItemList (originally GUI3SearchStruct) Private Type GUIXItemListSearchStruct SearchString As String End Type Dim GUIXItemListSearchStructVar As GUIXItemListSearchStruct 'GUIXColorSlider Dim GUIXColorSlider As New GFColorSlidercls Dim GUIXColorSliderPaletteCurrent As Integer 'GUIXProgressBar Dim GUIXProgressBar As New GFProgressBarcls ' '***END OF GUIX STRUCTURES*** '***OTHER*** ' 'Abort Const ABORT_NOTHING As Integer = 0 Const ABORT_SYSTEMDOEVENTS As Integer = 1 Const ABORT_SYSTEMDOEVENTS_AND_CANCEL As Integer = 2 'CommandToggle Const TOGGLESTATE_ERROR As Integer = 0 Const TOGGLESTATE_NORMAL As Integer = 1 Const TOGGLESTATE_TOGGLED As Integer = 2 'CommandToggleStruct Private Type CommandToggleStruct CommandDescription As String 'description of 'command' (two commands) visible to user CommandNormal As Object CommandToggled As Object ToggleState As Integer End Type Dim CommandToggleStructNumber As Integer Dim CommandToggleStructArray() As CommandToggleStruct 'Statistics1Struct Private Type Statistics1Struct ScanDirNumber As Integer ScanDirDriveNumber As Integer ScanDirFileNumberTotal As Integer ScanDirFileSizeTotal As String End Type 'Statistics2Struct Private Type Statistics2Struct DriveName As String DriveSerialNumber As String DriveTypeDescription As String DriveDescription As String 'CDDescription ScanDirName As String ScanDirFileCount As Integer ScanDirFileSizeTotal As Double ScanDirFileSizeTotalText As String ScanDirFilePercentage As Single 'percentage of files in scan dir compared to all files End Type 'GFDirectoryList4 Dim GFDirectoryList4GFDirListBox4 As New GFDirListBox4cls 'System_DoEvents Dim SystemDoEventsTimerOld As Single 'GUI_Wait/GUI_Continue Dim GUI_WaitCalledCounter As Integer 'other Dim NULLARRAYINT(0 To 0) As Integer 'used for GFTextMarker_ReceiveText() ' ' 'EXPERIMENTAL >>> ' ' Dim LANGIDUsedFlagArray(1 To 1000) As Byte Public Function LANG_Translate(ByVal StringID As Long, ByVal StringString As String) 'on error resume next 'If LANGIDUsedFlagArray(StringID) = False Then ' LANGIDUsedFlagArray(StringID) = True ' Open "LangDump.txt" For Append As #1 ' Print #1, CStr(StringID) + "=" + StringString ' Close #1 'End If LANG_Translate = StringString End Function ' ' '<<< END OF EXPERIMENTAL ' ' Private Sub Form_Load() 'on error Resume Next Dim Temp As Long 'begin 'Dim h As New HashTable 'h.DebugTest 'if this doesn't work, ANYTHING could happen (god knows what has happened) 'End StartUpStructVar.SystemStartingUpFlag = True If App.PrevInstance = True Then Call CheckProgramCommands If Len(ProgramCommandStructVar.AddDir) Then Call GFLRC_Senderfrm.GFLRC_SendMessage(JOINSTRINGS("add scan directory", ProgramCommandStructVar.AddDir), "MP3 Renamer 2 LRC Port") End If If Len(ProgramCommandStructVar.ScanDir) Then Call GFLRC_Senderfrm.GFLRC_SendMessage(JOINSTRINGS("scan directory", ProgramCommandStructVar.ScanDir), "MP3 Renamer 2 LRC Port") End If If 0 = 0 Then Call GFLRC_Senderfrm.GFLRC_SendMessage(JOINSTRINGS("restore Mfrm", ""), "MP3 Renamer 2 LRC Port") Call GFLRC_Senderfrm.GFLRC_SendMessage(JOINSTRINGS("restore Editfrm", ""), "MP3 Renamer 2 LRC Port") 'doesn't work :(================== End If End 'verify End If Call DefineProgramFilesStruct ' 'NOTE: the following line avoided that 'Clean up music files' from the 'Explorer right-click menu worked. That's why it was disabled. 'If VerifyProgramPathWriteAccess = False Then End ' If VerifyConflictCheckDLLExistence(True) = False Then End If VerifyProgramFileAttributes = False Then End If VerifyWindowsMediaPlayerExistence = False Then End If Rmod.RegGetKeyValue(RegMainKey, RegRootKey, "program running") = "True" Then MsgBox LANG_Translate(1, "It seems as if the program crashed or hung up last time it was started.") + Chr$(10) + LANG_Translate(2, "Despite failure-safe programming techniques and intensive testing it may happen that there are still bugs in the program, you can help the developers of Toricxs to find them through sending a mail to louis@toricxs.com containing the description of the bug.") + Chr$(10) + LANG_Translate(3, "Thank you!"), vbOKOnly + vbInformation Else Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey, "program running", CVar("True"), REG_SZ) End If Call CheckProgramCommands 'ProgramCommandStructVar.EditFile = "C:\MP3s\[unknown album]\01 - York - The Awakening (Quake Mix).mp3" 'TEMP Call CheckCopyrightNotice Call CheckDirectoryAction 'DEFINE ALL THAT'S NECESSARY FOR EXPLORER RIGHT CLICK EDIT Call DefineByteUCaseTable Call DefineByteLCaseTable Call DefineVars Call DefineGFTextMarkerPicture 'END OF DEFINING If Len(ProgramCommandStructVar.EditFile) Then Call GUIC_Preload 'load all data necessary for the FileInfoStruct_X functions and gui 8 file name creation functions If Editfrm.E_Edit(ProgramCommandStructVar.EditFile) = False Then StartUpStructVar.SystemStartingUpFlag = False ShutDownStructVar.SystemShuttingDownFlag = True Call GFSubClassmod.GFSubClass_Terminate Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey, "program running", CVar("False"), REG_SZ) 'reset ShutDownStructVar.SystemShuttingDownFlag = False End End If End If Call DefineHotKeys Call DefineGFPRSystem Call GFSetWindowStyle(TAGfrm.hwnd, WS_SYSMENU, True) 'do before (!) loading TAGfrm (TAGfrm is loaded before the Skin Engine can set the WS_SYSMENU style) Load TAGfrm 'define TAGfrm.TAGListView Load TGfrm 'define GenreNameByteStructArray() Call DefineGUI4TreeView 'used by Skin Engine Call DefineGUI7ListView Call DefineGUI9ListView Call DefineGUI10TreeView Call DefineGUI10ListView Call DefineSkinEngine 'do before displaying Loginfrm 'read SkinDataFile instantly Call SE_DisplayPalette(0, 0, False, False, True) 'read SDF only GFTextMarkerStructVar.MarkNumber = 0 Call DefineGFTextMarkerPicture 'do again (after resetting mark number) to load correct colors from SDF; loading SDF before right click edit is too slow GUICStructVar.ForceRedrawFlag = False GUICStructVar.ForceSkinDataFileReloadFlag = False 'do not force loading SkinDataFile any more Call FunFromReg 'important to enable sound Call StartUpFromReg Call StartUpToReg ' save changes (especially last start update and time) If (ProgramCommandStructVar.FastReadModeEnabledFlag = False) And (ProgramCommandStructVar.FastSortModeEnabledFlag = False) Then If StartUpStructVar.ShowSplashScreenFlag = True Then Call Login_Show Call Login_Refresh 'important End If Select Case Int((3 - 1 + 1) * Rnd(1) + 1) Case 1 'Call Fun_PlaySound("INTROA", 15) Case 2 'Call Fun_PlaySound("INTROB", 15) Case 3 'Call Fun_PlaySound("INTROC", 15) End Select End If Call DefineLogoLine 'of Loginfrm Call LogoLine_Refresh(LANG_Translate(4, "Loading CD Descriptions..."), True, 10) Call CDfrm.CDFromReg Call LogoLine_Refresh(LANG_Translate(5, "Loading Controls..."), True, 10) Call DefineStatus Call DefineGFMsgBox Call DefineSampleStruct Call DefineMfrm Call DefineGUIXProgressBar Call DefineGUI4ReadTrackingProgressBar Call DefineCommandToggleSystem Call DefineSGSystem Call DefineGUI1CopyDirList Call DefineGUI1MoveDirList Call DefineGUI3CutCharText Call DefineGUI3ReplaceCharText Call DefineGUI3NoUCaseText Call DefineGUI3NoLCaseText Call DefineGUI3ExpressionText Call DefineGUI3TestText Call DefineGUI5ItemTypeCombo Call DefineGUI6ItemTypeCombo Call DefineGUI9RecoverFileText Call DefineGFCCDDSystem Call DefineGFCompressionSystem Call DefineGFWindowStickSystem Call DefineWindowFadeSystem Call DefineGFDirectoryList4 Call DefineGUIXColorSlider Call DefineGUIXAnimationControl Call DefineFunSystem 'If Agent_Initialize = False Then 'verify Agent_Initialize has not been called before 'no! on some machines, agent was installed but not speech engine (tested) If OptionsStructVar.FirstProgramStartUpFlag = True Then 'do once only MsgBox LANG_Translate(5, "Note that you can download a Microsoft Agent with speech engine that reads the help to you. Visit www.toricxs.com/download/download.html for more information, or click on 'Yes' in the following dialog to make Toricxs install the Agent."), vbOKOnly + vbInformation If MsgBox(LANG_Translate(6, "Do you want Toricxs to install the Agent with Speech Engine now?") + Chr$(10) + LANG_Translate(7, "That's cool stuff, the Agent will read out the help text and you can also make the Agent speak what you want (Main Menu->Program Options->Test Agent...)."), vbYesNo + vbQuestion) = vbYes Then MsgBox LANG_Translate(8, "Toricxs will now run 4 executables downloaded from microsoft.com. Please accept the End User License Agreement if necessary."), vbOKOnly + vbInformation Call System_DoEvents Call GFShell_RunAndWait(ProgramFilesStructVar.ProgramPath + "Agent\MSagent.exe", -1) Call System_DoEvents Call GFShell_RunAndWait(ProgramFilesStructVar.ProgramPath + "Agent\Merlin.exe", -1) Call System_DoEvents Call GFShell_RunAndWait(ProgramFilesStructVar.ProgramPath + "Agent\tv_enua.exe", -1) Call System_DoEvents Call GFShell_RunAndWait(ProgramFilesStructVar.ProgramPath + "Agent\spchapi.exe", -1) Call System_DoEvents MsgBox LANG_Translate(9, "Agent and Speech Engine installation ended. Now continuing in Toricxs..."), vbOKOnly + vbInformation Loginfrm.SetFocus Call System_DoEvents Else Call MsgBox(LANG_Translate(10, "You can install the Agent and the speech engine manually at a later point of time. Therefore run the executables in ") + ProgramFilesStructVar.ProgramPath + LANG_Translate(11, "Agent\ ."), vbOKOnly + vbInformation) End If End If 'End If Call Program_EnableMenuBitmaps Call LogoLine_Refresh(LANG_Translate(12, "Loading Context Help..."), True, 10) Call DefineContextHelp Call LogoLine_Refresh(LANG_Translate(13, "Initializing Graphics..."), True, 10) Call DefineGUIPalette Call DefineGUICStructVar Call LogoLine_Refresh(LANG_Translate(14, "Initializing Message System..."), True, 10) Call Login_Refresh Call GFPMSmod.GFPMS_DefineSystemEx(100, Mfrm) If ProgramCommandStructVar.ExtendedHelpEnabledFlag = True Then If (ProgramCommandStructVar.FastReadModeEnabledFlag = False) And (ProgramCommandStructVar.FastSortModeEnabledFlag = False) Then 'NOTE: disable the following line when wanting to change the Loginfrm skinning. If StartUpStructVar.ShowSplashScreenFlag = True Then Call Login_Hide 'do here as CD could be requested in next lines Call Login_Refresh 'important End If End If Call ContextHelp_Show("SuddenText:10", True) 'show before step 1 reached 'Call ProgramReceivePopUpMenu_Click(43, 3) 'open HTML Help 'confusing If (ProgramCommandStructVar.FastReadModeEnabledFlag = False) And (ProgramCommandStructVar.FastSortModeEnabledFlag = False) Then If StartUpStructVar.ShowSplashScreenFlag = True Then Call Login_Show Call Login_Refresh 'important End If End If End If ' Call LogoLine_Refresh(LANG_Translate(15, "Checking for SafeGuard data recovery..."), True, 10) Call Login_Refresh Call SG_Read_Ask(SGStructVar, ProgramCommandStructVar) 'read FileInfoStruct data if necessary, temporary disable ContextHelp system if necessary 'NOTE: call SG_Read_Ask before ProgramCommandStructVar.[Add/Scan]Dir is processed. ' Call LogoLine_Refresh(LANG_Translate(16, "Processing Program Commands..."), True, 10) Call Login_Refresh ' If (Len(ProgramCommandStructVar.AddDir)) Or _ (Len(ProgramCommandStructVar.ScanDir)) Then ' 'NOTE: when program was started because of a use of the 'MP3 Renamer 2 Explorer Shell interface a special ConfigSet will be used. ' 'verify ConfigSet exists Call CSETfrm.ConfigSet_ReceiveRegKey(RegMainKey, RegRootKey + "Scan Directories\") 'important If CSETfrm.GetConfigSetIndex("[Explorer]") = 0 Then Call CSETfrm.ConfigSet_CreateConfigSet("[Explorer]") Call CSETfrm.ConfigSetStructToReg_Public 'save changes (important) End If 'verify ConfigSet will be used (verify before calling GUIC_DoPaletteChange) Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + "Scan Directories\", "ConfigSetNameCurrent", "[Explorer]", REG_SZ) 'verify ConfigSet contains no directories Call Rmod.RegDeleteSubKey(RegMainKey, CSETfrm.ConfigSet_GetRegKeyEx(CSETfrm.GetConfigSetIndex("[Explorer]"))) Call Rmod.RegCreateSubKey(RegMainKey, CSETfrm.ConfigSet_GetRegKeyEx(CSETfrm.GetConfigSetIndex("[Explorer]"))) End If Call LogoLine_Refresh(LANG_Translate(17, "Loading Directories..."), True, 10) Call Login_Refresh Call GUI1DirListFromReg 'load directories Call LogoLine_Refresh(LANG_Translate(18, "Loading Graphics..."), True, 10) Call Login_Refresh ' 'NOTE: 'till the end of this sub we temporary disable the extended help system 'to avoid that the StepDescription is shown through ANY System_DoEvents-call. ' ProgramCommandStructVar.ExtendedHelpEnabledFlagUnchanged = ProgramCommandStructVar.ExtendedHelpEnabledFlag ProgramCommandStructVar.ExtendedHelpEnabledFlag = False 'temporary disable ANTStructVar.ANTSystemDisabledFlag = True 'temporary disable (just copied from extended help system, don't show when SG_Perform is active) ' 'NOTE: the stupid system processed some messages that set the current and the old 'palette to 1 so that the palette 1 will not be loaded any more (only reload if changed). 'Reset the value of the current and the old palette to verify palette 1 will be loaded. 'The error explained above only appeared sometimes when the program is compiled '(damn it!). There will be no error when resetting the values as they have only been set 'to enable or disable the GUI[Back/Next]Command, what is done in any case 'in GUIC_DoPaletteChange() before the form is shown (see below). ' GUICStructVar.GUIPaletteNumberCurrent = 0 'reset (important) GUICStructVar.GUIPaletteNumberOld = 0 'reset (important) 'NOTE: I'm not sure if the stuff explained above really caused an error (I think it didn't). Call GUIC_DoPaletteChange(1, True) 'change palette in any case, also if there's a ContextHelp message in the buffer Call LogoLine_Refresh(LANG_Translate(19, "Initializing Start Station..."), True, 10) Call Login_Refresh Call DefineStartStation 'do after SE is usable Call LogoLine_Refresh("", True, 10) Call Login_Refresh If (ProgramCommandStructVar.FastReadModeEnabledFlag = True) Then If SGfrm.SG_IsReadAllPossible = True Then If MsgBox(LANG_Translate(20, "When performing the FastRead then the SafeGuard data will be lost (you cannot continue where you stopped editing at last program start up). Continue (press 'No' if you want to continue editing where you stopped last time) ?"), vbYesNo + vbQuestion) = vbYes Then Call FastReadMode_PerformFastRead ProgramCommandStructVar.FastReadModeEnabledFlag = False 'reset (after performing fast read) Else ProgramCommandStructVar.FastReadModeEnabledFlag = False 'reset (as user does not really want to perform the FastRead) End If End If End If If (ProgramCommandStructVar.FastSortModeEnabledFlag = True) Then If SGfrm.SG_IsReadAllPossible = True Then If MsgBox(LANG_Translate(21, "When performing the FastSort then the SafeGuard data will be lost (you cannot continue where you stopped editing at last program start up). Continue (press 'No' if you want to continue editing where you stopped last time) ?"), vbYesNo + vbQuestion) = vbYes Then Call FastSortMode_PerformFastSort ProgramCommandStructVar.FastSortModeEnabledFlag = False 'reset (after performing fast read) Else ProgramCommandStructVar.FastSortModeEnabledFlag = False 'reset (as user does not really want to perform the FastSort) End If End If End If 'NOTE: Mfrm is completely invisible 'till this point If (ProgramCommandStructVar.FastReadModeEnabledFlag = False) And (ProgramCommandStructVar.FastSortModeEnabledFlag = False) Then 'NOTE: disable the following line when wanting to change the Loginfrm skinning. If StartUpStructVar.ShowSplashScreenFlag = True Then Call Login_Hide 'do here as CD could be requested in next lines Call Login_Refresh 'important End If End If Call ZoomSlideFromReg(ZoomSlideControlStructVar) Call Msg_Add("call Idle_Update()") If Len(ProgramCommandStructVar.AddDir) Then Call Msg_AddAndPack("call GUI1Dirs_Add()", ProgramCommandStructVar.AddDir) 'ProgramCommandStructVar.AddDir = "" 'reset 'no! (still used) End If If Len(ProgramCommandStructVar.ScanDir) Then Call Msg_AddAndPack("call GUI1Dirs_Scan()", ProgramCommandStructVar.ScanDir) 'ProgramCommandStructVar.ScanDir = "" 'reset 'no! End If Call GFLRC_Receiverfrm.OpenLRCPort("MP3 Renamer 2 LRC Port") 'see also Form_Unload() Call GFLRC_Receiverfrm.GFLRC_AddCallBackForm(Mfrm) If StartUpStructVar.ShowSplashScreenFlag = False Then ' 'NOTE: if the user disabled the splash screen then Mfrm is displayed minimized. 'So the user can make Toricxs play a randomly selected file '(StartUpStructVar.RandomPlayEnabledFlag = True) 'without disturbing the user. ' Me.WindowState = vbMinimized Else Me.WindowState = WindowStateRestore_CatchWindowState(PROGRAMFORM_MFRM) End If If StartUpStructVar.RandomPlayEnabledFlag = True Then If (Len(ProgramCommandStructVar.AddDir) = 0) And (Len(ProgramCommandStructVar.ScanDir) = 0) Then Call QPfrm.QPList_RandomPlay Else 'NOTE: we don't play any file if the user used the Explorer right-click menu to start MP3 Renamer 2. End If End If Call SG_Read_Perform(SGStructVar, ProgramCommandStructVar) Call WindowFade_DoFade(Me.hwnd, 0) Me.Enabled = True 'important as project starts in Sub Main Me.Visible = True 'important as project starts in Sub Main Me.Refresh If Me.WindowState = vbNormal Then 'verify For Temp = 0 To 100 Step 10 'fade in If WindowFade_DoFade(Me.hwnd, Temp) = False Then Exit For Call Sleep(30) Next Temp End If Call WindowFade_DisableFade(Me.hwnd) ZoomSlideStructVar.ZoomSlideDisabledFlag = True 'don't center forms opened through the WindowStateRestore system If WindowStateRestore_CatchVisible(PROGRAMFORM_QPFRM) = True Then Call GUI_Wait 'important, or user can perform e.g. a dir scan while QPList is loading Call SystemManualMessage_Show(LANG_Translate(22, "opening Quick Play window...")) Call QPfrm.QP_Show Call SystemManualMessage_Hide Call GUI_Continue End If If WindowStateRestore_CatchVisible(PROGRAMFORM_LWCFRM) = True Then If GUICStructVar.GUIPaletteNumberCurrent = 9 Then Call GUI_Wait Call SystemManualMessage_Show(LANG_Translate(23, "opening Tools window...")) Call GUI9ToolsCommand_Click 'LWCfrm.LWC_Show needs too much stuff (easier this way) Call SystemManualMessage_Hide Call GUI_Continue End If End If ZoomSlideStructVar.ZoomSlideDisabledFlag = False 'reset ' 'NOTE: now re-enable the extended help system (if it was enabled) and 'display the first StepDescription. ' If ProgramCommandStructVar.ExtendedHelpEnabledFlagUnchanged = True Then ProgramCommandStructVar.ExtendedHelpEnabledFlag = True 'reset ANTStructVar.ANTSystemDisabledFlag = False 'reset (like extended help system would be reset, copied from there) Call GUIC_ShowStepDescription(GUICStructVar.GUIPaletteNumberCurrent, False) 'if previously error changing palette then we'll show the help for the current palette (Step) Else ANTStructVar.ANTSystemDisabledFlag = False 'reset (like extended help system would be reset, copied from there) Call GUIC_ShowANT(GUICStructVar.GUIPaletteNumberCurrent) 'done when palette changed End If ' Call Msg_Add("call SystemForms_GarbageCollect") StartUpStructVar.SystemStartingUpFlag = False 'now system is completely functionary SystemUpdateTimer.Enabled = True 'always running, GFPMS timer running only when message in queue ' 'DIRTY HACK ' 'NOTE: there's an error somewhere, STS commands are not redrawn after skin editing or skin 'reloading or something like this, re-create at every program start up. 'NOTE: the following lines are not necessary as after every skin reload the commands are 'refreshed with ForceRecreateFlag = True (but we keep the lines there to verify the refreshing). ' Dim DisabledPictureCacheDir As String Call DisabledPictureCache_GetCacheDir(DisabledPictureCacheDir) Call StartStation_RefreshCommandSub(1, GetSEControlStructIndex("GFStartStationCommandFixed(1)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(1)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(2, GetSEControlStructIndex("GFStartStationCommandFixed(2)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(2)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(3, GetSEControlStructIndex("GFStartStationCommandFixed(3)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(3)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(4, GetSEControlStructIndex("GFStartStationCommandFixed(4)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(4)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(5, GetSEControlStructIndex("GFStartStationCommandFixed(5)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(5)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(1, GetSEControlStructIndex("GFStartStationCommandMovable(1)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(1)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(2, GetSEControlStructIndex("GFStartStationCommandMovable(2)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(2)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(3, GetSEControlStructIndex("GFStartStationCommandMovable(3)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(3)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(4, GetSEControlStructIndex("GFStartStationCommandMovable(4)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(4)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(5, GetSEControlStructIndex("GFStartStationCommandMovable(5)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(5)"), DisabledPictureCacheDir, True) 'important (tested) 'END OF DIRTY HACK ' 'APU ' GFPMSfrm.MsgTimer.Enabled = False 'temporary disable or ContextHelp will be displayed over update message (tested); don't forget to re-enable!!! ' On Error GoTo 0 On Error GoTo APUError: 'important, if DLL not existing If APUmod.APUMOD_LoadUpdateFile = True Then 'if internet connection existing, if not, ignore Dim ProgramVersionCurrent As String ProgramVersionCurrent = APUmod.APUMOD_GetProgramVersionCurrent If ProgramVersionCurrent <> ProgramVersion + " " + ProgramBuild Then If MsgBox(LANG_Translate(24, "There is a newer version of Toricxs served for downloading (your version is out-of-date).") + Chr$(10) + LANG_Translate(25, "Do you want to have more information ?"), vbYesNo + vbQuestion) = vbYes Then Call SystemManualMessage_Hide 'reset Call SystemForms_Disable(PROGRAMFORM_ALL) Call APUMOD_ShowUpdateInfo Call SystemForms_Enable 'reset End If End If End If APUError: ' GFPMSfrm.MsgTimer.Enabled = True 'reset (see info above) ' End Sub Private Sub Form_Resize() 'on error resume next If GUICurtainPicture.Visible = True Then ' 'NOTE: hide non-loaded controls when the current step changes and 'Mfrm has a larger size in the new step than in the current one. ' Call GUICurtain_Size(Mfrm.Width, Mfrm.Height) End If If MfrmSizeStructVar.MfrmSizedOnceFlag = True Then 'do not process the very first size change Call MfrmSizeChanged( _ MfrmSizeStructVar.MfrmWidthOld, MfrmSizeStructVar.MfrmHeightOld, MfrmSizeStructVar.MfrmWindowStateOld, _ Mfrm.Width, Mfrm.Height, Mfrm.WindowState) 'used to size/move GUI10 controls End If MfrmSizeStructVar.MfrmSizedOnceFlag = True MfrmSizeStructVar.MfrmWidthOld = Mfrm.Width MfrmSizeStructVar.MfrmHeightOld = Mfrm.Height MfrmSizeStructVar.MfrmWindowStateOld = Mfrm.WindowState End Sub Private Sub DefineVars() 'on error resume next ' 'NOTE: intialize vars here that do not really fit to any other Define-sub '(that would be initialized in a constructor). ' GUIXSongNameSearchStructVar.ListViewSubItemIndex = 1 GUIXArtistNameSearchStructVar.ListViewSubItemIndex = 2 GUIXAlbumNameSearchStructVar.ListViewSubItemIndex = 3 GUIXYearNameSearchStructVar.ListViewSubItemIndex = 4 GUIXCommentSearchStructVar.ListViewSubItemIndex = 5 End Sub Public Sub GFLRC_ReceiveMessage(ByVal message As String) 'on error resume next Dim LRCCommand As String Dim LRCValue As String ' 'NOTE: another copy of MP3 Renamer 2 is started with a special program command 'that makes it add a special scan directory. This copy determined that it is not 'the previous instance of MP3 Renamer 2, used GFLRC to send a message to this 'instance and will terminate itself. ' 'begin Call SPLITSTRINGS(message, LRCCommand, LRCValue) Select Case LRCCommand Case "add scan directory" If (GUICStructVar.GUIPaletteNumberCurrent = 1) And (System_IsSystemBusy = False) Then 'verify (important, or directory will be added even during renaming) If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then Call Msg_AddAndPack("call GUI1Dirs_Add()", LRCValue) Else MsgBox LANG_Translate(26, "Please disable the UserMove mode (Esc) first !"), vbOKOnly + vbInformation End If Else MsgBox LANG_Translate(27, "Sorry, you can only add a new directory when you are in step 1 and when there is currently no operation performed !"), vbOKOnly + vbInformation End If Case "scan directory" If (GUICStructVar.GUIPaletteNumberCurrent = 1) And (System_IsSystemBusy = False) Then 'verify (important, or directory will be scanned even during renaming) Call Msg_AddAndPack("call GUI1Dirs_Scan()", LRCValue) Else MsgBox LANG_Translate(28, "Sorry, you can only add a new directory when you are in step 1 and when there is currently no operation performed !"), vbOKOnly + vbInformation End If Case "restore Mfrm" If Not (Mfrm.WindowState = vbNormal) Then Mfrm.WindowState = vbNormal If (Mfrm.Enabled) And (Mfrm.Visible) Then Mfrm.SetFocus 'important (tested) Case "restore Editfrm" If Not (Editfrm.WindowState = vbNormal) Then Editfrm.WindowState = vbNormal If (Editfrm.Enabled) And (Editfrm.Visible) Then Editfrm.SetFocus 'important (tested) Case Else MsgBox "internal error in GFLRC_ReceiveMessage(): command '" + LRCCommand + "' unknown !", vbOKOnly + vbExclamation End Select End Sub Private Function VerifyProgramPathWriteAccess() As Boolean On Error GoTo Error: 'important; returns True if writing in ProgramPath is possible, False if not Dim TempFile As String Dim TempFileNumber As Integer 'preset TempFile = GenerateTempFileName(ProgramFilesStructVar.ProgramPath) TempFileNumber = FreeFile(0) Open TempFile For Output As #TempFileNumber Close #TempFileNumber Kill TempFile 'make sure temp file is deleted VerifyProgramPathWriteAccess = True 'ok Exit Function Error: Close #TempFileNumber 'make sure file is closed MsgBox LANG_Translate(29, "Error: writing to current directory failed, please do not start this program from a CD or write-protected network drive (use the installation program) !"), vbOKOnly + vbCritical VerifyProgramPathWriteAccess = False 'error Exit Function End Function Private Function VerifyConflictCheckDLLExistence(ByVal DisplayErrorMessageFlag As Boolean) As Boolean On Error GoTo Error: 'important; returns False if the Conflict Check DLL is not existing and the user wants to abort or the user cannot abort as no error message is created, True otherwise Call DLLConflictCheck_IsConflictCheckAvailable 'in case of error jump to Error: VerifyConflictCheckDLLExistence = True 'ok Exit Function Error: If DisplayErrorMessageFlag = True Then If MsgBox(LANG_Translate(30, "Error: dll 'mp3ex.dll' not found in %windir% or %winsysdir%, program behavior may be incorrect. Continue (not recommended) ?"), vbYesNo + vbQuestion) = vbYes Then VerifyConflictCheckDLLExistence = True 'ok (?!) Else MsgBox LANG_Translate(31, "Please reinstall Toricxs using the installation program."), vbOKOnly + vbInformation VerifyConflictCheckDLLExistence = False 'error End If Else VerifyConflictCheckDLLExistence = False 'error End If Exit Function End Function Private Function VerifyProgramFileAttributes() As Boolean On Error Resume Next 'important (if a file is not found or locked); always returns True (just returns something like the other 'start-up verifying functions') 'begin Call SetAttr(STUFF_PROGRAMDIRECTORY + "Toricxs.exe", vbNormal) Call SetAttr(STUFF_PROGRAMDIRECTORY + "Toricxs Starter.exe", vbNormal) Call SetAttr(STUFF_PROGRAMDIRECTORY + "ContextHelp.dat", vbNormal) Call SetAttr(STUFF_PROGRAMDIRECTORY + "Resource.dat", vbNormal) Call SetAttr(STUFF_PROGRAMDIRECTORY + "Resource.dll", vbNormal) Call SetAttr(STUFF_PROGRAMDIRECTORY + "SGFile.dat", vbNormal) 'verify If Not (GetAttr(STUFF_PROGRAMDIRECTORY + "Resource.dat") = vbNormal) Then 'Toricxs.exe can be write-protected (will not be changed anyway) MsgBox LANG_Translate(32, "Please verify Toricxs.exe and related files in the directory '") + STUFF_PROGRAMDIRECTORY + LANG_Translate(33, "' are not hidden, system-stated or write-protected (mark files in Explorer, right click and uncheck all file attributes-check boxes) !"), vbOKOnly + vbExclamation End If VerifyProgramFileAttributes = True 'even if 'error' (try to continue) End Function Private Function VerifyWindowsMediaPlayerExistence() As Boolean On Error GoTo Error: Dim TempWMP As New WindowsMediaPlayer VerifyWindowsMediaPlayerExistence = True Exit Function Error: If MsgBox(LANG_Translate(34, "Please download and install the newest version of Microsoft Windows Media Player.") + Chr$(10) + _ LANG_Translate(35, "Without Media Player Toricxs is not able to read & write WMA tags."), vbOKCancel + vbExclamation) = vbCancel Then VerifyWindowsMediaPlayerExistence = False Else VerifyWindowsMediaPlayerExistence = True End If Exit Function End Function Private Sub ProgramCaption_Change(ByVal CaptionNew As String) 'on error resume next 'sets Mfrm's caption ' 'NOTE: Mfrm.Caption has a special meaning. It is important for 'Starter to determine if MP3 Renamer 2 is running, and if it does 'in which mode (normal, FastRead, FastSort). 'If CaptionNew is nothing (""), the default caption will be displayed ' Select Case CaptionNew Case "" Mfrm.Caption = "Toricxs" Case Else Mfrm.Caption = CaptionNew End Select End Sub Private Sub CheckProgramCommands() 'on error resume next ' 'NOTE: values in some structures are changed depending on the program commands, 'what influences the behavior of the system. 'command: program action '-/fastread: program is minimized, does not display any start up picture, ' caption displays Fast Read until arrived at step 5, then caption displays FINISHED. ' If an error occurs the caption displays ERROR. '-/fastsort: like /fastread, but stops at step 10. '-/extendedhelp: enabled extended help ' 'NOTE: for further information about the FastRead and FastSort mode 'view annotations at related code location. ' 'reset ProgramCommandStructVar.FastReadModeEnabledFlag = False ProgramCommandStructVar.FastSortModeEnabledFlag = False ProgramCommandStructVar.ExtendedHelpEnabledFlag = False 'begin Select Case LCase$(Trim$(Command$)) Case "/fastread" ProgramCommandStructVar.FastReadModeEnabledFlag = True Case "/fastsort" ProgramCommandStructVar.FastSortModeEnabledFlag = True Case "/extendedhelp" ProgramCommandStructVar.ExtendedHelpEnabledFlag = True End Select If Left$(LCase$(Trim$(Command$)), 5) = "/add:" Then ProgramCommandStructVar.AddDir = Trim$(Right$(Command$, Len(Command$) - 5)) ProgramCommandStructVar.AddDir = GFGetLongFileName(ProgramCommandStructVar.AddDir) 'important If Not (Right$(ProgramCommandStructVar.AddDir, 1) = "\") Then ProgramCommandStructVar.AddDir = ProgramCommandStructVar.AddDir + "\" 'verify 'NOTE: only the Windows Shell passes short file names, VB file list boxes always display long file names. End If If Left$(LCase$(Trim$(Command$)), 6) = "/scan:" Then ProgramCommandStructVar.ScanDir = Trim$(Right$(Command$, Len(Command$) - 6)) ProgramCommandStructVar.ScanDir = GFGetLongFileName(ProgramCommandStructVar.ScanDir) 'important If Not (Right$(ProgramCommandStructVar.ScanDir, 1) = "\") Then ProgramCommandStructVar.ScanDir = ProgramCommandStructVar.ScanDir + "\" 'verify End If If Left$(LCase$(Trim$(Command$)), 6) = "/edit:" Then ProgramCommandStructVar.EditFile = Trim$(Mid$(Command$, 7)) Else ProgramCommandStructVar.EditFile = "" End If If Rmod.RegGetKeyValue(RegMainKey, RegRootKey, "") = "" Then 'NOTE: the default entry in the root directory signalizes that MP3 Renamer 2 was started once. 'ProgramCommandStructVar.ExtendedHelpEnabledFlag = True 'not any more... we use the ANT help now Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey, "", _ CVar("MP3 Renamer 2 first start up: " + Date$ + ", " + time$), REG_SZ) 'NOTE: create the default entry in the root directory only if not existing yet. OptionsStructVar.FirstProgramStartUpFlag = True Else 'ProgramCommandStructVar.ExtendedHelpEnabledFlag = False 'could have been enabled through program command OptionsStructVar.FirstProgramStartUpFlag = False End If 'ProgramCommandStructVar.ExtendedHelpEnabledFlag = True '***TEMP*** 'ProgramCommandStructVar.FastReadModeEnabledFlag = True '***TEMP*** End Sub Private Sub CheckCopyrightNotice() 'on error resume next Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey, "copyright notice 1", CVar("Toricxs (c)2001-2008 by Louis (Matthias Mueller)."), REG_SZ) Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey, "copyright notice 2", CVar("Toricxs Skin Engine (c)2001-2008 by Louis (Matthias Mueller)."), REG_SZ) End Sub Private Sub CheckDirectoryAction() 'on error resume next ' 'NOTE: it is important to put the executable name between quotes or the stupid 'Win98-shell will not manage to handle extended file names (8.3 format only). ' 'REMOVE OLD Call GFRegShellInfo_RemoveDirectoryAction("Clean Up With Toricxs", "Toricxs.AddDir", """" + ProgramFilesStructVar.ProgramFile + """" + " /add:%1") 'v1.0 Call GFRegShellInfo_RemoveDirectoryAction("Scan With Toricxs", "Toricxs.ScanDir", """" + ProgramFilesStructVar.ProgramFile + """" + " /scan:%1") 'v1.0 Call GFRegShellInfo_RemoveDirectoryAction("Get and/or Clean Up MP3s", "Toricxs.ScanDir", """" + ProgramFilesStructVar.ProgramFile + """" + " /scan:%1") 'v1.1.1 'ADD CURRENT Call GFRegShellInfo_CreateDirectoryAction("Clean Up Music Files", "Toricxs.ScanDir", """" + ProgramFilesStructVar.ProgramFile + """" + " /scan:%1") 'v1.1.1 18.02.05 Call GFRegShellInfo_CreateDriveAction("Clean Up Music Files", "Toricxs.ScanDrive", """" + ProgramFilesStructVar.ProgramFile + """" + " /scan:%1") 'v1.1.1 16.01.06 'add file context menus Dim RegSubKey As String RegSubKey = Rmod.RegGetKeyValue(HKEY_CLASSES_ROOT, ".mp3", "") Call GFRegShellInfo_CreateFileAction(RegSubKey, "Edit File Name/Tag", "Toricxs.EditFile", """" + ProgramFilesStructVar.ProgramFile + """" + " /edit:%1") 'v1.1.1 16.01.06 RegSubKey = Rmod.RegGetKeyValue(HKEY_CLASSES_ROOT, ".wma", "") Call GFRegShellInfo_CreateFileAction(RegSubKey, "Edit File Name/Tag", "Toricxs.EditFile", """" + ProgramFilesStructVar.ProgramFile + """" + " /edit:%1") 'v1.1.1 16.01.06 RegSubKey = Rmod.RegGetKeyValue(HKEY_CLASSES_ROOT, ".wav", "") Call GFRegShellInfo_CreateFileAction(RegSubKey, "Edit File Name/Tag", "Toricxs.EditFile", """" + ProgramFilesStructVar.ProgramFile + """" + " /edit:%1") 'v1.1.1 16.01.06 End Sub Private Sub DefineStatus() 'on error Resume Next GUI2SongNameStartStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2SongNameEndStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2ArtistNameStartStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2ArtistNameEndStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2AlbumNameStartStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2AlbumNameEndStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2YearNameStartStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2YearNameEndStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2CommentStartStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2CommentEndStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2TrashStartStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI2TrashEndStringText.MaxLength = FILTERSTRUCT_BYTESTRINGLENGTH GUI8FileFormatText.MaxLength = MAX_PATH 'real path can of course be longer anyway GUI8DirFormatText.MaxLength = MAX_PATH 'real path can of course be longer anyway GUI12CommentText.MaxLength = 1024 GUI12AuthorText.MaxLength = 50 End Sub Public Sub DefineGFMsgBox() 'also used by Pmod 'on error resume next Dim FontName As String 'begin FontName = SE_GetSystemText(120) If ISFONTAVAILABLE(FontName) = True Then Call GFMsgBoxfrm.GFMsgBox_SetLabelFont(FontName, 10, False, False, False, False) 'don't use size 8, hard to read Else Call GFMsgBoxfrm.GFMsgBox_SetLabelFont("Arial", 10, False, False, False, False) 'don't use size 8, hard to read End If FontName = SE_GetSystemText(121) If ISFONTAVAILABLE(FontName) = True Then Call GFMsgBoxfrm.GFMsgBox_SetTextBoxFont(FontName, 8, False, False, False, False) Else Call GFMsgBoxfrm.GFMsgBox_SetTextBoxFont("Arial", 8, False, False, False, False) End If FontName = SE_GetSystemText(122) 'NOTE: the command font size is 10 too in a GFStatisticsBox . If ISFONTAVAILABLE(FontName) = True Then Call GFMsgBoxfrm.GFMsgBox_SetCommandFont(FontName, 10, False, False, False, False) Else Call GFMsgBoxfrm.GFMsgBox_SetCommandFont("Arial", 10, False, False, False, False) End If End Sub Private Sub DefineProgramFilesStruct() 'on error resume next Dim ProgramFile As String 'begin ' ProgramFilesStructVar.WinDir = GFShellRegistration_GetWinDir ProgramFilesStructVar.WinSysDir = GFShellRegistration_GetWinSysDir ProgramFilesStructVar.WinTempDir = GFShellRegistration_GetWinTempDir ' ProgramFile = App.Path If Not (Right$(ProgramFile, 1) = "\") Then ProgramFile = ProgramFile + "\" ProgramFilesStructVar.ProgramPath = ProgramFile 'temporary ProgramFile value ' ProgramFile = ProgramFile + App.EXEName If Not (Right$(ProgramFile, 1) = ".") Then ProgramFile = ProgramFile + "." If Not (LCase$(Right$(ProgramFile, 3)) = "exe") Then ProgramFile = ProgramFile + "exe" 'this should work! ProgramFilesStructVar.ProgramFile = ProgramFile ' ProgramFilesStructVar.ProgramResourceFile = ProgramFilesStructVar.ProgramPath + "Resource.dat" ProgramFilesStructVar.ProgramResourceDLL = ProgramFilesStructVar.ProgramPath + "Resource.dll" ProgramFilesStructVar.ContextHelpFile = ProgramFilesStructVar.ProgramPath + "ContextHelp.dat" ProgramFilesStructVar.StarterFile = ProgramFilesStructVar.ProgramPath + "Toricxs Starter.exe" ProgramFilesStructVar.DS = ProgramFilesStructVar.ProgramPath + "DeleteServer.exe" ' End Sub Private Sub DefineHotKeys() 'on error Resume Next Call SE_DefineHotKeys End Sub Private Sub DefineStartStation() 'on error resume next Call GFStartStation_Initialize(RegMainKey, RegRootKey, "shell32.dll", 20, "shell32.dll", 2) Call GFStartStationFromReg Call GFStartStation_RefreshAll End Sub Private Sub DefineGFPRSystem() 'on error resume next ' Call GFPR_Initialize(ProgramFilesStructVar.ProgramResourceFile, GFShellRegistration_GetWinTempDir) ' Call GFPR_RegisterResource("FILECMOV", "FILECMOV.AVI") Call GFPR_RegisterResource("FILECOPY", "FILECOPY.AVI") Call GFPR_RegisterResource("FILEMOVE", "FILEMOVE.AVI") Call GFPR_RegisterResource("FILESCAN", "FILESCAN.AVI") Call GFPR_RegisterResource("FINDFILE", "FINDFILE.AVI") Call GFPR_RegisterResource("HOURGLSS", "HOURGLSS.AVI") Call GFPR_RegisterResource("QUESTION", "QUESTION.AVI") Call GFPR_RegisterResource("SCANDIGIT", "SCANDIGIT.AVI") Call GFPR_RegisterResource("XP_CHECK", "XP_CHECK.AVI") ' Call GFPR_RegisterResource("LOGO1", "LOGO1.BMP") Call GFPR_RegisterResource("DIRDRAG", "DIRDRAG.BMP") Call GFPR_RegisterResource("MP31", "MP31.BMP") Call GFPR_RegisterResource("TAG1", "TAG1.BMP") Call GFPR_RegisterResource("SPELLERR1", "SPELLERR1.BMP") Call GFPR_RegisterResource("INCLERR1", "INCLERR1.BMP") Call GFPR_RegisterResource("GUI9MENU", "GUI9MENU.BMP") Call GFPR_RegisterResource("TRAILER1", "TRAILER1.BMP") Call GFPR_RegisterResource("TRAILER2", "TRAILER2.BMP") Call GFPR_RegisterResource("VBLOGO", "VBLOGO.BMP") Call GFPR_RegisterResource("VCLOGO", "VCLOGO.BMP") Call GFPR_RegisterResource("LOGO", "LOGO.BMP") Call GFPR_RegisterResource("INTROA", "INTROA.WAV") Call GFPR_RegisterResource("INTROB", "INTROB.WAV") Call GFPR_RegisterResource("INTROC", "INTROC.WAV") Call GFPR_RegisterResource("MEGASCAN", "MEGASCAN.WAV") Call GFPR_RegisterResource("DATAREAD", "DATAREAD.WAV") Call GFPR_RegisterResource("NEWNAMES", "NEWNAMES.WAV") Call GFPR_RegisterResource("TRAILER", "TRAILER.WAV") ' End Sub Private Sub DefineMfrm() 'on error Resume Next Call DragAcceptFiles(Mfrm.hwnd, 1) 'must be removed (see Form_Unload()) Call GFSubClass(Mfrm, "Mfrm", Mfrm, True) Call ProgramCaption_Change("") 'set default caption End Sub Private Sub DefineCommandToggleSystem() 'on error rresume next Call CommandToggle_AddItem(GUI4PauseCommand, GUI4ResumeCommand, "GUI4") Call CommandToggle_Refresh("GUI4") Call CommandToggle_AddItem(GUI11PauseCommand, GUI11ResumeCommand, "GUI11") Call CommandToggle_Refresh("GUI11") End Sub Private Sub DefineGFTextMarkerPicture() 'on error Resume Next Call GFSubClass(GFTextMarkerPicture, "GFTextMarkerPicture", Mfrm, True) 'see also Form_Unload() Call DragAcceptFiles(GFTextMarkerPicture.hwnd, True) 'see also Form_Unload() GFTextMarkerStructVar.EffectsEnabledFlag = True Call GFTextMarker_AddMark(GetTAGItemTypeDescription(CONST_SONGNAME), SE_GetSystemColor(CONST_SONGNAME)) Call GFTextMarker_AddMark(GetTAGItemTypeDescription(CONST_ARTISTNAME), SE_GetSystemColor(CONST_ARTISTNAME)) Call GFTextMarker_AddMark(GetTAGItemTypeDescription(CONST_ALBUMNAME), SE_GetSystemColor(CONST_ALBUMNAME)) Call GFTextMarker_AddMark(GetTAGItemTypeDescription(CONST_YEAR), SE_GetSystemColor(CONST_YEARNAME)) Call GFTextMarker_AddMark(GetTAGItemTypeDescription(CONST_COMMENT), SE_GetSystemColor(CONST_COMMENT)) Call GFTextMarker_AddMark(GetTAGItemTypeDescription(CONST_TRASH), SE_GetSystemColor(CONST_TRASH)) Call GFTextMarker_DrawLegend(GFTextMarkerStructVar) Call GFTextMarker_Refresh(GFTextMarkerStructVar) Call GFTextMarkerLegendPicture_MouseDown(vbLeftButton, 0, 1, 1) 'preset End Sub Private Sub DefineGUI3CutCharText() 'on error Resume Next 'subclassed to disable the default text pop-up menu Call GFSubClass(GUI3CutCharText, "GUI3CutCharText", Mfrm, True) End Sub Private Sub DefineGUI3ReplaceCharText() 'on error Resume Next 'subclassed to disable the default text pop-up menu Call GFSubClass(GUI3ReplaceCharText, "GUI3ReplaceCharText", Mfrm, True) End Sub Private Sub DefineGUI3NoUCaseText() 'on error Resume Next 'subclassed to disable the default text pop-up menu Call GFSubClass(GUI3NoUCaseText, "GUI3NoUCaseText", Mfrm, True) End Sub Private Sub DefineGUI3NoLCaseText() 'on error Resume Next 'subclassed to disable the default text pop-up menu Call GFSubClass(GUI3NoLCaseText, "GUI3NoLCaseText", Mfrm, True) End Sub Private Sub DefineGUI3ExpressionText() 'on error Resume Next 'subclassed to disable the default text pop-up menu Call GFSubClass(GUI3ExpressionText, "GUI3ExpressionText", Mfrm, True) End Sub Private Sub DefineGUI3TestText() 'on error Resume Next Call GFSubClass(GUI3TestText, "GUI3TestText", Mfrm, True) 'see also Form_Unload() Call DragAcceptFiles(GUI3TestText.hwnd, True) 'see also Form_Unload() End Sub Private Sub DefineGUIXProgressBar() 'on error rresume next Call GUIXProgressBar.Define(GUIXProgressBarPicture) End Sub Private Sub DefineGUI4ReadTrackingProgressBar() 'on error resume next Call GUI4ReadTrackingProgressBar.Define(GUI4ReadTrackingProgressBarPicture) End Sub Private Sub DefineGUI4TreeView() 'on error resume next Dim IconHandle1 As Long 'closed directory Dim IconHandle2 As Long 'opened directory 'preset IconHandle1 = GUI_GetIconHandle("GUI4TreeView1") IconHandle2 = GUI_GetIconHandle("GUI4TreeView2") 'begin Call GUI4TreeView.Create("", GUI4TreeViewPicture.hwnd, 0, 0, GUI4TreeViewPicture.ScaleWidth, GUI4TreeViewPicture.ScaleHeight, 0, Mfrm, "GUI4TreeView") Call GUI4TreeView.AddIcon(IconHandle1) Call GUI4TreeView.AddIcon(IconHandle2) End Sub Private Sub DefineGUI7ListView() 'on error Resume Next Call GUI7ListView.Create("", GUI7ListViewPicture.hwnd, 0, 0, GUI7ListViewPicture.ScaleWidth, GUI7ListViewPicture.ScaleHeight, 0, Mfrm, "GUI7ListView") Call GUI7ListView.SetStyle(LVS_SHOWSELALWAYS + LVS_NOSORTHEADER, True) 'allow multiselection Call GUI7ListView.SetStyleEx(LVS_EX_FULLROWSELECT, True) Call GUI7ListView.SetStyleCustom(STYLECUSTOM_LEFT_ALIGNMENT) Call GUI7ListView.AddIcon(GUI_GetIconHandle("GUIXListView")) Call GUI7ListView.AddIcon(GUI_GetIconHandle("GUIXListView DoubleDropped")) GUI7ListView.GridLines = True GUI7ListView.SortHeader = False Call GUI7ListView.AddColumn("Song", 75 * Screen.TwipsPerPixelX) Call GUI7ListView.AddColumn("Artist", 75 * Screen.TwipsPerPixelX) Call GUI7ListView.AddColumn("Album", 75 * Screen.TwipsPerPixelX) Call GUI7ListView.AddColumn("Year", 75 * Screen.TwipsPerPixelX) Call GUI7ListView.AddColumn("Comment", 75 * Screen.TwipsPerPixelX) Call GUI7ListView.AddColumn("Genre", 75 * Screen.TwipsPerPixelX) End Sub Private Sub DefineGUI9ListView() 'on error Resume Next Call GUI9ListView.Create("", GUI9ListViewPicture.hwnd, 0, 0, GUI9ListViewPicture.ScaleWidth, GUI9ListViewPicture.ScaleHeight, 0, Mfrm, "GUI9ListView") Call GUI9ListView.SetStyle(LVS_SHOWSELALWAYS, True) 'multi-selection allowed Call GUI9ListView.SetStyleEx(LVS_EX_FULLROWSELECT, True) Call GUI9ListView.SetStyleCustom(STYLECUSTOM_LEFT_ALIGNMENT) Call GUI9ListView.AddIcon(GUI_GetIconHandle("GUIXListView")) Call GUI9ListView.AddIcon(GUI_GetIconHandle("GUIXListView DoubleDropped")) GUI9ListView.GridLines = True GUI9ListView.SortHeader = True Call GUI9ListView.AddColumn("Song", 150 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Artist", 150 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Album", 150 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Year", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Comment", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Genre", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Composer", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Original Artist", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Publisher", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Copyright", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Conductor", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("URL", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Encoded by", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Writer", 75 * Screen.TwipsPerPixelX) Call GUI9ListView.AddColumn("Track #", 75 * Screen.TwipsPerPixelX) ' 'NOTE: as the GUI9ListView is the ONLY ListView in MP3 Renamer 2 that allows the 'user to sort the mp3 files by a definable TAG item, the GUI9ListView is the only ListView 'whose headers are clickable. ' End Sub Private Sub DefineGUI5ItemTypeCombo() 'on error Resume Next GUI5ItemTypeCombo.Clear 'reset GUI5ItemTypeCombo.AddItem GetTAGItemTypeDescription(CONST_SONGNAME) GUI5ItemTypeCombo.AddItem GetTAGItemTypeDescription(CONST_ARTISTNAME) GUI5ItemTypeCombo.TEXT = GUI5ItemTypeCombo.List(1) End Sub Private Sub DefineGUI6ItemTypeCombo() 'on error Resume Next GUI6ItemTypeCombo.Clear 'reset GUI6ItemTypeCombo.AddItem GetTAGItemTypeDescription(CONST_SONGNAME) GUI6ItemTypeCombo.AddItem GetTAGItemTypeDescription(CONST_ARTISTNAME) GUI6ItemTypeCombo.TEXT = GUI6ItemTypeCombo.List(1) End Sub Private Sub DefineGUI10TreeView() 'on error Resume Next Dim IconHandle1 As Long 'closed directory Dim IconHandle2 As Long 'opened directory 'preset IconHandle1 = GUI_GetIconHandle("GUI10TreeView1") IconHandle2 = GUI_GetIconHandle("GUI10TreeView2") 'begin Call GUI10TreeView.Create("", GUI10TreeViewPicture.hwnd, 0, 0, GUI10TreeViewPicture.ScaleWidth, GUI10TreeViewPicture.ScaleHeight, TVS_EDITLABELS, Mfrm, "GUI10TreeView") Call GUI10TreeView.AddIcon(IconHandle1) Call GUI10TreeView.AddIcon(IconHandle2) End Sub Private Sub DefineGUI10ListView() 'on error Resume Next ' 'NOTE: the GUI10ListView is not equal in appearance and function 'to the GUI[5, 6, 7, 9]ListView, but should look like the list view in user's Explorer. 'As the user might have an icon view in Explorer, 'a fixed ListView with the following columns is used: 'Filename, Size, Description, Date. ' Call GUI10ListView.Create("", GUI10ListViewPicture.hwnd, 0, 0, GUI10ListViewPicture.ScaleWidth, GUI10ListViewPicture.ScaleHeight, 0, Mfrm, "GUI10ListView") Call GUI10ListView.SetStyle(LVS_SHOWSELALWAYS + LVS_EDITLABELS, True) Call GUI10ListView.AddIcon(GUI_GetIconHandle("GUIXListView")) Call GUI10ListView.AddIcon(GUI_GetIconHandle("GUIXListView DoubleDropped")) Call GUI10ListView.AddColumn("Filename", 75 * Screen.TwipsPerPixelX) Call GUI10ListView.AddColumn("Size", 75 * Screen.TwipsPerPixelX) Call GUI10ListView.AddColumn("Description", 75 * Screen.TwipsPerPixelX) Call GUI10ListView.AddColumn("Changed at", 75 * Screen.TwipsPerPixelX) GUI10ListView.GridLines = False GUI10ListView.SortHeader = False End Sub Private Sub DefineGUI1CopyDirList() 'on error Resume Next Call GFSubClass(GUI1CopyDirList, "GUI1CopyDirList", Mfrm, True) 'see also Form_Unload() Call DragAcceptFiles(GUI1CopyDirList.hwnd, True) 'see also Form_Unload() End Sub Private Sub DefineGUI1MoveDirList() 'on error Resume Next Call GFSubClass(GUI1MoveDirList, "GUI1MoveDirList", Mfrm, True) 'see also Form_Unload() Call DragAcceptFiles(GUI1MoveDirList.hwnd, True) 'see also Form_Unload() End Sub Private Sub DefineGUI9RecoverFileText() 'on error Resume Next Call GFSubClass(GUI9RecoverFileText, "GUI9RecoverFileText", Mfrm, True) 'see also Form_Unload() Call DragAcceptFiles(GUI9RecoverFileText.hwnd, True) 'see also Form_Unload() End Sub Private Sub DefineSGSystem() 'on error resume next Load SGfrm 'important Call SGfrm.SG_ReceiveSGFile(STUFF_PROGRAMDIRECTORY + "SGFile.dat") Call SGfrm.SG_ReceiveSGBackUpFile(STUFF_PROGRAMDIRECTORY + "SGFileBackUp.dat") Call SGfrm.SGBackUp_Delete 'see annotations for SGBackUp system End Sub Private Sub DefineGFCCDDSystem() 'on error resume next 'sets up the GFCCDD (CommCtrlDragDrop) system ' Call GFCCDD_Initialize(Mfrm, True) ' Call GFCCDD_RegisterControl("GUI1CopyDirList", GUI1CopyDirList, GFCCDD_CONTROLTYPE_LISTBOX) Call GFCCDD_RegisterControl("GUI1MoveDirList", GUI1MoveDirList, GFCCDD_CONTROLTYPE_LISTBOX) Call GFCCDD_RegisterControl("GUI10TreeViewPicture", GUI10TreeViewPicture, GFCCDD_CONTROLTYPE_OTHER) Call GFCCDD_RegisterControl("GUI10TreeView", GUI10TreeView, GFCCDD_CONTROLTYPE_GFTREEVIEW) Call GFCCDD_RegisterControl("GUI10ListViewPicture", GUI10ListViewPicture, GFCCDD_CONTROLTYPE_OTHER) Call GFCCDD_RegisterControl("GUI10ListView", GUI10ListView, GFCCDD_CONTROLTYPE_GFREPORTVIEW) Call GFCCDD_RegisterControl("Mfrm", Mfrm, GFCCDD_CONTROLTYPE_OTHER) Call GFCCDD_RegisterControl("GUI5DefaultList", GUI5DefaultList, GFCCDD_CONTROLTYPE_LISTBOX) Call GFCCDD_RegisterControl("GUI6DefaultList", GUI6DefaultList, GFCCDD_CONTROLTYPE_LISTBOX) Call GFCCDD_RegisterControl("GUIXItemList", GUIXItemList, GFCCDD_CONTROLTYPE_LISTBOX) Call GFCCDD_RegisterControl("QPfrm.QPList", QPfrm.QPList, GFCCDD_CONTROLTYPE_LISTBOX) Call GFCCDD_RegisterControl("GFTextMarkerPicture", GFTextMarkerPicture, GFCCDD_CONTROLTYPE_PICTUREBOX) Call GFCCDD_RegisterControl("GUI3TestText", GUI3TestText, GFCCDD_CONTROLTYPE_TEXTBOX) Call GFCCDD_RegisterControl("GUI9RecoverFileText", GUI9RecoverFileText, GFCCDD_CONTROLTYPE_TEXTBOX) Call GFCCDD_RegisterControl("GFStartStationCommandFixed(1)", GFStartStationCommand(1), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandFixed(2)", GFStartStationCommand(2), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandFixed(3)", GFStartStationCommand(3), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandFixed(4)", GFStartStationCommand(4), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandFixed(5)", GFStartStationCommand(5), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandMovable(1)", GFStartStationCommand(1), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandMovable(2)", GFStartStationCommand(2), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandMovable(3)", GFStartStationCommand(3), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandMovable(4)", GFStartStationCommand(4), SECONTROLTYPE_SECOMMAND) Call GFCCDD_RegisterControl("GFStartStationCommandMovable(5)", GFStartStationCommand(5), SECONTROLTYPE_SECOMMAND) ' Call GFCCDD_Enable ' End Sub Private Sub DefineGFCompressionSystem() 'on error resume next Call GFCompression_CallBackForm_Enable(Mfrm) End Sub Private Sub DefineGFWindowStickSystem() 'on error resume next ' 'NOTE: Mfrm is the 'master window', all other forms can be docked 'at this form. If the master window is moved, the slave windows will move, too. ' With GFWindowStickfrm Call .GFWindowStick_Initialize(RegMainKey, RegRootKey, "Mfrm", Mfrm) Call .GFWindowStick_AddWindow("Mfrm", Mfrm) Call .GFWindowStick_AddWindow("QPfrm", QPfrm) Call .GFWindowStick_AddWindow("TAGfrm", TAGfrm) Call .GFWindowStick_AddWindow("LWCfrm", LWCfrm) End With End Sub Private Sub DefineWindowFadeSystem() 'on error resume next Call WindowFadeFromReg(WindowFadeStructVar) End Sub Private Sub DefineSkinEngine() 'on error Resume Next Dim FontStructVar As FontStruct 'preset ' FontStructVar.Name = "Arial" FontStructVar.Size = 8 ' Call SE_Initialize(RGB(255, 255, 255), 0, FontStructVar, "", True, ProgramFilesStructVar.ProgramPath + "SKINS\", RegMainKey, RegRootKey, ProgramContextHelpCommand, ProgramFilesStructVar.ContextHelpFile) Call SECB_AddCallBackForm(Mfrm) Call SEPE_HideControl_AddItem("Loginfrm") 'do not allow user to edit Loginfrm's properties Call SEPE_HideControl_AddItem("PolyRgn37") 'do not allow user to edit Loginfrm's poly rgn Call SEFormSystem_Initialize(False, False, False, False, False, True) ReDim FormNameArray(1 To 2) As String FormNameArray(1) = "Mfrm_9" FormNameArray(2) = "Mfrm_10" Call SEFormSystem_AddFormPosGroup(2, FormNameArray()) ReDim FormNameArray(1 To 10) As String FormNameArray(1) = "Mfrm_1" FormNameArray(2) = "Mfrm_2" FormNameArray(3) = "Mfrm_3" FormNameArray(4) = "Mfrm_4" FormNameArray(5) = "Mfrm_5" FormNameArray(6) = "Mfrm_6" FormNameArray(7) = "Mfrm_7" FormNameArray(8) = "Mfrm_8" FormNameArray(9) = "Mfrm_11" FormNameArray(10) = "Mfrm_12" Call SEFormSystem_AddFormPosGroup(10, FormNameArray()) ReDim FormNameArray(1 To 2) As String FormNameArray(1) = "Mfrm_9" FormNameArray(2) = "Mfrm_10" Call SEFormSystem_AddFormSizeGroup(2, FormNameArray()) ' ReDim FormNameArray(1 To 10) As String ' FormNameArray(1) = "Mfrm_1" 'the form pos group was disabled ' FormNameArray(2) = "Mfrm_2" '(although worked failure-free) ' FormNameArray(3) = "Mfrm_3" 'because it makes sense to use different ' FormNameArray(4) = "Mfrm_4" 'form sizes for different steps ' FormNameArray(5) = "Mfrm_5" '(for instance, in step 2 there are much more ' FormNameArray(6) = "Mfrm_6" 'controls on the form than in step 11 or 12) ' FormNameArray(7) = "Mfrm_7" ' FormNameArray(8) = "Mfrm_8" ' FormNameArray(9) = "Mfrm_11" ' FormNameArray(10) = "Mfrm_12" ' Call SEFormSystem_AddFormSizeGroup(10, FormNameArray()) ' 'NOTE: only the Mfrm code resizes Mfrm, except when the UserMove system is enabled. 'Only the Skin Engine moves Mfrm, if UserMove is enabled then only through the title bar. ' 'begin ' 'NOTE: call this sub before using SE_GetSystemColor(). ' Call SE_RegisterControl("Skin Engine system settings", Nothing, SECONTROLTYPE_PSEUDOCONTROL) ' Call SE_RegisterControl("ProgramSystemMenuCommand", ProgramSystemMenuCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("ProgramMenuCommand", ProgramMenuCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("ProgramSkinEngineCommand", ProgramSkinEngineCommand, SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("ProgramContextHelpCommandFixed", ProgramContextHelpCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("ProgramMinimizeCommandFixed", ProgramMinimizeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("ProgramCloseCommandFixed", ProgramCloseCommand, SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("ProgramContextHelpCommandMovable", ProgramContextHelpCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("ProgramMinimizeCommandMovable", ProgramMinimizeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("ProgramMaximizeCommandMovable", ProgramMaximizeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("ProgramRestoreCommandMovable", ProgramRestoreCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("ProgramCloseCommandMovable", ProgramCloseCommand, SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("CSETfrm", CSETfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("PolyRgn35", CSETfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("CSETfrm.ConfigSetList", CSETfrm.ConfigSetList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("CSETfrm.ConfigSetNewCommand", CSETfrm.ConfigSetNewCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("CSETfrm.ConfigSetDeleteCommand", CSETfrm.ConfigSetDeleteCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("CSETfrm.ConfigSetRenameCommand", CSETfrm.ConfigSetRenameCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("CSETfrm.ConfigSetCloseCommand", CSETfrm.ConfigSetCloseCommand, SECONTROLTYPE_SECOMMAND) ' 'NOTE: Mfrm is registered as a 'pool control' to allow changing its 'back picture together with the se control palettes. 'The GUI?AnimationControlPicture is also used as 'pool control', as well as 'the GUI?ProgressLabel. 'Note that the GUI?ProgressLabel is mostly displayed together with the 'GUI?AnimationControlPicture. 'Additional pool objects are GUI?ProgressBarPicture, GUI?ColorSliderPicture 'and GUI?ColorSliderLegendPicture. ' Call SE_RegisterControl("Mfrm_0", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_1", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_2", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_3", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_4", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_5", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_6", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_7", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_8", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_9", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_10", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_11", Mfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("Mfrm_12", Mfrm, SECONTROLTYPE_FORM) ' Call SE_RegisterControl("PolyRgn0", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn1", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn2", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn3", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn4", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn5", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn6", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn7", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn8", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn9", Mfrm, SECONTROLTYPE_SEPOLYRGN) 'attention: Mfrm can be resized Call SE_RegisterControl("PolyRgn10", Mfrm, SECONTROLTYPE_SEPOLYRGN) 'attention: Mfrm can be resized Call SE_RegisterControl("PolyRgn11", Mfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("PolyRgn12", Mfrm, SECONTROLTYPE_SEPOLYRGN) ' Call SE_RegisterControl("Statistics1LabelFixed", Statistics1Label, SECONTROLTYPE_LABEL) Call SE_RegisterControl("Statistics1LabelMovable", Statistics1Label, SECONTROLTYPE_LABEL) Call SE_RegisterControl("StepLabelFixed", StepLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("StepLabelMovable", StepLabel, SECONTROLTYPE_LABEL) ' Call SE_RegisterControl("Loginfrm", Loginfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("PolyRgn37", Loginfrm, SECONTROLTYPE_SEPOLYRGN) ' Call SE_RegisterControl("TAGfrm", TAGfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("PolyRgn32", TAGfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("TAGfrm.TAGMinimizeCommand", TAGfrm.TAGMinimizeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("TAGfrm.TAGCloseCommand", TAGfrm.TAGCloseCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("TAGfrm.TAGSaveWithAutoChangeCommand", TAGfrm.TAGSaveWithAutoChangeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("TAGfrm.TAGSaveSansAutoChangeCommand", TAGfrm.TAGSaveSansAutoChangeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("TAGfrm.TAGCancelAndCloseCommand", TAGfrm.TAGCancelAndCloseCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("TAGfrm.TAGUpCommand", TAGfrm.TAGUpCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("TAGfrm.TAGDownCommand", TAGfrm.TAGDownCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("TAGfrm.TAGChangeCommand", TAGfrm.TAGChangeCommand, SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("TAGfrm.TAGSongNameText", TAGfrm.TAGSongNameText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGArtistNameText", TAGfrm.TAGArtistNameText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGAlbumNameText", TAGfrm.TAGAlbumNameText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGYearNameText", TAGfrm.TAGYearNameText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGCommentText", TAGfrm.TAGCommentText, SECONTROLTYPE_TEXTBOX) ' Call SE_RegisterControl("TAGfrm.TAGSongNameOldText", TAGfrm.TAGSongNameOldText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGArtistNameOldText", TAGfrm.TAGArtistNameOldText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGAlbumNameOldText", TAGfrm.TAGAlbumNameOldText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGYearNameOldText", TAGfrm.TAGYearNameOldText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGCommentOldText", TAGfrm.TAGCommentOldText, SECONTROLTYPE_TEXTBOX) ' Call SE_RegisterControl("TAGfrm.TAGListViewPicture", TAGfrm.TAGListViewPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("TAGfrm.TAGListView", Mmod.TAGListView, SECONTROLTYPE_GFLISTVIEW) ' Call SE_RegisterControl("TAGfrm.TAGSongLabel", TAGfrm.TAGSongLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGArtistLabel", TAGfrm.TAGArtistLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGAlbumLabel", TAGfrm.TAGAlbumLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGYearLabel", TAGfrm.TAGYearLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGChangePreviewList", TAGfrm.TAGChangePreviewList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("TAGfrm.TAGCommentLabel", TAGfrm.TAGCommentLabel, SECONTROLTYPE_LABEL) ' Call SE_RegisterControl("TAGfrm.TAGFileInfoOption", TAGfrm.TAGFileInfoOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("TAGfrm.TAGAutoChangeOption", TAGfrm.TAGAutoChangeOption, SECONTROLTYPE_OPTIONBUTTON) ' Call SE_RegisterControl("TAGfrm.TAGFileNameOldText", TAGfrm.TAGFileNameOldText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGFileNameNewText", TAGfrm.TAGFileNameNewText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("TAGfrm.TAGFileInfoText", TAGfrm.TAGFileInfoText, SECONTROLTYPE_TEXTBOX) ' Call SE_RegisterControl("TAGfrm.TAGFileNameOldLabel", TAGfrm.TAGFileNameOldLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGFileNameNewLabel", TAGfrm.TAGFileNameNewLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGFileInfoLabel", TAGfrm.TAGFileInfoLabel, SECONTROLTYPE_LABEL) ' Call SE_RegisterControl("TAGfrm.TAGPlayCommand", TAGfrm.TAGPlayCommand, SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("TAGfrm.TAGChangePreviewLabel", TAGfrm.TAGChangePreviewLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGOldTAGInfoLabel", TAGfrm.TAGOldTAGInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGNewTAGInfoLabel", TAGfrm.TAGNewTAGInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGOldIsNewInfoLabel", TAGfrm.TAGOldIsNewInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGDoubleDroppedInfoLabel", TAGfrm.TAGDoubleDroppedInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGCopyOrMoveInfoLabel", TAGfrm.TAGCopyOrMoveInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("TAGfrm.TAGContextHelpCommand", TAGfrm.TAGContextHelpCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("TAGfrm.TAGSystemMenuCommand", TAGfrm.TAGSystemMenuCommand, SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("QPfrm", QPfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("PolyRgn33", QPfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("QPfrm.QPSystemMenuCommand", QPfrm.QPSystemMenuCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("QPfrm.QPMinimizeCommand", QPfrm.QPMinimizeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("QPfrm.QPCloseCommand", QPfrm.QPCloseCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("QPfrm.QPList", QPfrm.QPList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("QPfrm.QPInfoLabel", QPfrm.QPInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("QPfrm.QPRandomPlayCommand", QPfrm.QPRandomPlayCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("QPfrm.QPPlayMarkedCommand", QPfrm.QPPlayMarkedCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("QPfrm.QPCloseCommand2", QPfrm.QPCloseCommand2, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("QPfrm.QPCancelCommand", QPfrm.QPCancelCommand, SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("GFContextHelpfrm", GFContextHelpfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("GFContextHelpfrm.ContextHelpPicture", GFContextHelpfrm.ContextHelpPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GFContextHelpfrm.ContextHelpHeaderPicture", GFContextHelpfrm.ContextHelpHeaderPicture, SECONTROLTYPE_PICTUREBOX) ' Call SE_RegisterControl("GUICancelCommandFixed", GUICancelCommand, SECONTROLTYPE_SECOMMAND) 'no movable version existing ' 'NOTE: the GUI[Next/Back]Command is registered as a pool control, 'as in all steps except 9 and 10 these commands cannot be moved, 'what led to errors when resizing the parent form in steps except 9 and 10. ' Call SE_RegisterControl("GUIBackCommandFixed", GUIBackCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUINextCommandFixed", GUINextCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUIBackCommandMovable", GUIBackCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUINextCommandMovable", GUINextCommand, SECONTROLTYPE_SECOMMAND) ' 'OLD SKIN SUPPORT (for SkinDataFiles of v1.0) (does not really work) 'Call SE_RegisterControl("GFStartStationCommand(1)", GFStartStationCommand(1), SECONTROLTYPE_SECOMMAND) 'Call SE_RegisterControl("GFStartStationCommand(2)", GFStartStationCommand(2), SECONTROLTYPE_SECOMMAND) 'Call SE_RegisterControl("GFStartStationCommand(3)", GFStartStationCommand(3), SECONTROLTYPE_SECOMMAND) 'Call SE_RegisterControl("GFStartStationCommand(4)", GFStartStationCommand(4), SECONTROLTYPE_SECOMMAND) 'Call SE_RegisterControl("GFStartStationCommand(5)", GFStartStationCommand(5), SECONTROLTYPE_SECOMMAND) 'END OF OLD SKIN SUPPORT Call SE_RegisterControl("GFStartStationCommandFixed(1)", GFStartStationCommand(1), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandFixed(2)", GFStartStationCommand(2), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandFixed(3)", GFStartStationCommand(3), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandFixed(4)", GFStartStationCommand(4), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandFixed(5)", GFStartStationCommand(5), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandMovable(1)", GFStartStationCommand(1), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandMovable(2)", GFStartStationCommand(2), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandMovable(3)", GFStartStationCommand(3), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandMovable(4)", GFStartStationCommand(4), SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GFStartStationCommandMovable(5)", GFStartStationCommand(5), SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("GUI1AddCommand", GUI1AddCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI1ScanCommand", GUI1ScanCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI1MegaScanCommand", GUI1MegaScanCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI1CopyDirLabel", GUI1CopyDirLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI1CopyDirList", GUI1CopyDirList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("GUI1CopyDirInfoLabel", GUI1CopyDirInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI1MoveDirLabel", GUI1MoveDirLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI1MoveDirList", GUI1MoveDirList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("GUI1MoveDirInfoLabel", GUI1MoveDirInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI1CopySpaceRequiredLabel", GUI1CopySpaceRequiredLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI1ConfigSetCommand", GUI1ConfigSetCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI1ConfigSetNameLabel", GUIXConfigSetNameLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI1ProgressLabel", GUIXProgressLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI1AnimationControlPicture", GUIXAnimationControlPicture, SECONTROLTYPE_PICTUREBOX) ' Call SE_RegisterControl("GFTextMarkerPicture", GFTextMarkerPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GFTextMarkerLegendPicture", GFTextMarkerLegendPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI2AddCommand", GUI2AddCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI2ChangeCommand", GUI2ChangeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI2DeleteCommand", GUI2DeleteCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI2TAGInfoCommand", GUI2TAGInfoCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI2OkCommand", GUI2OkCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI2TestCommand", GUI2TestCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI2FilterList", GUI2FilterList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("GUI2SongNameStartStringText", GUI2SongNameStartStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2SongNameEndStringText", GUI2SongNameEndStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2ArtistNameStartStringText", GUI2ArtistNameStartStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2ArtistNameEndStringText", GUI2ArtistNameEndStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2AlbumNameStartStringText", GUI2AlbumNameStartStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2AlbumNameEndStringText", GUI2AlbumNameEndStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2YearNameStartStringText", GUI2YearNameStartStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2YearNameEndStringText", GUI2YearNameEndStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2CommentStartStringText", GUI2CommentStartStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2CommentEndStringText", GUI2CommentEndStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2TrashStartStringText", GUI2TrashStartStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2TrashEndStringText", GUI2TrashEndStringText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI2SongStartStringLabel", GUI2SongStartStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2SongEndStringLabel", GUI2SongEndStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2ArtistStartStringLabel", GUI2ArtistStartStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2ArtistEndStringLabel", GUI2ArtistEndStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2AlbumStartStringLabel", GUI2AlbumStartStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2AlbumEndStringLabel", GUI2AlbumEndStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2YearStartStringLabel", GUI2YearStartStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2YearEndStringLabel", GUI2YearEndStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2CommentStartStringLabel", GUI2CommentStartStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2CommentEndStringLabel", GUI2CommentEndStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2TrashStartStringLabel", GUI2TrashStartStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2TrashEndStringLabel", GUI2TrashEndStringLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI2ConfigSetCommand", GUI2ConfigSetCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI2ConfigSetNameLabel", GUIXConfigSetNameLabel, SECONTROLTYPE_LABEL) ' Call SE_RegisterControl("GUI3CutCharText", GUI3CutCharText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI3ReplaceCharText", GUI3ReplaceCharText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI3NoUCaseText", GUI3NoUCaseText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI3NoLCaseText", GUI3NoLCaseText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI3ExpressionText", GUI3ExpressionText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI3TestText", GUI3TestText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI3CutLabel", GUI3CutLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI3ReplaceLabel", GUI3ReplaceLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI3NonCapitalLabel", GUI3NonCapitalLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI3CapitalLabel", GUI3CapitalLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI3ExpressionLabel", GUI3ExpressionLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI3CutCharDefaultCommand", GUI3CutCharDefaultCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI3HTMLCommand", GUI3HTMLCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI3NoUCaseDefaultCommand", GUI3NoUCaseDefaultCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI3NoLCaseDefaultCommand", GUI3NoLCaseDefaultCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI3ExpressionDefaultCommand", GUI3ExpressionDefaultCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI3ConfigSetCommand", GUI3ConfigSetCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI3ConfigSetNameLabel", GUIXConfigSetNameLabel, SECONTROLTYPE_LABEL) ' Call SE_RegisterControl("GUI4ReadCommand", GUI4ReadCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI4ReadNewCommand", GUI4ReadNewCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI4ReadAllCommand", GUI4ReadAllCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI4PauseCommand", GUI4PauseCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI4ResumeCommand", GUI4ResumeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI4ShowReadDirCommand", GUI4ShowReadDirCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI4TreeViewPicture", GUI4TreeViewPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI4TreeView", GUI4TreeView, SECONTROLTYPE_GFTREEVIEW) Call SE_RegisterControl("GUI4TreeViewInfoLabel", GUI4TreeViewInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI4ReadTrackingEnabledCheck", GUI4ReadTrackingEnabledCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI4ReadTrackingProgressBarPicture", GUI4ReadTrackingProgressBarPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI4ReadTrackingDirectoryLabel", GUI4ReadTrackingDirectoryLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI4ProgressLabel", GUIXProgressLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI4ProgressBarPicture", GUIXProgressBarPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI4ColorSliderPicture", GUIXColorSliderPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI4ColorSliderLegendPicture", GUIXColorSliderLegendPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI4ColorSliderNextPaletteCommand", GUIXColorSliderNextPaletteCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI4ColorSliderPreviousPaletteCommand", GUIXColorSliderPreviousPaletteCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI4AnimationControlPicture", GUIXAnimationControlPicture, SECONTROLTYPE_PICTUREBOX) ' Call SE_RegisterControl("GUI5CheckCommand", GUI5CheckCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI5UseNewOption", GUI5UseNewOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI5UseDefaultOption", GUI5UseDefaultOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI5NewText", GUI5NewText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI5DefaultList", GUI5DefaultList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("GUI5NextCommand", GUI5NextCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI5ChangeCommand", GUI5ChangeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI5IgnoreCommand", GUI5IgnoreCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI5PreviousCommand", GUI5PreviousCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI5ItemTypeCombo", GUI5ItemTypeCombo, SECONTROLTYPE_COMBOBOX) Call SE_RegisterControl("GUI5ItemList", GUIXItemList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("GUI5ItemListLabel", GUIXItemListLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI5FaultyTagItemsLabel", GUI5FaultyTagItemsLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI5AllTagItemsLabel", GUI5AllTagItemsLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI5ProgressLabel", GUIXProgressLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI5AnimationControlPicture", GUIXAnimationControlPicture, SECONTROLTYPE_PICTUREBOX) ' Call SE_RegisterControl("GUI6CheckCommand", GUI6CheckCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI6UseNewOption", GUI6UseNewOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI6UseDefaultOption", GUI6UseDefaultOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI6NewText", GUI6NewText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI6DefaultList", GUI6DefaultList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("GUI6NextCommand", GUI6NextCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI6ChangeCommand", GUI6ChangeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI6IgnoreCommand", GUI6IgnoreCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI6PreviousCommand", GUI6PreviousCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI6ItemTypeCombo", GUI6ItemTypeCombo, SECONTROLTYPE_COMBOBOX) Call SE_RegisterControl("GUI6ItemList", GUIXItemList, SECONTROLTYPE_LISTBOX) Call SE_RegisterControl("GUI6ItemListLabel", GUIXItemListLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI6FaultyTagItemsLabel", GUI6FaultyTagItemsLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI6AllTagItemsLabel", GUI6AllTagItemsLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI6ProgressLabel", GUIXProgressLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI6AnimationControlPicture", GUIXAnimationControlPicture, SECONTROLTYPE_PICTUREBOX) ' Call SE_RegisterControl("GUI7CheckCommand", GUI7CheckCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI7ListViewPicture", GUI7ListViewPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI7ListView", GUI7ListView, SECONTROLTYPE_GFLISTVIEW) Call SE_RegisterControl("GUI7SwappedCommand", GUI7SwappedCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI7PreviousCommand", GUI7PreviousCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI7OkCommand", GUI7OkCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI7NextCommand", GUI7NextCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI7SongNameErrorCommand", GUI7SongNameErrorCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI7ArtistNameErrorCommand", GUI7ArtistNameErrorCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI7ErrorItemLabel", GUI7ErrorItemLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI7ProgressLabel", GUIXProgressLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI7AnimationControlPicture", GUIXAnimationControlPicture, SECONTROLTYPE_PICTUREBOX) ' Call SE_RegisterControl("GUI8CreateNewFileNamesCommand", GUI8CreateNewFileNamesCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI8FileFormatText", GUI8FileFormatText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI8DirFormatText", GUI8DirFormatText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI8FileFormatLabel", GUI8FileFormatLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI8DirFormatLabel", GUI8DirFormatLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI8FileFormatDefaultCommand", GUI8FileFormatDefaultCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI8DirFormatDefaultCommand", GUI8DirFormatDefaultCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI8DeleteEmptySourceFoldersCheck", GUI8DeleteEmptySourceFoldersCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI8LogFileEnabledCheck", GUI8LogFileEnabledCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI8RetainAllFileNamesCheck", GUI8RetainAllFileNamesCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI8RetainLongFileNamesCheck", GUI8RetainLongFileNamesCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI8FormatRetainedFileNamesCheck", GUI8FormatRetainedFileNamesCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI8WriteTAGsCheck", GUI8WriteTAGsCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI8DoubledFilesLabel", GUI8DoubledFilesLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI8DoubledFilesPicture", GUI8DoubledFilesPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI8NumerateOption", GUI8NumerateOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI8OverwriteOption", GUI8OverwriteOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI8ProgressLabel", GUIXProgressLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI8ProgressBarPicture", GUIXProgressBarPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI8ConfigSetCommand", GUI8ConfigSetCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI8ConfigSetNameLabel", GUIXConfigSetNameLabel, SECONTROLTYPE_LABEL) ' Call SE_RegisterControl("PolyRgn34", LWCfrm, SECONTROLTYPE_SEPOLYRGN) Call SE_RegisterControl("LWCfrm", LWCfrm, SECONTROLTYPE_FORM) Call SE_RegisterControl("LWCfrm.LWCSearchNextCommand", LWCfrm.LWCSearchNextCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCSearchAllCommand", LWCfrm.LWCSearchAllCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCSelectAllCommand", LWCfrm.LWCSelectAllCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCSelectNoneCommand", LWCfrm.LWCSelectNoneCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCSelectionToTopCommand", LWCfrm.LWCSelectionToTopCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCSearchTypeCombo", LWCfrm.LWCSearchTypeCombo, SECONTROLTYPE_COMBOBOX) Call SE_RegisterControl("LWCfrm.LWCSearchCombo", LWCfrm.LWCSearchCombo, SECONTROLTYPE_COMBOBOX) Call SE_RegisterControl("LWCfrm.LWCSearchSpecialCombo", LWCfrm.LWCSearchSpecialCombo, SECONTROLTYPE_COMBOBOX) Call SE_RegisterControl("LWCfrm.LWCSearchStringCombo", LWCfrm.LWCSearchStringCombo, SECONTROLTYPE_COMBOBOX) Call SE_RegisterControl("LWCfrm.LWCSetCommand", LWCfrm.LWCSetCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCSetCombo", LWCfrm.LWCSetCombo, SECONTROLTYPE_COMBOBOX) Call SE_RegisterControl("LWCfrm.LWCSetStringCombo", LWCfrm.LWCSetStringCombo, SECONTROLTYPE_COMBOBOX) Call SE_RegisterControl("LWCfrm.LWCChangeLabel", LWCfrm.LWCChangeLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("LWCfrm.LWCInLabel", LWCfrm.LWCInLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("LWCfrm.LWCInSelectionToLabel", LWCfrm.LWCInSelectionToLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("LWCfrm.LWCHelpTextLabel", LWCfrm.LWCHelpTextLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("LWCfrm.LWCSelectionInfoLabel", LWCfrm.LWCSelectionInfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("LWCfrm.LWCRemove2DigitNumberCommand", LWCfrm.LWCRemove2DigitNumberCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCRemoveMP3ExtensionCommand", LWCfrm.LWCRemoveMP3ExtensionCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCRemoveFileNumerationCommand", LWCfrm.LWCRemoveFileNumerationCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCTabString", Mmod.LWCTabString, SECONTROLTYPE_GFTABSTRING) Call SE_RegisterControl("LWCfrm.LWCSystemMenuCommand", LWCfrm.LWCSystemMenuCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCMinimizeCommand", LWCfrm.LWCMinimizeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCCloseCommand", LWCfrm.LWCCloseCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCScrollUpCommand", LWCfrm.LWCScrollUpFrame, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCScrollDownCommand", LWCfrm.LWCScrollDownFrame, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCScrollLeftCommand", LWCfrm.LWCScrollLeftFrame, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("LWCfrm.LWCScrollRightCommand", LWCfrm.LWCScrollRightFrame, SECONTROLTYPE_SECOMMAND) ' Call SE_RegisterControl("GUI9ToolsCommand", GUI9ToolsCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI9RecoverFileText", GUI9RecoverFileText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI9ListViewPicture", GUI9ListViewPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI9ListView", GUI9ListView, SECONTROLTYPE_GFLISTVIEW) ' Call SE_RegisterControl("GUI10InfoLabel", GUI10InfoLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI10TreeViewPicture", GUI10TreeViewPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI10TreeView", GUI10TreeView, SECONTROLTYPE_GFTREEVIEW) Call SE_RegisterControl("GUI10ListViewPicture", GUI10ListViewPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI10ListView", GUI10ListView, SECONTROLTYPE_GFLISTVIEW) Call SE_RegisterControl("GUI10ListViewDirLabel", GUI10ListViewDirLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI10SizeChangePicture", GUI10SizeChangePicture, SECONTROLTYPE_PICTUREBOX) ' Call SE_RegisterControl("GUI11RenameCommand", GUI11RenameCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI11PauseCommand", GUI11PauseCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI11ResumeCommand", GUI11ResumeCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI11ExistingFilesLabel", GUI11ExistingFilesLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI11ExistingFilesPicture", GUI11ExistingFilesPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI11ExistingFilesOverwriteOption", GUI11ExistingFilesOverwriteOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI11ExistingFilesFlushOption", GUI11ExistingFilesFlushOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI11ExistingFilesRetainOption", GUI11ExistingFilesRetainOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI11ExistingFilesAskOption", GUI11ExistingFilesAskOption, SECONTROLTYPE_OPTIONBUTTON) Call SE_RegisterControl("GUI11TimePassedLabel", GUI11TimePassedLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI11TimeRemainingLabel", GUI11TimeRemainingLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI11ProcessedLabel", GUI11ProcessedLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI11ColorSliderPicture", GUIXColorSliderPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI11ColorSliderLegendPicture", GUIXColorSliderLegendPicture, SECONTROLTYPE_PICTUREBOX) Call SE_RegisterControl("GUI11ColorSliderNextPaletteCommand", GUIXColorSliderNextPaletteCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI11ColorSliderPreviousPaletteCommand", GUIXColorSliderPreviousPaletteCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI11ProgressLabel", GUIXProgressLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI11AnimationControlPicture", GUIXAnimationControlPicture, SECONTROLTYPE_PICTUREBOX) ' Call SE_RegisterControl("GUI12InfoCommand", GUI12InfoCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI12CreateCommand", GUI12CreateCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI12BrowseCommand", GUI12BrowseCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI12ViewCommand", GUI12ViewCommand, SECONTROLTYPE_SECOMMAND) Call SE_RegisterControl("GUI12ListHeadLineLabel", GUI12ListHeadLineLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI12ListHelpTextLabel", GUI12ListHelpTextLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI12AuthorLabel", GUI12AuthorLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI12AuthorText", GUI12AuthorText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI12CommentLabel", GUI12CommentLabel, SECONTROLTYPE_LABEL) Call SE_RegisterControl("GUI12CommentText", GUI12CommentText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI12IncludeDescriptionCheck", GUI12IncludeDescriptionCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI12IncludeDateCheck", GUI12IncludeDateCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI12IncludeNewFileNamesCheck", GUI12IncludeNewFileNamesCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI12IncludeOldFileNamesCheck", GUI12IncludeOldFileNamesCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI12IncludeTAGCheck", GUI12IncludeTAGCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI12IncludeFileSizeCheck", GUI12IncludeFileSizeCheck, SECONTROLTYPE_CHECKBOX) Call SE_RegisterControl("GUI12MP3ListFileText", GUI12MP3ListFileText, SECONTROLTYPE_TEXTBOX) Call SE_RegisterControl("GUI12FinishedCommand", GUI12FinishedCommand, SECONTROLTYPE_SECOMMAND) ' Call Skin_Preload End Sub Private Sub UpdateSkin() 'to be called by GFPMS via message "call UpdateSkin" 'on error resume next 'call to verify controls that were not existing in previous program versions are existing now Dim SEControlStructIndex As Integer Dim ReloadFlag As Boolean 'begin ReloadFlag = False 'reset If (SkinDataFile_CreateDomain(SE_GetSkinDataFile, "GUI8RetainAllFileNamesCheck", 8)) Then ReloadFlag = True If (SkinDataFile_CreateDomain(SE_GetSkinDataFile, "GUI8RetainLongFileNamesCheck", 8)) Then ReloadFlag = True If (SkinDataFile_CreateDomain(SE_GetSkinDataFile, "GUI8FormatRetainedFileNamesCheck", 8)) Then ReloadFlag = True If (SkinDataFile_CreateDomain(SE_GetSkinDataFile, "GUI8WriteTAGsCheck", 8)) Then ReloadFlag = True If (ReloadFlag) Then Call SE_DisplayPalette(GUICStructVar.GUIPaletteNumberOld, GUICStructVar.GUIPaletteNumberCurrent, True, True, False, False) 'ForceSkinDataFileReloadingFlag = False, or errors, no button redrawing and no control frames SEControlStructIndex = GetSEControlStructIndex("GUI8RetainAllFileNamesCheck") Call SetSEControlXPos(SEControlStructIndex, 0, 0, False) Call SetSEControlYPos(SEControlStructIndex, 0, 0, False) Call SaveSEControlPos(SEControlStructIndex, 0, 0, 0, 0, False, False) Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, "GUI8RetainAllFileNamesCheck", "tooltiptext", "enable to make Toricxs re-use the old file names, if you think they are better") SEControlStructIndex = GetSEControlStructIndex("GUI8RetainLongFileNamesCheck") Call SetSEControlXPos(SEControlStructIndex, 0, 0, False) Call SetSEControlYPos(SEControlStructIndex, 20, 0, False) Call SaveSEControlPos(SEControlStructIndex, 0, 20, 0, 0, False, False) Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, "GUI8RetainLongFileNamesCheck", "tooltiptext", "enable to make Toricxs re-use the old file name if the one created by Toricxs would be shortened") SEControlStructIndex = GetSEControlStructIndex("GUI8FormatRetainedFileNamesCheck") Call SetSEControlXPos(SEControlStructIndex, 0, 0, False) Call SetSEControlYPos(SEControlStructIndex, 40, 0, False) Call SaveSEControlPos(SEControlStructIndex, 0, 40, 0, 0, False, False) Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, "GUI8FormatRetainedFileNamesCheck", "tooltiptext", "makes Toricxs capitalize retained file names (like TAGs, see step 3)") SEControlStructIndex = GetSEControlStructIndex("GUI8WriteTAGsCheck") Call SetSEControlXPos(SEControlStructIndex, 0, 0, False) Call SetSEControlYPos(SEControlStructIndex, 60, 0, False) Call SaveSEControlPos(SEControlStructIndex, 0, 60, 0, 0, False, False) Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, "GUI8WriteTAGsCheck", "tooltiptext", "Disable to retain the old TAG. Additionally enable file name retaining to move/copy files to new directories without altering the files.") End If End Sub Public Sub DefineLogoLine() 'also used by Pmod 'on error resume next Call Loginfrm.LogoLine_Initialize(RGB(255, 255, 255), 0, "Ms Sans Serif", 8, False, False, False, False) End Sub Public Sub DefineContextHelp() 'also used by Pmod 'on error resume next Dim SEControlStructIndex As Integer ' 'NOTE: if the GFContextHelp system cannot find a help text for a special control, 'the help text of the control [default] will be displayed (see ContextHelp.dat). ' 'As the context help is partially handled by the Skin Engine it is possible to 'copy the control names from a SkinDataFile '(then all property lines must be replaced through a control-specific help text). ' 'NOTE: this sub is called EVERY TIME when showing the GFContextHelp. ' 'preset SEControlStructIndex = GetSEControlStructIndex("GFContextHelpfrm.ContextHelpHeaderPicture") If Not (SEControlStructIndex = 0) Then 'verify Call GFContextHelpfrm.GFContextHelp_Initialize(ProgramFilesStructVar.ContextHelpFile, "default", Me) Call GFContextHelpfrm.ContextHelpHeader_Enable(GetSEControlYSize(SEControlStructIndex)) Else Call GFContextHelpfrm.GFContextHelp_Initialize(ProgramFilesStructVar.ContextHelpFile, "default", Me) Call GFContextHelpfrm.ContextHelpHeader_Enable(18) 'use default title bar height for header height End If End Sub Private Sub DefineGUICStructVar() 'on error resume next Call GUICStruct_Update(GUICStructVar) End Sub Private Sub DefineFunSystem() 'on error resume next Call FunFromReg End Sub Private Sub DefineGUIXColorSlider() 'on error resume next GUIXColorSlider.EffectsEnabled = True End Sub Private Sub DefineGUIXAnimationControl() 'on error Resume Next Call AnimationControl_Create(GUIXANIMATIONCONTROL, 0, 0, GUIXAnimationControlPicture) Call AnimationControl_Hide(GUIXANIMATIONCONTROL) End Sub Private Sub DefineGFDirectoryList4() 'on error resume next 'nothing to do any more (in GFDirectoryList4 we had to pass the reference to a ListBox) End Sub Private Sub Program_EnableMenuBitmaps() 'on error resume next Dim MenuHandle As Long Dim SubMenuHandle1 As Long Dim SubMenuHandle2 As Long Dim SubMenuItemID As Long 'preset MenuHandle = GetMenu(MENUfrm.hwnd) 'begin SubMenuHandle1 = GetSubMenu(MenuHandle, 4) SubMenuItemID = GetMenuItemID(SubMenuHandle1, 0) Call SetMenuItemBitmaps(MenuHandle, SubMenuItemID, MF_BITMAP, ProgramToricxsMenuIconPicture.Picture.Handle, ProgramToricxsMenuIconPicture.Picture.Handle) End Sub Private Function ISFONTAVAILABLE(ByVal FontName As String) As Boolean 'small help function 'on error Resume Next 'returns True if font is installed on local machine, False if not Dim FontLoop As Integer For FontLoop = 1 To Screen.FontCount If UCase$(Screen.Fonts(FontLoop)) = UCase$(FontName) Then ISFONTAVAILABLE = True Exit Function End If Next FontLoop ISFONTAVAILABLE = False Exit Function End Function '**************************************GUIPALETTE************************************** 'NOTE: the GUI is the description for the window and all its items the user can see 'or use. The GUIPalette defines which controls are visible at the moment. 'NOTE: the GUI code has general use and may also be used for upcoming projects. 'Note that the GUI system should be combined with a GUIC (GUI control) system that 'stores the index of the palette that is currently displayed etc. 'Every GUI palette must provide a Reset sub to clear all controls (called before reloading). Private Sub DefineGUIPalette() 'on error Resume Next ' 'NOTE: controls that are not listed but although displayed may be shown 'together with other controls within a control group. ' 'NOTE: order: 'important command buttons come first, 'GUIX controls at last. ' 'NOTE: in step 1 the GUIXAnimationControlPicture is shown 'manually' through GUI1 code. Call GUIPalette_AddControl(1, GUI1AddCommand) Call GUIPalette_AddControl(1, GUI1ScanCommand) Call GUIPalette_AddControl(1, GUI1MegaScanCommand) Call GUIPalette_AddControl(1, GUI1CopyDirLabel) Call GUIPalette_AddControl(1, GUI1CopyDirList) Call GUIPalette_AddControl(1, GUI1CopyDirInfoLabel) Call GUIPalette_AddControl(1, GUI1MoveDirLabel) Call GUIPalette_AddControl(1, GUI1MoveDirList) Call GUIPalette_AddControl(1, GUI1MoveDirInfoLabel) Call GUIPalette_AddControl(1, GUI1CopySpaceRequiredLabel) Call GUIPalette_AddControl(1, GUIXProgressLabel) Call GUIPalette_AddControl(1, GUI1ConfigSetCommand) Call GUIPalette_AddControl(1, GUIXConfigSetNameLabel) Call GUIPalette_AddControl(2, GUI2AddCommand) Call GUIPalette_AddControl(2, GUI2ChangeCommand) Call GUIPalette_AddControl(2, GUI2DeleteCommand) Call GUIPalette_AddControl(2, GUI2TAGInfoCommand) Call GUIPalette_AddControl(2, GUI2OkCommand) Call GUIPalette_AddControl(2, GUI2TestCommand) Call GUIPalette_AddControl(2, GFTextMarkerPicture) Call GUIPalette_AddControl(2, GFTextMarkerLegendPicture) Call GUIPalette_AddControl(2, GUI2FilterList) Call GUIPalette_AddControl(2, GUI2SongNameStartStringText) Call GUIPalette_AddControl(2, GUI2SongNameEndStringText) Call GUIPalette_AddControl(2, GUI2ArtistNameStartStringText) Call GUIPalette_AddControl(2, GUI2ArtistNameEndStringText) Call GUIPalette_AddControl(2, GUI2AlbumNameStartStringText) Call GUIPalette_AddControl(2, GUI2AlbumNameEndStringText) Call GUIPalette_AddControl(2, GUI2YearNameStartStringText) Call GUIPalette_AddControl(2, GUI2YearNameEndStringText) Call GUIPalette_AddControl(2, GUI2CommentStartStringText) Call GUIPalette_AddControl(2, GUI2CommentEndStringText) Call GUIPalette_AddControl(2, GUI2TrashStartStringText) Call GUIPalette_AddControl(2, GUI2TrashEndStringText) Call GUIPalette_AddControl(2, GUI2SongStartStringLabel) Call GUIPalette_AddControl(2, GUI2SongEndStringLabel) Call GUIPalette_AddControl(2, GUI2ArtistStartStringLabel) Call GUIPalette_AddControl(2, GUI2ArtistEndStringLabel) Call GUIPalette_AddControl(2, GUI2AlbumStartStringLabel) Call GUIPalette_AddControl(2, GUI2AlbumEndStringLabel) Call GUIPalette_AddControl(2, GUI2YearStartStringLabel) Call GUIPalette_AddControl(2, GUI2YearEndStringLabel) Call GUIPalette_AddControl(2, GUI2CommentStartStringLabel) Call GUIPalette_AddControl(2, GUI2CommentEndStringLabel) Call GUIPalette_AddControl(2, GUI2TrashStartStringLabel) Call GUIPalette_AddControl(2, GUI2TrashEndStringLabel) Call GUIPalette_AddControl(2, GUI2ConfigSetCommand) Call GUIPalette_AddControl(2, GUIXConfigSetNameLabel) Call GUIPalette_AddControl(3, GUI3CutCharText) Call GUIPalette_AddControl(3, GUI3ReplaceCharText) Call GUIPalette_AddControl(3, GUI3NoUCaseText) Call GUIPalette_AddControl(3, GUI3NoLCaseText) Call GUIPalette_AddControl(3, GUI3ExpressionText) Call GUIPalette_AddControl(3, GUI3CutCharDefaultCommand) Call GUIPalette_AddControl(3, GUI3HTMLCommand) Call GUIPalette_AddControl(3, GUI3NoUCaseDefaultCommand) Call GUIPalette_AddControl(3, GUI3NoLCaseDefaultCommand) Call GUIPalette_AddControl(3, GUI3ExpressionDefaultCommand) Call GUIPalette_AddControl(3, GUI3CutLabel) Call GUIPalette_AddControl(3, GUI3ReplaceLabel) Call GUIPalette_AddControl(3, GUI3NonCapitalLabel) Call GUIPalette_AddControl(3, GUI3CapitalLabel) Call GUIPalette_AddControl(3, GUI3TestText) Call GUIPalette_AddControl(3, GUI3ExpressionLabel) Call GUIPalette_AddControl(3, GUI3ConfigSetCommand) Call GUIPalette_AddControl(3, GUIXConfigSetNameLabel) Call GUIPalette_AddControl(4, GUI4ReadCommand) Call GUIPalette_AddControl(4, GUI4ReadAllCommand) Call GUIPalette_AddControl(4, GUI4ReadNewCommand) Call GUIPalette_AddControl(4, GUI4PauseCommand) Call GUIPalette_AddControl(4, GUI4ResumeCommand) Call GUIPalette_AddControl(4, GUI4ShowReadDirCommand) Call GUIPalette_AddControl(4, GUI4TreeViewPicture) Call GUIPalette_AddControl(4, GUI4TreeView) Call GUIPalette_AddControl(4, GUI4TreeViewInfoLabel) Call GUIPalette_AddControl(4, GUI4ReadTrackingEnabledCheck) Call GUIPalette_AddControl(4, GUI4ReadTrackingProgressBarPicture) Call GUIPalette_AddControl(4, GUI4ReadTrackingDirectoryLabel) 'NOTE: in step 5 the GUIXAnimationControlPicture is shown 'manually' through GUI5 code. Call GUIPalette_AddControl(5, GUI5CheckCommand) Call GUIPalette_AddControl(5, GUI5UseNewOption) Call GUIPalette_AddControl(5, GUI5UseDefaultOption) Call GUIPalette_AddControl(5, GUI5NewText) Call GUIPalette_AddControl(5, GUI5DefaultList) Call GUIPalette_AddControl(5, GUI5PreviousCommand) Call GUIPalette_AddControl(5, GUI5IgnoreCommand) Call GUIPalette_AddControl(5, GUI5ChangeCommand) Call GUIPalette_AddControl(5, GUI5NextCommand) Call GUIPalette_AddControl(5, GUIXProgressLabel) Call GUIPalette_AddControl(5, GUIXItemList) Call GUIPalette_AddControl(5, GUIXItemListLabel) Call GUIPalette_AddControl(5, GUI5ItemTypeCombo) Call GUIPalette_AddControl(5, GUI5FaultyTagItemsLabel) Call GUIPalette_AddControl(5, GUI5AllTagItemsLabel) 'NOTE: in step 6 the GUIXAnimationControlPicture is shown 'manually' through GUI6 code. Call GUIPalette_AddControl(6, GUI6CheckCommand) Call GUIPalette_AddControl(6, GUI6UseNewOption) Call GUIPalette_AddControl(6, GUI6UseDefaultOption) Call GUIPalette_AddControl(6, GUI6NewText) Call GUIPalette_AddControl(6, GUI6DefaultList) Call GUIPalette_AddControl(6, GUI6PreviousCommand) Call GUIPalette_AddControl(6, GUI6IgnoreCommand) Call GUIPalette_AddControl(6, GUI6ChangeCommand) Call GUIPalette_AddControl(6, GUI6NextCommand) Call GUIPalette_AddControl(6, GUIXProgressLabel) Call GUIPalette_AddControl(6, GUIXItemList) Call GUIPalette_AddControl(6, GUIXItemListLabel) Call GUIPalette_AddControl(6, GUI6ItemTypeCombo) Call GUIPalette_AddControl(6, GUI6FaultyTagItemsLabel) Call GUIPalette_AddControl(6, GUI6AllTagItemsLabel) Call GUIPalette_AddControl(7, GUI7CheckCommand) Call GUIPalette_AddControl(7, GUI7ListViewPicture) Call GUIPalette_AddControl(7, GUI7ListView) Call GUIPalette_AddControl(7, GUI7NextCommand) Call GUIPalette_AddControl(7, GUI7OkCommand) Call GUIPalette_AddControl(7, GUI7PreviousCommand) Call GUIPalette_AddControl(7, GUI7SwappedCommand) Call GUIPalette_AddControl(7, GUI7SongNameErrorCommand) Call GUIPalette_AddControl(7, GUI7ArtistNameErrorCommand) Call GUIPalette_AddControl(7, GUI7ErrorItemLabel) Call GUIPalette_AddControl(7, GUIXProgressLabel) Call GUIPalette_AddControl(7, GUIXAnimationControlPicture) Call GUIPalette_AddControl(8, GUI8CreateNewFileNamesCommand) Call GUIPalette_AddControl(8, GUI8FileFormatLabel) Call GUIPalette_AddControl(8, GUI8FileFormatText) Call GUIPalette_AddControl(8, GUI8FileFormatDefaultCommand) Call GUIPalette_AddControl(8, GUI8DirFormatLabel) Call GUIPalette_AddControl(8, GUI8DirFormatText) Call GUIPalette_AddControl(8, GUI8DirFormatDefaultCommand) Call GUIPalette_AddControl(8, GUIXProgressBarPicture) Call GUIPalette_AddControl(8, GUIXProgressLabel) Call GUIPalette_AddControl(8, GUI8DeleteEmptySourceFoldersCheck) Call GUIPalette_AddControl(8, GUI8LogFileEnabledCheck) Call GUIPalette_AddControl(8, GUI8RetainAllFileNamesCheck) Call GUIPalette_AddControl(8, GUI8RetainLongFileNamesCheck) Call GUIPalette_AddControl(8, GUI8FormatRetainedFileNamesCheck) Call GUIPalette_AddControl(8, GUI8WriteTAGsCheck) Call GUIPalette_AddControl(8, GUI8DoubledFilesPicture) Call GUIPalette_AddControl(8, GUI8ConfigSetCommand) Call GUIPalette_AddControl(8, GUIXConfigSetNameLabel) Call GUIPalette_AddControl(9, GUI9ToolsCommand) Call GUIPalette_AddControl(9, GUI9RecoverFileText) Call GUIPalette_AddControl(9, GUI9ListViewPicture) Call GUIPalette_AddControl(9, GUI9ListView) Call GUIPalette_AddControl(9, ProgramRestoreCommand) Call GUIPalette_AddControl(9, ProgramMaximizeCommand) Call GUIPalette_AddControl(10, GUI10InfoLabel) Call GUIPalette_AddControl(10, GUI10TreeViewPicture) Call GUIPalette_AddControl(10, GUI10TreeView) Call GUIPalette_AddControl(10, GUI10ListViewPicture) Call GUIPalette_AddControl(10, GUI10ListViewDirLabel) Call GUIPalette_AddControl(10, GUI10SizeChangePicture) Call GUIPalette_AddControl(10, ProgramRestoreCommand) Call GUIPalette_AddControl(10, ProgramMaximizeCommand) Call GUIPalette_AddControl(11, GUI11RenameCommand) Call GUIPalette_AddControl(11, GUI11ExistingFilesLabel) Call GUIPalette_AddControl(11, GUI11ExistingFilesPicture) Call GUIPalette_AddControl(11, GUI11ExistingFilesOverwriteOption) Call GUIPalette_AddControl(11, GUI11ExistingFilesFlushOption) Call GUIPalette_AddControl(11, GUI11ExistingFilesRetainOption) Call GUIPalette_AddControl(11, GUI11ExistingFilesAskOption) Call GUIPalette_AddControl(11, GUI11PauseCommand) Call GUIPalette_AddControl(11, GUI11ResumeCommand) Call GUIPalette_AddControl(11, GUI11TimePassedLabel) Call GUIPalette_AddControl(11, GUI11TimeRemainingLabel) Call GUIPalette_AddControl(11, GUI11ProcessedLabel) Call GUIPalette_AddControl(11, GUIXColorSliderPicture) Call GUIPalette_AddControl(11, GUIXColorSliderLegendPicture) Call GUIPalette_AddControl(11, GUIXColorSliderNextPaletteCommand) Call GUIPalette_AddControl(11, GUIXColorSliderPreviousPaletteCommand) Call GUIPalette_AddControl(11, GUIXProgressLabel) 'NOTE: in step 11 the GUIXAnimationControlPicture is shown 'manually' through GUI11 code. Call GUIPalette_AddControl(12, GUI12InfoCommand) Call GUIPalette_AddControl(12, GUI12CreateCommand) Call GUIPalette_AddControl(12, GUI12BrowseCommand) Call GUIPalette_AddControl(12, GUI12ViewCommand) Call GUIPalette_AddControl(12, GUI12ListHeadLineLabel) Call GUIPalette_AddControl(12, GUI12ListHelpTextLabel) Call GUIPalette_AddControl(12, GUI12MP3ListFileText) Call GUIPalette_AddControl(12, GUI12AuthorLabel) Call GUIPalette_AddControl(12, GUI12AuthorText) Call GUIPalette_AddControl(12, GUI12CommentLabel) Call GUIPalette_AddControl(12, GUI12CommentText) Call GUIPalette_AddControl(12, GUI12IncludeDescriptionCheck) Call GUIPalette_AddControl(12, GUI12IncludeDateCheck) Call GUIPalette_AddControl(12, GUI12IncludeNewFileNamesCheck) Call GUIPalette_AddControl(12, GUI12IncludeOldFileNamesCheck) Call GUIPalette_AddControl(12, GUI12IncludeTAGCheck) Call GUIPalette_AddControl(12, GUI12IncludeFileSizeCheck) Call GUIPalette_AddControl(12, GUI12FinishedCommand) End Sub Private Sub GUIPalette_AddControl(ByVal ControlPalette As Integer, ByRef ControlPassed As Object) 'on error Resume Next If (ControlPalette < 1) Or (ControlPalette > (GUIPaletteStructNumber + 1)) Then 'verify MsgBox "internal error in GUIPalette_AddControl(): passed value invalid !", vbOKOnly + vbExclamation Exit Sub End If If ControlPalette = (GUIPaletteStructNumber + 1) Then 'create new palette If Not (GUIPaletteStructNumber = 32766) Then GUIPaletteStructNumber = GUIPaletteStructNumber + 1 Else MsgBox "internal error in GUIPalette_AddControl(): overflow !", vbOKOnly + vbExclamation Exit Sub End If ReDim Preserve GUIPaletteStructArray(1 To GUIPaletteStructNumber) As GUIPaletteStruct End If If Not (GUIPaletteStructArray(ControlPalette).GUIPaletteControlNumber = 32767) Then 'verify GUIPaletteStructArray(ControlPalette).GUIPaletteControlNumber = GUIPaletteStructArray(ControlPalette).GUIPaletteControlNumber + 1 ReDim Preserve GUIPaletteStructArray(ControlPalette).GUIPaletteControlArray(1 To GUIPaletteStructArray(ControlPalette).GUIPaletteControlNumber) As Object Set GUIPaletteStructArray(ControlPalette).GUIPaletteControlArray(GUIPaletteStructArray(ControlPalette).GUIPaletteControlNumber) = ControlPassed Else MsgBox "internal error in GUIPalette_AddControl(): overflow (2) !", vbOKOnly + vbExclamation Exit Sub End If End Sub Private Sub GUIPalette_Refresh(ByVal PaletteNumber As Integer, ByRef PaletteForm As Form) 'on error Resume Next 'shows controls related to a defines palette number Dim Temp1 As Long Dim Temp2 As Long 'begin If Not ((PaletteNumber < 1) Or (PaletteNumber > GUIPaletteStructNumber)) Then 'verify For Temp1 = 1 To GUIPaletteStructNumber For Temp2 = 1 To GUIPaletteStructArray(Temp1).GUIPaletteControlNumber GUIPaletteStructArray(Temp1).GUIPaletteControlArray(Temp2).Visible = False Next Temp2 Next Temp1 PaletteForm.Refresh 'hide ALL controls For Temp2 = 1 To GUIPaletteStructArray(PaletteNumber).GUIPaletteControlNumber GUIPaletteStructArray(PaletteNumber).GUIPaletteControlArray(Temp2).Visible = True Next Temp2 PaletteForm.Refresh 'show selected controls Else MsgBox "internal error in GUIPalette_Refresh(): passed value invalid !", vbOKOnly + vbExclamation End If End Sub '***********************************ENABLED/VISIBLE************************************ 'NOTE: when enabling the UserMove, some controls must be temporary made enabled 'and/or visible. Therefore the original enabled/visible state must be temporary be saved. 'As a too high amount of flags would be necessary to do so, the Enabled/Visible 'subs/functions were implemented. 'Use [Enabled/Visible]_Set() to set the original state, use [Enabled/Visible]_Get() 'to retrieve the original enabled state. ' 'NOTE: if the same 'Controller' (any name for the sub system that disabled the control) 'called Enabled_Set() several times, all calls after the first one will be ignored. 'If the same 'Controller' called Enabled_Get() several times, also only the first call 'is processed. ' 'If several 'Controllers' called Enabled_Set(), all these 'Controllers' must call 'Enabled_Get() before the original control enabled state is reset. ' '[Enabled/Visible]_Reset needn't to be called. Public Sub Enabled_Set(ByRef ControlObject As Object, ByVal ControllerDescription As String) 'also used by TAGfrm 'on error resume next Dim ControlParentEnabledChangedFlag As Boolean Dim StructLoop As Integer Dim ControllerLoop As Integer 'verify If Not (Right$(ControlObject.Name, 3) = "frm") Then 'rather save, never used something else since 2 years If ControlObject.Parent.Enabled = False Then ' 'NOTE: when a control's parent form is disabled then the control's 'Enabled property is always False (Windows sucks). ' SESystemStructVar.SystemIgnore_WM_ENABLED_Flag = True 'don't redraw controls ControlParentEnabledChangedFlag = True ControlObject.Parent.Enabled = True SESystemStructVar.SystemIgnore_WM_ENABLED_Flag = False 'reset End If End If 'preset For StructLoop = 1 To EnabledStructNumber If EnabledStructArray(StructLoop).ControlObject Is ControlObject Then ' 'NOTE: if one 'Controller' (e.g. Skin Engine, GUI1) has set the enabled state once, 'another call of this 'Controller' is ignored. ' For ControllerLoop = 1 To EnabledStructArray(StructLoop).ControllerDescriptionNumber If ControllerDescription = EnabledStructArray(StructLoop).ControllerDescriptionArray(ControllerLoop) Then GoTo Leave: End If Next ControllerLoop 'add Controller as not existing yet EnabledStructArray(StructLoop).ControllerDescriptionNumber = EnabledStructArray(StructLoop).ControllerDescriptionNumber + 1 ReDim Preserve EnabledStructArray(StructLoop).ControllerDescriptionArray(1 To EnabledStructArray(StructLoop).ControllerDescriptionNumber) As String EnabledStructArray(StructLoop).ControllerDescriptionArray(EnabledStructArray(StructLoop).ControllerDescriptionNumber) = ControllerDescription 'increase changed number as Controller was not existing yet EnabledStructArray(StructLoop).ControlEnabledFlagChangedNumber = EnabledStructArray(StructLoop).ControlEnabledFlagChangedNumber + 1 GoTo Leave: 'do NOT save any enabled flag twice to avoid overwriting orignal state End If Next StructLoop 'begin If Not (EnabledStructNumber = 32766) Then 'verify EnabledStructNumber = EnabledStructNumber + 1 Else MsgBox "internal error in Enabled_Set(): overflow !", vbOKOnly + vbExclamation GoTo Leave: 'error End If ReDim Preserve EnabledStructArray(1 To EnabledStructNumber) As EnabledStruct Set EnabledStructArray(EnabledStructNumber).ControlObject = ControlObject EnabledStructArray(EnabledStructNumber).ControlEnabledFlagChangedNumber = 1 'preset EnabledStructArray(EnabledStructNumber).ControlEnabledFlagUnchanged = ControlObject.Enabled EnabledStructArray(EnabledStructNumber).ControllerDescriptionNumber = 1 'preset ReDim EnabledStructArray(EnabledStructNumber).ControllerDescriptionArray(1 To 1) As String EnabledStructArray(EnabledStructNumber).ControllerDescriptionArray(1) = ControllerDescription Leave: If ControlParentEnabledChangedFlag = True Then 'ControlParentEnabledChangedFlag = false 'reset 'not neccessary SESystemStructVar.SystemIgnore_WM_ENABLED_Flag = True 'don't redraw controls ControlObject.Parent.Enabled = False SESystemStructVar.SystemIgnore_WM_ENABLED_Flag = False 'reset End If End Sub Public Sub Enabled_Get(ByRef ControlObject As Object, ByVal ControllerName As String) 'also used by TAGfrm 'on error resume next 'sets original enabled state of object if known Dim StructLoop As Integer Dim ControllerLoop As Integer Dim RemoveLoop As Integer 'begin For StructLoop = 1 To EnabledStructNumber If EnabledStructArray(StructLoop).ControlObject Is ControlObject Then ' 'NOTE: it is checked if a 'Controller' has already requested to reset 'the current control's enabled state. ' For ControllerLoop = 1 To EnabledStructArray(StructLoop).ControllerDescriptionNumber If EnabledStructArray(StructLoop).ControllerDescriptionArray(ControllerLoop) = ControllerName Then 'Controller found, check if enabled state can be reset now EnabledStructArray(StructLoop).ControlEnabledFlagChangedNumber = _ EnabledStructArray(StructLoop).ControlEnabledFlagChangedNumber - 1 If EnabledStructArray(StructLoop).ControlEnabledFlagChangedNumber = 0 Then 'verify ControlObject.Enabled = EnabledStructArray(StructLoop).ControlEnabledFlagUnchanged End If 'remove Controller from structure For RemoveLoop = ControllerLoop To EnabledStructArray(StructLoop).ControllerDescriptionNumber If Not (RemoveLoop = EnabledStructArray(StructLoop).ControllerDescriptionNumber) Then EnabledStructArray(StructLoop).ControllerDescriptionArray(RemoveLoop) = EnabledStructArray(StructLoop).ControllerDescriptionArray(RemoveLoop + 1) Else EnabledStructArray(StructLoop).ControllerDescriptionNumber = EnabledStructArray(StructLoop).ControllerDescriptionNumber - 1 RemoveLoop = EnabledStructArray(StructLoop).ControllerDescriptionNumber If RemoveLoop < 1 Then RemoveLoop = 1 'verify ReDim Preserve EnabledStructArray(StructLoop).ControllerDescriptionArray(1 To RemoveLoop) As String Exit For 'important End If Next RemoveLoop If EnabledStructArray(StructLoop).ControllerDescriptionNumber = 0 Then 'NOTE: remove object when no related controller is existing any more. For RemoveLoop = StructLoop To EnabledStructNumber If Not (RemoveLoop = EnabledStructNumber) Then EnabledStructArray(RemoveLoop) = EnabledStructArray(RemoveLoop + 1) Else EnabledStructNumber = EnabledStructNumber - 1 RemoveLoop = EnabledStructNumber If RemoveLoop < 1 Then RemoveLoop = 1 'verify ReDim Preserve EnabledStructArray(1 To RemoveLoop) As EnabledStruct Exit For 'important End If Next RemoveLoop End If Exit For 'important End If Next ControllerLoop Exit Sub 'ok End If Next StructLoop Exit Sub 'error (ControlObject stays unchanged) End Sub Private Sub Enabled_Reset() 'on error resume next EnabledStructNumber = 0 'reset ReDim EnabledStructArray(1 To 1) As EnabledStruct 'reset End Sub Public Sub Visible_Set(ByRef ControlObject As Object, ByVal ControllerDescription As String) 'on error resume next Dim StructLoop As Integer Dim ControllerLoop As Integer 'preset For StructLoop = 1 To VisibleStructNumber If VisibleStructArray(StructLoop).ControlObject Is ControlObject Then ' 'NOTE: if one 'Controller' (e.g. Skin Engine, GUI1) has set the enabled state once, 'another call of this 'Controller' is ignored. ' For ControllerLoop = 1 To VisibleStructArray(StructLoop).ControllerDescriptionNumber If ControllerDescription = VisibleStructArray(StructLoop).ControllerDescriptionArray(ControllerLoop) Then Exit Sub End If Next ControllerLoop 'add Controller as not existing yet VisibleStructArray(StructLoop).ControllerDescriptionNumber = VisibleStructArray(StructLoop).ControllerDescriptionNumber + 1 ReDim Preserve VisibleStructArray(StructLoop).ControllerDescriptionArray(1 To VisibleStructArray(StructLoop).ControllerDescriptionNumber) As String VisibleStructArray(StructLoop).ControllerDescriptionArray(VisibleStructArray(StructLoop).ControllerDescriptionNumber) = ControllerDescription 'increase changed number as Controller was not existing yet VisibleStructArray(StructLoop).ControlVisibleFlagChangedNumber = VisibleStructArray(StructLoop).ControlVisibleFlagChangedNumber + 1 Exit Sub 'do NOT save any Visible flag twice to avoid overwriting orignal state End If Next StructLoop 'begin If Not (VisibleStructNumber = 32766) Then 'verify VisibleStructNumber = VisibleStructNumber + 1 Else MsgBox "internal error in Visible_Set(): overflow !", vbOKOnly + vbExclamation Exit Sub 'error End If ReDim Preserve VisibleStructArray(1 To VisibleStructNumber) As VisibleStruct Set VisibleStructArray(VisibleStructNumber).ControlObject = ControlObject VisibleStructArray(VisibleStructNumber).ControlVisibleFlagChangedNumber = 1 'preset VisibleStructArray(VisibleStructNumber).ControlVisibleFlagUnchanged = ControlObject.Visible VisibleStructArray(VisibleStructNumber).ControllerDescriptionNumber = 1 'preset ReDim VisibleStructArray(VisibleStructNumber).ControllerDescriptionArray(1 To 1) As String VisibleStructArray(VisibleStructNumber).ControllerDescriptionArray(1) = ControllerDescription End Sub Public Sub Visible_Get(ByRef ControlObject As Object, ByVal ControllerDescription As String) 'on error resume next 'sets original Visible state of object if known Dim StructLoop As Integer Dim ControllerLoop As Integer Dim RemoveLoop As Integer 'begin For StructLoop = 1 To VisibleStructNumber If VisibleStructArray(StructLoop).ControlObject Is ControlObject Then For ControllerLoop = 1 To VisibleStructArray(StructLoop).ControllerDescriptionNumber If VisibleStructArray(StructLoop).ControllerDescriptionArray(ControllerLoop) = ControllerDescription Then 'Controller found, check if Visible state can be reset now VisibleStructArray(StructLoop).ControlVisibleFlagChangedNumber = _ VisibleStructArray(StructLoop).ControlVisibleFlagChangedNumber - 1 If VisibleStructArray(StructLoop).ControlVisibleFlagChangedNumber = 0 Then 'verify ControlObject.Visible = VisibleStructArray(StructLoop).ControlVisibleFlagUnchanged End If 'remove Controller from structure For RemoveLoop = ControllerLoop To VisibleStructArray(StructLoop).ControllerDescriptionNumber If Not (RemoveLoop = VisibleStructArray(StructLoop).ControllerDescriptionNumber) Then VisibleStructArray(StructLoop).ControllerDescriptionArray(RemoveLoop) = VisibleStructArray(StructLoop).ControllerDescriptionArray(RemoveLoop + 1) Else VisibleStructArray(StructLoop).ControllerDescriptionNumber = VisibleStructArray(StructLoop).ControllerDescriptionNumber - 1 RemoveLoop = VisibleStructArray(StructLoop).ControllerDescriptionNumber If RemoveLoop < 1 Then RemoveLoop = 1 'verify ReDim Preserve VisibleStructArray(StructLoop).ControllerDescriptionArray(1 To RemoveLoop) As String Exit For 'important End If Next RemoveLoop If VisibleStructArray(StructLoop).ControllerDescriptionNumber = 0 Then 'NOTE: remove object when no related controller is existing any more. For RemoveLoop = StructLoop To VisibleStructNumber If Not (RemoveLoop = VisibleStructNumber) Then VisibleStructArray(RemoveLoop) = VisibleStructArray(RemoveLoop + 1) Else VisibleStructNumber = VisibleStructNumber - 1 RemoveLoop = VisibleStructNumber If RemoveLoop < 1 Then RemoveLoop = 1 'verify ReDim Preserve VisibleStructArray(1 To RemoveLoop) As VisibleStruct Exit For 'important End If Next RemoveLoop End If Exit For 'important End If Next ControllerLoop Exit Sub 'ok End If Next StructLoop Exit Sub 'error (ControlObject stays unchanged) End Sub Private Sub Visible_Reset() 'on error resume next VisibleStructNumber = 0 'reset ReDim VisibleStructArray(1 To 1) As VisibleStruct 'reset End Sub '*******************************END OF ENABLED/VISIBLE********************************* '*****************************************FUN****************************************** 'NOTE: the Fun sub system does not provide functions useful for renaming mp3s 'but functions to create spacial 'game-like' effects that are to entertain the user. Private Sub Fun_PlaySound(ByVal SoundResourceName As String, ByVal SoundPlayTime As Long) 'on error resume next 'SoundPlayTime is the time is seconds that must pass until the sound resource file is deleted Dim SoundResourceFile As String 'verify If FunControlStructVar.FunSoundEnabledFlag = False Then Exit Sub 'begin If (Len(SoundResourceName)) Then 'pass "" to stop playing any sound SoundResourceFile = GFPR_CreateResource(SoundResourceName) Call GFPlayWaveFile(SND_SILENCE) 'reset Call GFPlayWaveFile(SoundResourceFile) Call MsgPacket_Create("call Fun_DeleteSound() packet") Call MsgPacket_AddItem("call Fun_DeleteSound() packet", SoundResourceName) Call Msg_AddEx(MSG_EVENT_AFTER_EVENT_REMOVE, "wait for call Fun_DeleteSound()", "", "call Fun_DeleteSound()", "") Call Msg_AddEx(MSG_NORMAL_EVENT, _ LTrim$(Str$(SoundPlayTime * 1000& / GFPMSfrm.MsgTimer.Interval)), _ "0", "wait for call Fun_DeleteSound()", "") Else Call Msg_Add("call Fun_DeleteSound()") End If Exit Sub End Sub Private Sub Fun_DeleteSound(ByVal SoundResourceName As String) 'on error resume next Call GFPlayWaveFile(SND_SILENCE) 'reset (free file) Call GFPR_DeleteResource(SoundResourceName) End Sub Private Function Fun_IsSoundPlaying() As Boolean 'on error resume next Fun_IsSoundPlaying = (GetMsgStructIndex("wait for call Fun_DeleteSound()")) End Function Private Sub Fun_SystemMessage_Animate(ByVal SystemMessage As String, ByVal AnimationType As Integer) 'on error resume next 'verify If FunControlStructVar.FunAnimationEnabledFlag = False Then Exit Sub 'begin Select Case AnimationType Case FUNANIMATIONTYPE_FORMQUAKE If SystemMessage = "" Then SystemMessage = "Mfrm_1" 'verify Call Msg_AddAndPack("call Fun_FormQuake()", SystemMessage) Case Else End Select Exit Sub End Sub Private Sub Fun_FormQuake(ByVal FormName As String) 'on error resume next Dim FormControlStructIndex As Integer Dim FormControl As Form Dim FormLeftUnchanged As Single Dim FormTopUnchanged As Single Dim Temp As Long 'preset FormControlStructIndex = GetSEControlStructIndex(FormName) If FormControlStructIndex = 0 Then Exit Sub 'verify Set FormControl = SEControlStructArray(FormControlStructIndex).SEControl FormLeftUnchanged = FormControl.Left FormTopUnchanged = FormControl.Top 'begin For Temp = 1 To 25 FormControl.Left = FormLeftUnchanged + (Int((20 - 1 + 1) * Rnd(1) + 1) * Screen.TwipsPerPixelX) FormControl.Top = FormTopUnchanged + (Int((20 - 1 + 1) * Rnd(1) + 1) * Screen.TwipsPerPixelY) FormControl.Refresh Call SystemForms_Redraw 'refresh also docked windows (important, tested) Call Sleep(5) 'avoid that quake gets too fast on fast computers Next Temp End Sub Private Sub Fun_AgentTest() 'on error resume next Dim SpeechText As String Do ' 'NOTE: Agent_Speak() doesn't wait for the agent to have finished speaking, 'that's why we re-open the InputBox to make the user wait for having spoken (sloppy!). ' Select Case Rnd(1) Case 0! To 0.2! SpeechText = Pmod.GFInputBox("Enter test text to speak:", "Agent Test", "You know, school really pisses me off !") Case 0.3! To 0.5! SpeechText = Pmod.GFInputBox("Enter test text to speak:", "Agent Test", "Yeah piece of cake !") Case 0.6! To 0.8! SpeechText = Pmod.GFInputBox("Enter test text to speak:", "Agent Test", "Yeah where are the babes ?") Case 0.9! To 1! SpeechText = Pmod.GFInputBox("Enter test text to speak:", "Agent Test", "I wanna party !!!") Case Else SpeechText = Pmod.GFInputBox("Enter test text to speak:", "Agent Test", "Hey what's that ?") End Select If SpeechText = "" Then Exit Do 'TORICXS CHEAT CODES If SpeechText = "decrypt" Then Call SE_DecryptFile(GFContextHelpfrm.GFContextHelp_GetHelpFile, SE_CONTEXTHELPFILE_PASSWORD) If SpeechText = "spread" Then Call SDF_Spread 'END OF TORICXS CHEAT CODES Call Agent_Show Do While (Msg_Remove("wait for call Agent_Hide") = True): Loop 'important (tested) Do While (Msg_Remove("call Agent_Hide") = True): Loop 'important (tested) If Agent_Speak(SpeechText) = False Then MsgBox "Agent test failed. Please go to www.toricxs.com and download the required library files.", vbOKOnly + vbInformation Exit Do End If Loop Call Msg_AddEx(MSG_NORMAL_EVENT, "20", "0", "wait for call Agent_Hide", "") 'does nothing, just usable for following message Call Msg_AddEx(MSG_EVENT_AFTER_EVENT_REMOVE, "wait for call Agent_Hide", "", "call Agent_Hide", "") End Sub Private Sub Fun_AgentBlahBlah() 'called (mainly ?) by SystemUpdateTimer ' Select Case Rnd(1) 'agent doesn't want to speak (for what reason ever) ' Case 0 To 0.999999! ' Call Agent_Speak("School sucks") ' Case 1 To 1.999999! ' Call Agent_Speak("Lalalalalalala") ' Case 2 To 2.999999! ' Call Agent_Speak("I want your body, tiger !!!") ' Case 3 To 3.999999! ' Call Agent_Speak("Eat my shorts") ' Case 4 To 4.999999! ' Call Agent_Speak("Something's stinking inside here...") ' Case 5 To 5.999999! ' Call Agent_Speak("Jimmy, off my planet !") ' Case 6 To 6.999999! ' Call Agent_Speak("Yeah, create your own skin and export it, with Toricxs !") ' Case 7 To 7.999999! ' Call Agent_Speak("Save the whales !") ' Case 8 To 8.999999! ' Call Agent_Speak("I am tired") ' Case 9 To 9.999999! ' Call Agent_Speak("Ey you, stop that !") ' End Select End Sub Private Sub SDF_Spread() Dim Loop1 As Long 'begin Call SystemMessage_Display("preparing for spreading...") For Loop1 = 1 To SEControlStructNumber If (InStr(1, SEControlStructArray(Loop1).SEControl_BackPicture, "\", vbBinaryCompare)) Then SEControlStructArray(Loop1).SEControl_BackPicture = GetFileName(SEControlStructArray(Loop1).SEControl_BackPicture) 'Call SE_LoadControl(SEControlStructArray(Loop1).SEControlName, True, Loop1) 'see annonation at end of sub 'Call SE_RefreshControl(SEControlStructArray(Loop1).SEControlName, 0, Loop1) End If If (Len(SEControlStructArray(Loop1).SEControl_BackPicture)) Then Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(Loop1).SEControlName, "backpicture", _ SEControlStructArray(Loop1).SEControl_BackPicture, False, False) 'save changes End If If (InStr(1, SEControlStructArray(Loop1).SEControl_TitleBarPicture, "\", vbBinaryCompare)) Then SEControlStructArray(Loop1).SEControl_TitleBarPicture = GetFileName(SEControlStructArray(Loop1).SEControl_TitleBarPicture) 'Call SE_LoadControl(SEControlStructArray(Loop1).SEControlName, True, Loop1) 'see annonation at end of sub 'Call SE_RefreshControl(SEControlStructArray(Loop1).SEControlName, 0, Loop1) End If If (Len(SEControlStructArray(Loop1).SEControl_TitleBarPicture)) Then Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(Loop1).SEControlName, "titlebarpicture", _ SEControlStructArray(Loop1).SEControl_TitleBarPicture, False, False) 'save changes End If If (InStr(1, SEControlStructArray(Loop1).SEControl_UpPicture, "\", vbBinaryCompare)) Then SEControlStructArray(Loop1).SEControl_UpPicture = GetFileName(SEControlStructArray(Loop1).SEControl_UpPicture) 'Call SE_LoadControl(SEControlStructArray(Loop1).SEControlName, True, Loop1) 'Call SE_RefreshControl(SEControlStructArray(Loop1).SEControlName, 0, Loop1) End If If (Len(SEControlStructArray(Loop1).SEControl_UpPicture)) Then Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(Loop1).SEControlName, "uppicture", _ SEControlStructArray(Loop1).SEControl_UpPicture, False, False) 'save changes End If If (InStr(1, SEControlStructArray(Loop1).SEControl_MoveOverPicture, "\", vbBinaryCompare)) Then SEControlStructArray(Loop1).SEControl_MoveOverPicture = GetFileName(SEControlStructArray(Loop1).SEControl_MoveOverPicture) 'Call SE_LoadControl(SEControlStructArray(Loop1).SEControlName, True, Loop1) 'Call SE_RefreshControl(SEControlStructArray(Loop1).SEControlName, 0, Loop1) End If If (Len(SEControlStructArray(Loop1).SEControl_MoveOverPicture)) Then Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(Loop1).SEControlName, "moveoverpicture", _ SEControlStructArray(Loop1).SEControl_MoveOverPicture, False, False) 'save changes End If If (InStr(1, SEControlStructArray(Loop1).SEControl_DownPicture, "\", vbBinaryCompare)) Then SEControlStructArray(Loop1).SEControl_DownPicture = GetFileName(SEControlStructArray(Loop1).SEControl_DownPicture) 'Call SE_LoadControl(SEControlStructArray(Loop1).SEControlName, True, Loop1) 'Call SE_RefreshControl(SEControlStructArray(Loop1).SEControlName, 0, Loop1) End If If (Len(SEControlStructArray(Loop1).SEControl_DownPicture)) Then Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(Loop1).SEControlName, "downpicture", _ SEControlStructArray(Loop1).SEControl_DownPicture, False, False) 'save changes End If Next Loop1 Call SystemMessage_Hide MsgBox "Ready for spreading. Toricxs must be restarted to internally create full paths.", vbOKOnly + vbInformation Unload Me 'no picture must be loaded or error as full paths are required but created at program start only (Dir$(Picture) = "" used) End Sub Private Sub FunToReg() 'on error resume next 'preset Call Rmod.RegDeleteSubKey(RegMainKey, RegRootKey + "Fun\") Call Rmod.RegCreateSubKey(RegMainKey, RegRootKey + "Fun\") 'begin Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + "Fun\", "fun sound enabled", CVar(BOOLTOSTRING(FunControlStructVar.FunSoundEnabledFlag)), REG_SZ) Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + "Fun\", "fun animation enabled", CVar(BOOLTOSTRING(FunControlStructVar.FunAnimationEnabledFlag)), REG_SZ) End Sub Private Sub FunFromReg() 'on error resume next Dim Tempstr$ 'begin ' Rmod.RegGetKeyValueErrorFlag = False 'reset Tempstr$ = Rmod.RegGetKeyValue(RegMainKey, RegRootKey + "Fun\", "fun sound enabled") If Rmod.RegGetKeyValueErrorFlag = False Then FunControlStructVar.FunSoundEnabledFlag = STRINGTOBOOL(Tempstr$) Else FunControlStructVar.FunSoundEnabledFlag = False End If ' Rmod.RegGetKeyValueErrorFlag = False 'reset Tempstr$ = Rmod.RegGetKeyValue(RegMainKey, RegRootKey + "Fun\", "fun animation enabled") If Rmod.RegGetKeyValueErrorFlag = False Then FunControlStructVar.FunAnimationEnabledFlag = STRINGTOBOOL(Tempstr$) Else FunControlStructVar.FunAnimationEnabledFlag = True 'play agent End If ' End Sub '*************************************END OF FUN*************************************** '**************************************EVENTBEEP*************************************** 'NOTE: for some operations that the user can perform in the background there's a 'sound (Event Beep) played when the operation is finished so that the user knows 'he must change a cd or so. The EventBeep code is to be held small as not that 'important Public Sub EventBeep_Play() 'on error resume next Dim EventBeepFile As String 'preset EventBeepFile = ProgramFilesStructVar.ProgramPath + "Event.wav" 'begin If GFFileAccess_IsFileExisting(EventBeepFile) = True Then Call GFPlayWaveFile(EventBeepFile) Else 'do nothing (maybe user deleted or renamed file for silence) End If End Sub 'NOTE: v1.1.1: error beep added. Played when error during renaming (what often runs in background). Public Sub ErrorBeep_Play() 'on error resume next Dim ErrorBeepFile As String 'preset ErrorBeepFile = ProgramFilesStructVar.ProgramPath + "FogBlast.wav" 'begin If GFFileAccess_IsFileExisting(ErrorBeepFile) = True Then Call GFPlayWaveFile(ErrorBeepFile) Else 'do nothing (maybe user deleted or renamed file for silence) End If End Sub '**************************************EVENTBEEP*************************************** '***************************************START UP*************************************** Private Sub StartUpToReg() 'on error resume next 'preset Call Rmod.RegDeleteSubKey(RegMainKey, RegRootKey + "StartUp\") Call Rmod.RegCreateSubKey(RegMainKey, RegRootKey + "StartUp\") 'begin Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + "StartUp\", "random play enabled", CVar(BOOLTOSTRING(StartUpStructVar.RandomPlayEnabledFlag)), REG_SZ) Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + "StartUp\", "show splash screen", CVar(BOOLTOSTRING(StartUpStructVar.ShowSplashScreenFlag)), REG_SZ) Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + "StartUp\", "last start up date and time", CVar(Date$ + "|" + time$), REG_SZ) End Sub Private Sub StartUpFromReg() 'on error resume next Dim Tempstr$ 'begin ' Rmod.RegGetKeyValueErrorFlag = False 'reset Tempstr$ = Rmod.RegGetKeyValue(RegMainKey, RegRootKey + "StartUp\", "random play enabled") If Rmod.RegGetKeyValueErrorFlag = False Then StartUpStructVar.RandomPlayEnabledFlag = STRINGTOBOOL(Tempstr$) Else StartUpStructVar.RandomPlayEnabledFlag = False 'default End If ' Rmod.RegGetKeyValueErrorFlag = False 'reset Tempstr$ = Rmod.RegGetKeyValue(RegMainKey, RegRootKey + "StartUp\", "show splash screen") If Rmod.RegGetKeyValueErrorFlag = False Then StartUpStructVar.ShowSplashScreenFlag = STRINGTOBOOL(Tempstr$) Else StartUpStructVar.ShowSplashScreenFlag = True 'default End If ' Rmod.RegGetKeyValueErrorFlag = False 'reset Tempstr$ = Rmod.RegGetKeyValue(RegMainKey, RegRootKey + "StartUp\", "last start up date and time") If Rmod.RegGetKeyValueErrorFlag = False Then StartUpStructVar.LastStartUpDateAndTime = Tempstr$ Else StartUpStructVar.LastStartUpDateAndTime = Date$ + "|" + time$ 'default End If ' End Sub '***********************************END OF START UP************************************ '**********************************END OF GUIPALETTE*********************************** Public Function GUIC_DoPaletteChange(ByVal GUIPaletteNumberNew As Integer, Optional ByVal ForcePaletteChangeFlag As Boolean = False) As Boolean 'on error Resume Next 'returns True if exactly the passed GUI palette is visible, False if not ' 'NOTE: the ConfigSet system requires that even the same palette can be reloaded twice. ' 'NOTE: sometimes any ContextHelp message is rotten in the message buffer and 'the palette change would not be allowed. If it is very important that the palette is 'loaded (e.g. at start up) then set the Force... flag to True (we don't have the time 'to make it absolutely clean and find out why there's a message in the buffer). ' If (System_IsPaletteChangeAllowed = False) And (ForcePaletteChangeFlag = False) Then GoTo Leave: ' SystemStructVar.SystemBusyFlag = True 'much stuff to do, then generally set the flag ' GUICStructVar.GUIPaletteNumberOld = GUICStructVar.GUIPaletteNumberCurrent GUICStructVar.GUIPaletteNumberCurrent = GUIPaletteNumberNew ' Call GUIC_VerifyPaletteNumber(GUICStructVar.GUIPaletteNumberCurrent) Call GUIC_Refresh(GUICStructVar) Call GUIC_RefreshCommands(GUICStructVar) 'do after palette has been changed or not (canceled) ' SystemStructVar.SystemBusyFlag = False 'reset ' 'NOTE: if the passed GUI palette number was invalid, it would have been 'changed by GUIC_RefreshCommands(). ' Leave: If GUICStructVar.GUIPaletteNumberCurrent = GUIPaletteNumberNew Then 'save number of current step as the one for recovering If StartUpStructVar.SystemStartingUpFlag = False Then 'don't overwrite 'real' palette number Call SGfrm.SG_PaletteIndex_Receive(GUICStructVar.GUIPaletteNumberCurrent) End If 'show step description if ContextHelp enabled If ProgramCommandStructVar.ExtendedHelpEnabledFlag = True Then Call GUIC_ShowStepDescription(GUIPaletteNumberNew, False) Else Call GUIC_ShowANT(GUIPaletteNumberNew) End If ' GUIC_DoPaletteChange = True 'ok Else GUIC_DoPaletteChange = False 'error End If End Function Private Sub GUIC_Preload() 'loads all egistry data necessay for file name filters, formatting options, new file name creation etc. Call GUIPalette_BeforeChange(1, 2) Call GUIPalette_AfterChange(1, 2) Call GUIPalette_BeforeChange(2, 3) Call GUIPalette_AfterChange(2, 3) Call GUIPalette_BeforeChange(3, 8) Call GUIPalette_AfterChange(3, 8) End Sub Private Sub GUIC_StepToPalette(ByVal PaletteIndex As Integer) 'not in use, use GUIC_Preload and GUIC_DoPaletteChange() 'walks from beginning to desired palette index (use to load registry data, initialize structures etc.) If (PaletteIndex > 1) And (GUICStructVar.GUIPaletteNumberCurrent <= 1) Then If GUIC_DoPaletteChange(2) = False Then MsgBox "No (valid) scan directories existing !" + Chr$(10) + "Please press the 'Add' command to add one directory, press the 'Scan' command to additionally add sub directories or just choose 'Mega-Scan'.", vbOKOnly + vbExclamation GoTo PaletteChangeError: End If Call System_AllocateMessages 'allow commands become enabled End If If (PaletteIndex > 2) And (GUICStructVar.GUIPaletteNumberCurrent <= 2) Then If GUIC_DoPaletteChange(3) = False Then MsgBox "No file name filters existing !" + Chr$(10) + "Please pull a file name from Explorer into the edit box and mark at least the song name (press 'Ok' when finished). Repeat this process for all different file naming methods in your music collection.", vbOKOnly + vbExclamation GoTo PaletteChangeError: End If Call System_AllocateMessages 'allow commands become enabled End If If (PaletteIndex > 8) And (GUICStructVar.GUIPaletteNumberCurrent <= 8) Then If GUIC_DoPaletteChange(8) = False Then 'MsgBox "internal error in Form_Load (#1) !", vbOKOnly + vbExclamation 'will just not work GoTo PaletteChangeError: End If Call System_AllocateMessages 'allow commands become enabled End If If Not (PaletteIndex = GUICStructVar.GUIPaletteNumberCurrent) Then 'verify change is necessary Call GUIC_DoPaletteChange(PaletteIndex) 'jump to where we wanna go Call System_AllocateMessages 'allow commands become enabled (save is save) End If PaletteChangeError: End Sub Private Sub GUIC_ShowStepDescription(ByVal GUICPaletteNumber As Integer, ByVal ForceShowingFlag As Boolean) 'on error resume next ' 'NOTE: the program message system is used to display the StepDescription 'when the 'step controls' are completely visible. 'NOTE: a StepDescription is displayed once only, the user can review it through 'the 'Plug-Ins'-menu. ' If (GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(GUICStructVar.GUIPaletteNumberCurrent) = False) Or (ForceShowingFlag = True) Then ' 'NOTE: GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray() is accessed when 'processing the message, do not set this flag when adding the message as it is not save that it is processed. ' Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:" + LTrim$(Str$(GUICPaletteNumber))) End If End Sub Private Sub GUIC_ShowANT(ByVal GUICPaletteNumber As Integer) 'verify If ANTStructVar.ANTSystemDisabledFlag = True Then Exit Sub If ProgramCommandStructVar.ExtendedHelpEnabledFlag = True Then Exit Sub 'begin Select Case GUICPaletteNumber Case 1 If (Len(ProgramCommandStructVar.AddDir)) Or _ (Len(ProgramCommandStructVar.ScanDir)) Then Call GUIC_ProcessANT(101) 'do you want to add another dir? Else Call GUIC_ProcessANT(-1) 'howdy! End If Case 2 Call GUIC_ProcessANT(9) Case 3 Call GUIC_ProcessANT(13) Case 4 Call GUIC_ProcessANT(16) Case 5 Call GUIC_ProcessANT(17) Case 6 Call GUIC_ProcessANT(21) Case 7 Call GUIC_ProcessANT(25) Case 8 Call GUIC_ProcessANT(28) Case 9 Call GUIC_ProcessANT(40) Case 10 Call GUIC_ProcessANT(43) Case 11 Call GUIC_ProcessANT(46) Case 12 Call GUIC_ProcessANT(49) End Select Exit Sub End Sub Private Sub GUIC_ProcessANT(ByVal ANTNumber As Integer) Dim DirFormat As String 'verify If ANTStructVar.ANTSystemDisabledFlag = True Then Exit Sub If ProgramCommandStructVar.ExtendedHelpEnabledFlag = True Then Exit Sub 'begin Select Case ANTNumber Case -1 Call Msg_AddAndPack("display ContextHelp centered", "ANTINTRO") Case 3 Dim Dir As String Dim DirNumberMax As Integer Dim DirLoop As Integer ' DirNumberMax = Val(RegGetKeyValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\MediaPlayer\Preferences", "TrackFoldersDirectories")) For DirLoop = 1 To DirNumberMax Dir = RegGetKeyValue(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\MediaPlayer\Preferences", "TrackFoldersDirectories" + LTrim$(Str$(DirLoop - 1))) If Not (Right$(Dir, 1) = "\") Then Dir = Dir + "\" 'important, or dirs are not added (tested) If (GFFileAccess_IsFileExisting(Dir + "*.mp3") = True) Or _ (GFFileAccess_IsFileExisting(Dir + "*.wma") = True) Or _ (GFFileAccess_IsFileExisting(Dir + "*.wav") = True) Then 'verify there are files in the MP directories (important, or various errors will follow) Call GUI1DirList_AddItem(Dir, GetDriveSerialNumber(Dir), True) 'copied from GUI1ScanCommand_Click End If Next DirLoop ' 'copied from GUI1ScanCommand_Click >>> If DirNumberMax > 0 Then 'verify (would otherwise look stupid) Call Update_FileSystemStruct_DirsAdded 'display changes Call Msg_Add("FileSystemStructVar changed") 'display changes Call GUI1DirListToReg 'save changes End If '<<< ' If (GUI1CopyDirList.ListCount = 0) And (GUI1MoveDirList.ListCount = 0) Then Call GUIC_ProcessANT(100) 'no dir, dude Call GUIC_ProcessANT(0) 'begin of directory selection Else Call GUIC_ProcessANT(101) 'do you want to add another dir? 102=yes, 103=no End If Case 4 GUI1StructVar.UseDefaultMoveOrCopyFlag = True GUI1StructVar.DefaultMoveOrCopyFlag = True 'move Call GUI1ScanCommand_Click GUI1StructVar.UseDefaultMoveOrCopyFlag = False 'reset in any case if user aborted If (GUI1CopyDirList.ListCount = 0) And (GUI1MoveDirList.ListCount = 0) Then Call GUIC_ProcessANT(100) 'no dir, dude Call GUIC_ProcessANT(0) 'begin of directory selection Else Call GUIC_ProcessANT(101) 'do you want to add another dir? 102=yes, 103=no End If Case 5 GUI1StructVar.UseMegaScanTypeBits = True GUI1StructVar.MegaScanTypeBits = 1 'hds only GUI1StructVar.UseMegaScanMoveOrCopy = True GUI1StructVar.MegaScanMoveOrCopy = 2 'copy GUI1StructVar.FunFormQuakeDisabledFlag = True 'no effect (message queue not allocated) Call GUI1MegaScanCommand_Click GUI1StructVar.UseMegaScanMoveOrCopy = False 'reset in any case if user canceled GUI1StructVar.FunFormQuakeDisabledFlag = False 'reset in any case if user canceled If (GUI1CopyDirList.ListCount = 0) And (GUI1MoveDirList.ListCount = 0) Then Call GUIC_ProcessANT(100) 'no dir, dude Call GUIC_ProcessANT(0) 'begin of directory selection Else Call GUIC_ProcessANT(101) 'do you want to add another dir? 102=yes, 103=no End If Case 6 GUI1StructVar.UseMegaScanTypeBits = True GUI1StructVar.MegaScanTypeBits = 3 'network only GUI1StructVar.UseMegaScanMoveOrCopy = True GUI1StructVar.MegaScanMoveOrCopy = 2 'copy GUI1StructVar.FunFormQuakeDisabledFlag = True 'no effect (message queue not allocated) Call GUI1MegaScanCommand_Click GUI1StructVar.UseMegaScanMoveOrCopy = False 'reset in any case if user canceled GUI1StructVar.FunFormQuakeDisabledFlag = False 'reset in any case if user canceled If (GUI1CopyDirList.ListCount = 0) And (GUI1MoveDirList.ListCount = 0) Then Call GUIC_ProcessANT(100) 'no dir, dude Call GUIC_ProcessANT(0) 'begin of directory selection Else Call GUIC_ProcessANT(101) 'do you want to add another dir? 102=yes, 103=no End If Case 7 GUI1StructVar.UseDefaultMoveOrCopyFlag = True GUI1StructVar.DefaultMoveOrCopyFlag = False 'copy Call GUI1ScanCommand_Click GUI1StructVar.UseDefaultMoveOrCopyFlag = False 'reset in any case if user aborted If (GUI1CopyDirList.ListCount = 0) And (GUI1MoveDirList.ListCount = 0) Then Call GUIC_ProcessANT(100) 'no dir, dude Call GUIC_ProcessANT(0) 'begin of directory selection Else Call GUIC_ProcessANT(101) 'do you want to add another dir? 102=yes, 103=no End If Case 72 'ok for 'select music file dir, upload' GUI1StructVar.UseDefaultMoveOrCopyFlag = True GUI1StructVar.DefaultMoveOrCopyFlag = True 'move Call GUI1ScanCommand_Click GUI1StructVar.UseDefaultMoveOrCopyFlag = False 'reset in any case if user aborted If (GUI1CopyDirList.ListCount = 0) And (GUI1MoveDirList.ListCount = 0) Then Call GUIC_ProcessANT(100) 'no dir, dude Call GUIC_ProcessANT(0) 'begin of directory selection Else Call GUIC_ProcessANT(101) 'do you want to add another dir? 102=yes, 103=no End If Case 8 MsgBox "Think about it. Then come back.", vbOKOnly + vbExclamation Case 102 Call GUIC_ProcessANT(0) Case 103 Call GUIC_DoPaletteChange(2) Case 110 'try again Call GUIC_ProcessANT(1) 'where are the files to clean up? Case 9 If (QPfrm.Enabled = False) Or (QPfrm.Visible = False) Or (QPfrm.WindowState <> vbNormal) Then Call QPfrm.QP_Show Call ContextHelp_MakeSureVisible( _ QPfrm.QPList, _ QPfrm) Call MousePointer_Move(GetSEControlStructIndex("QPfrm.QPList"), True) Call Msg_AddAndPack("display ContextHelp centered", "ANT009") Case 90 'too lazy Call GUIC_DoPaletteChange(3) Case 91 'don't need to add a filter twice Call ContextHelp_MakeSureVisible( _ Mfrm.GUI2FilterList, _ Mfrm) Call MousePointer_Move(GetSEControlStructIndex("GUI2FilterList"), True) Call Msg_AddAndPack("display ContextHelp centered", "ANT091") Case 10 Call ContextHelp_MakeSureVisible( _ Mfrm.GFTextMarkerPicture, _ Mfrm) Call MousePointer_Move(GetSEControlStructIndex("GFTextMarkerPicture"), True) Call Msg_AddAndPack("display ContextHelp centered", "ANT010") Case 11 'I've already done that with all files Call GUIC_DoPaletteChange(3) Case 14 Call GUIC_DoPaletteChange(4) Case 15 'extended help on formatting options Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:3") Case 104 Call GUI4ReadCommand_Click Case 18 Call GUI5CheckCommand_Click GUI5StructVar.ANTHelpEnabledFlag = False 'if user presses 'X' then help stays disabled (do always before ANT #117 is displayed) If GUI5DefaultList.ListCount > 0 Then 'see also GUI5DefaultList_Reload Call ContextHelp_MakeSureVisible( _ Mfrm.GUI5DefaultList, _ Mfrm) Call MousePointer_Move(GetSEControlStructIndex("GUI5DefaultList"), True) Call GUIC_ProcessANT(117) End If Case 19 Call GUIC_DoPaletteChange(6) Case 20 Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:5") Case 22 Call GUI6CheckCommand_Click If GUI6DefaultList.ListCount > 0 Then Call ContextHelp_MakeSureVisible( _ Mfrm.GUI6DefaultList, _ Mfrm) Call MousePointer_Move(GetSEControlStructIndex("GUI6DefaultList"), True) Call GUIC_ProcessANT(221) End If Case 23 Call GUIC_DoPaletteChange(7) Case 24 Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:6") Case 26 Call GUI7CheckCommand_Click If GUI7ListView.ListCount > 0 Then Call GUIC_ProcessANT(125) 'help on how to 're-swap' End If Case 27 Call GUIC_DoPaletteChange(8) Case 29 GUI8NumerateOption.Value = True Call GUIC_ProcessANT(31) Case 30 GUI8OverwriteOption.Value = True Call GUIC_ProcessANT(31) Case 32 'tag, rename and move GUI8WriteTAGsCheck.Value = 1 GUI8RetainAllFileNamesCheck.Value = 0 GUI8RetainLongFileNamesCheck.Value = 0 GUI8FormatRetainedFileNamesCheck.Value = 0 Call GUIC_ProcessANT(35) 'delete empty source dirs? Case 33 'tag only GUI8WriteTAGsCheck.Value = 1 GUI8RetainAllFileNamesCheck.Value = 1 GUI8RetainLongFileNamesCheck.Value = 0 GUI8FormatRetainedFileNamesCheck.Value = 0 Call GUIC_ProcessANT(35) 'delete empty source dirs? Case 34 'rename and move only GUI8WriteTAGsCheck.Value = 0 GUI8RetainAllFileNamesCheck.Value = 0 GUI8RetainLongFileNamesCheck.Value = 0 GUI8FormatRetainedFileNamesCheck.Value = 0 Call GUIC_ProcessANT(35) 'delete empty source dirs? Case 310 'move to new dirs ONLY GUI8WriteTAGsCheck.Value = 0 GUI8RetainAllFileNamesCheck.Value = 1 GUI8RetainLongFileNamesCheck.Value = 0 GUI8FormatRetainedFileNamesCheck.Value = 0 Call GUIC_ProcessANT(35) 'delete empty source dirs? Case 36 'delete empty source directories GUI8DeleteEmptySourceFoldersCheck.Value = 1 Call System_DoEventsEx 'call check box change events DirFormat = DirFormat_Select(GUI8DirFormatText.TEXT + GUI8FileFormatText.TEXT) GUI8DirFormatText.TEXT = GetDirectoryName(DirFormat) GUI8FileFormatText.TEXT = GetFileName(DirFormat) Call System_DoEventsEx 'remove window trash Call GUI8CreateNewFileNamesCommand_Click Case 37 'don't delete empty source directories GUI8DeleteEmptySourceFoldersCheck.Value = 0 Call System_DoEventsEx 'call check box change events DirFormat = DirFormat_Select(GUI8DirFormatText.TEXT + GUI8FileFormatText.TEXT) GUI8DirFormatText.TEXT = GetDirectoryName(DirFormat) GUI8FileFormatText.TEXT = GetFileName(DirFormat) Call System_DoEventsEx 'remove window trash Call GUI8CreateNewFileNamesCommand_Click Case 41 'let user edit TAG data (step 9) Call GUI9ToolsCommand_Click Call GUIC_ProcessANT(140) 'more help? Case 42 Call GUIC_DoPaletteChange(10) Case 141 'no more help about step 9 editing (list number here or 'sorry, no context help for this item') Case 142 Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:9") Case 44 Call GUIC_DoPaletteChange(11) Case 45 'let user edit TAG data (step 10) Call GUIC_ProcessANT(143) 'more help? Case 144 'no more help about step 10 editing (list number here or 'sorry, no context help for this item') Case 145 Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:10") Case 47 'NOTE: we can't set multiple existing files handling options for multiple directories, 'so it is best to take 'retain', that won't copy doubled files again. GUI11ExistingFilesRetainOption.Value = True Call GUI11RenameCommand_Click Case 48 'user doesn't want to rename Case 50 'bye bye Unload Me 'shut system down Case 51 'what's done in step 12? Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:12") Case Else 'just display a GFContextHelp box Select Case ANTNumber Case 118, 119, 120 'NOTE: the user did not close previous question. Next time GUI5DefaultList reloads, 'open ANT help again (search for 'If GUI5StructVar.ANTHelpEnabledFlag = True Then' 'for more information). GUI5StructVar.ANTHelpEnabledFlag = True End Select Select Case ANTNumber 'could have been called previously if a mouse pointer animation was to be played Case 0 To 9 Call Msg_AddAndPack("display ContextHelp centered", "ANT00" + LTrim$(Str$(ANTNumber))) Case 10 To 99 Call Msg_AddAndPack("display ContextHelp centered", "ANT0" + LTrim$(Str$(ANTNumber))) Case 100 To 999 Call Msg_AddAndPack("display ContextHelp centered", "ANT" + LTrim$(Str$(ANTNumber))) End Select End Select Exit Sub End Sub Private Sub GUICurtain_Show() 'on error resume next ' 'NOTE: when changing the GUI palette then there will be a temporary visual chaos: '-VB control flickering '-half VB controls (broken windows) '-controls that appear and disappear ' (cannot be avoided without changing the whole GUI system) '-overlapping VB controls ' 'As the user wants to have the impression as if everything would be clean 'we secretly display a picture box with the image of the old palette '(hahahahihihihohoho). 'When doing changes on the Skin Engine then temporary disable the 'GUICurtain to verify any skinned application will also look good without curtain. ' 'preset 'NOTE: we count the calls of this sub to verify that the GUICurtain is not hidden too early '(important when the GUICurtain subs are called from a number of different sub systems). CurtainStructVar.GUICurtain_ShowSubCallNumber = CurtainStructVar.GUICurtain_ShowSubCallNumber + 1 If CurtainStructVar.GUICurtain_ShowSubCallNumber > 1 Then Exit Sub 'begin Call SE_DeletePictureBox(GUICurtainPicture) 'msbugsave Call GUICurtainPicture.Move(0, 0, Mfrm.Width, Mfrm.Height) GUICurtainPicture.AutoRedraw = True GUICurtainPicture.ScaleMode = vbPixels GUICurtainPicture.BackColor = SESystemStructVar.SystemBackColor GUICurtainPicture.Enabled = False GUICurtainPicture.TabStop = False Call BitBlt(GUICurtainPicture.hDC, 0, 0, GUICurtainPicture.ScaleWidth, GUICurtainPicture.ScaleHeight, _ GFAlphaBlendfrm.GFAlphaBlend_GetDesktopDC(), _ Mfrm.Left / Screen.TwipsPerPixelX, Mfrm.Top / Screen.TwipsPerPixelY, vbSrcCopy) GUICurtainPicture.Visible = True GUICurtainPicture.ZOrder 'set on top of Z order GUICurtainPicture.Refresh End Sub Private Sub GUICurtain_Hide() 'on error resume next ' 'NOTE: this sub should be called indirectly through a GFPMS message 'so that all WM_PAINT messages can be processed by the OS- and program system. ' 'verify If CurtainStructVar.GUICurtain_ShowSubCallNumber > 0 Then CurtainStructVar.GUICurtain_ShowSubCallNumber = CurtainStructVar.GUICurtain_ShowSubCallNumber - 1 End If If CurtainStructVar.GUICurtain_ShowSubCallNumber > 0 Then Exit Sub End If 'begin GUICurtainPicture.Visible = False GUICurtainPicture.Refresh Call SystemForms_Redraw 'important (tested, ContextHelp slows down palette changing -> frame salad) Call SE_DeletePictureBox(GUICurtainPicture) GUICurtainPicture.AutoRedraw = False 'save memory End Sub Private Sub GUICurtain_HideEx() 'on error resume next 'hide GUICurtain in any case (function similar to GUI_ContinueEx) CurtainStructVar.GUICurtain_ShowSubCallNumber = 0 'reset Call GUICurtain_Hide End Sub Private Sub GUICurtain_Size(ByVal XSizeNew As Single, ByVal YSizeNew As Single) 'on error resume next 'call to resize the GUICurtain, when Mfrm is resized GUICurtainPicture.Width = XSizeNew GUICurtainPicture.Height = YSizeNew GUICurtainPicture.Refresh End Sub Private Sub GUICStruct_Update(ByRef GUICStructVar As GUICStruct) 'on error Resume Next Dim StructLoop As Integer ' 'NOTE: this sub sets the values of '-GUICStructVar.PaletteIndexMin and '-GUICStructVar.PaletteIndexMax 'Also pop up menu items are enabled/disabled. 'Call this sub whenever the amount of available steps has changed or 'to refresh the pop up menu items. ' 'IMPORTANT: GUICStructVar.PaletteIndexMax must never be smaller than 'the current palette number or the user will get stuck in the current step. 'GUICStructVar.PaletteIndexMax could get smaller if there's one 'scan directory on cdrom and the cd is not inserted and GUI4 code 'removes the one and only scan directory. 'In this case GUICStructVar.PaletteIndexMax must not be smaller than 4 '(tested). ' 'reset For StructLoop = 1 To MENUfrm.M5.UBound MENUfrm.M5(StructLoop).Enabled = False 'reset Next StructLoop 'begin GUICStructVar.GUIPaletteStartIndex = 1 If FileSystemStructVar.SourceDirNumber = 0 Then 'NOTE: user must select at least one scan directory to continue. GUICStructVar.GUIPaletteEndIndex = STUFF_MAX(1, GUICStructVar.GUIPaletteNumberCurrent) MENUfrm.M5(1).Enabled = True GoTo Leave: End If If FilterStructNumber = 0 Then 'NOTE: user must create at least one file name filter to continue. GUICStructVar.GUIPaletteEndIndex = STUFF_MAX(2, GUICStructVar.GUIPaletteNumberCurrent) MENUfrm.M5(1).Enabled = True MENUfrm.M5(2).Enabled = True GoTo Leave: End If If (GUI3StructVar.CutStructInitializedFlag = False) Or (GUI3StructVar.ReplaceStructInitializedFlag = False) Or _ (GUI3StructVar.NoUCaseStructInitializedFlag = False) Or (GUI3StructVar.NoLCaseStructInitializedFlag = False) Or _ (GUI3StructVar.ExpressionStructInitializedFlag = False) Then 'NOTE: the user must visit step 3 at least once per program execution. ' 'NOTE: the difference between checking the GUI[1, 2, 3]StructVar initialized 'flags and such vars like FileInfoStructNumber is that the valid state of 'FileInfoStructNumber can change at any time but the valid state of the 'GUI[1, 2, 3]StructVar initialized flags always stays True after it has been 'been set to True once. ' 'That means the user must visit step 3 only once but step 1, 2 and 4 'every time data is missing. ' GUICStructVar.GUIPaletteEndIndex = STUFF_MAX(3, GUICStructVar.GUIPaletteNumberCurrent) MENUfrm.M5(1).Enabled = True MENUfrm.M5(2).Enabled = True MENUfrm.M5(3).Enabled = True GoTo Leave: End If If FileInfoStructNumber = 0 Then 'NOTE: user must collect file data to continue. GUICStructVar.GUIPaletteEndIndex = STUFF_MAX(4, GUICStructVar.GUIPaletteNumberCurrent) MENUfrm.M5(1).Enabled = True MENUfrm.M5(2).Enabled = True MENUfrm.M5(3).Enabled = True MENUfrm.M5(4).Enabled = True GoTo Leave: End If For StructLoop = 1 To FileInfoStructNumber If FileInfoStructArray(StructLoop).FileNameNew(1) = 0 Then 'NOTE: user must (re-) create the new file names to continue. GUICStructVar.GUIPaletteEndIndex = STUFF_MAX(8, GUICStructVar.GUIPaletteNumberCurrent) MENUfrm.M5(1).Enabled = True MENUfrm.M5(2).Enabled = True MENUfrm.M5(3).Enabled = True MENUfrm.M5(4).Enabled = True MENUfrm.M5(5).Enabled = True MENUfrm.M5(6).Enabled = True MENUfrm.M5(7).Enabled = True MENUfrm.M5(8).Enabled = True GoTo Leave: End If Next StructLoop If 0 = 0 Then GUICStructVar.GUIPaletteEndIndex = STUFF_MAX(12, GUICStructVar.GUIPaletteNumberCurrent) MENUfrm.M5(1).Enabled = True MENUfrm.M5(2).Enabled = True MENUfrm.M5(3).Enabled = True MENUfrm.M5(4).Enabled = True MENUfrm.M5(5).Enabled = True MENUfrm.M5(6).Enabled = True MENUfrm.M5(7).Enabled = True MENUfrm.M5(8).Enabled = True MENUfrm.M5(9).Enabled = True MENUfrm.M5(10).Enabled = True MENUfrm.M5(11).Enabled = True MENUfrm.M5(12).Enabled = True GoTo Leave: End If Leave: Exit Sub End Sub Private Sub GUIC_RefreshCommands(ByRef GUICStructVar As GUICStruct) 'on error Resume Next 'NOTE: it is important to be able to call this sub separately from GUIC_Refresh(). Dim GUINextCommandEnabledFlag As Boolean Dim CommandControlStructIndex As Integer Dim CommandCaption As String ' 'NOTE: if GUINextCommand is disabled then its caption is set 'to a help text giving information what is to be done before continuing. ' 'enable/disable commands Select Case GUICStructVar.GUIPaletteNumberCurrent Case 11 'NOTE: the user must still be able to go to step 12 after having renamed files. If FileInfoStructNumber = 0 Then GUIBackCommand.Enabled = False GUINextCommand.Enabled = True GUINextCommandEnabledFlag = True Else GUIBackCommand.Enabled = True GUINextCommand.Enabled = True GUINextCommandEnabledFlag = True End If Case Is = GUICStructVar.GUIPaletteStartIndex GUIBackCommand.Enabled = False GUINextCommand.Enabled = True GUINextCommandEnabledFlag = True Case Is = GUICStructVar.GUIPaletteEndIndex GUIBackCommand.Enabled = True GUINextCommand.Enabled = False GUINextCommandEnabledFlag = False Case Else GUIBackCommand.Enabled = True GUINextCommand.Enabled = True GUINextCommandEnabledFlag = True End Select If (GUICStructVar.GUIPaletteStartIndex = GUICStructVar.GUIPaletteEndIndex) Then 'NOTE: disable commands afterwards as Select Case-statement was used to update GUICStructVar data. GUIBackCommand.Enabled = False GUINextCommand.Enabled = False GUINextCommandEnabledFlag = False End If 'show help text in GUINextCommand If GUINextCommandEnabledFlag = False Then 'don't use command property as .Enabled = False also if form disabled :-( Select Case GUICStructVar.GUIPaletteNumberCurrent Case 1 CommandCaption = "Please add a directory" Case 2 CommandCaption = "Please create a filter" Case 3 CommandCaption = "Please verify settings" Case 4 CommandCaption = "Please read file data" Case 8 CommandCaption = "Please create names" Case Else CommandCaption = "Next" End Select Else CommandCaption = "Next" End If CommandControlStructIndex = GetSEControlStructIndex("GUINextCommandFixed") '...Movable not captioned as never disabled If (CommandControlStructIndex) Then 'verify SEControlStructArray(CommandControlStructIndex).SEControl_Caption = CommandCaption Call SE_UnloadControl( _ SEControlStructArray(CommandControlStructIndex).SEControlName, _ CommandControlStructIndex) Call SE_LoadControl( _ SEControlStructArray(CommandControlStructIndex).SEControlName, _ True, CommandControlStructIndex) 'create picture with new caption Call SE_RefreshControl( _ SEControlStructArray(CommandControlStructIndex).SEControlName, _ GetSEControlState(SEControlStructArray(CommandControlStructIndex).SEControlName), _ CommandControlStructIndex) 'NOTE: don't save caption as permanently recreated (needn't to be saved, faster). End If End Sub Private Function GUIC_VerifyPaletteNumber(ByRef PaletteNumber As Integer) As Boolean 'on error Resume Next 'returns True if passed palette number has been changed, True if it is valid 'preset GUIC_VerifyPaletteNumber = True 'ok 'begin Select Case PaletteNumber Case 12 'allowed as otherwise the user couldn't get to step 12 when renamed files Case Is < GUICStructVar.GUIPaletteStartIndex ' PaletteNumber = GUICStructVar.GUIPaletteStartIndex GUIC_VerifyPaletteNumber = False 'error ' Case Is > GUICStructVar.GUIPaletteEndIndex ' PaletteNumber = GUICStructVar.GUIPaletteEndIndex GUIC_VerifyPaletteNumber = False 'error ' End Select End Function Private Sub GUIC_Refresh(ByRef GUICStructVar As GUICStruct) 'on error Resume Next 'call to display an other GUI palette ' 'If Not (GUICStructVar.GUIPaletteNumberCurrent = GUICStructVar.GUIPaletteNumberOld) Then 'important 'no! 'End If ' Call GUI_Wait If GUIPalette_PrepareChange(GUICStructVar.GUIPaletteNumberOld, GUICStructVar.GUIPaletteNumberCurrent) = True Then If ActionTrack_Verify(GUICStructVar.GUIPaletteNumberOld, GUICStructVar.GUIPaletteNumberCurrent, ActionTrackStructVar) = True Then Call GUICurtain_Show 'hide this visual mess that follows now ' GUICStructVar.GUIPaletteChangingFlag = True ' Call GUIPalette_BeforeChange(GUICStructVar.GUIPaletteNumberOld, GUICStructVar.GUIPaletteNumberCurrent) If Not (GUICStructVar.GUIPaletteNumberCurrent = GUICStructVar.GUIPaletteNumberOld) Then 'NOTE: refresh the controls if the palette stays the same, but do not hide and show them. Call GUIPalette_Refresh(GUICStructVar.GUIPaletteNumberCurrent, Mfrm) End If ' 'NOTE: execute the GUIC palette change code before executing the 'Skin Engine palette change code as this looks much better when 'Mfrm's size is about to chenge. ' If (GUICStructVar.ForceRedrawFlag = True) Or (GUICStructVar.ForceSkinDataFileReloadFlag = True) Then ' 'NOTE: MP3 Renamer 2 only reloads the SkinDataFile at start up, 'when Mfrm is not visible yet and thus the user has no control. 'Therefore Mfrm can be enabled to avoid that all SECommands are 'displayed as disabled. ' Mfrm.Enabled = True End If If GUICStructVar.SkinEnginePaletteChangeDisabledFlag = False Then 'enable if e.g. ConfigSet was changed 'NOTE: make SE update palette first, as e.g. picture boxes will be cleared if their back color is changed. Call SE_DisplayPalette(GUICStructVar.GUIPaletteNumberOld, GUICStructVar.GUIPaletteNumberCurrent, GUICStructVar.ForceRedrawFlag, GUICStructVar.ForceSkinDataFileReloadFlag, _ False, True) 'do not unload controls of old palette End If If (GUICStructVar.ForceRedrawFlag = True) Or (GUICStructVar.ForceSkinDataFileReloadFlag = True) Then Mfrm.Enabled = False GUICStructVar.ForceRedrawFlag = False 'reset GUICStructVar.ForceSkinDataFileReloadFlag = False 'reset End If If GUICStructVar.SkinEnginePaletteChangeDisabledFlag = False Then 'enable if e.g. ConfigSet was changed 'NOTE: unload controls after they have been hidden to avoid ugly drawing errors. Call SE_UnloadPaletteControls(GUICStructVar.GUIPaletteNumberOld, GUICStructVar.GUIPaletteNumberCurrent) End If Call GUIPalette_AfterChange(GUICStructVar.GUIPaletteNumberOld, GUICStructVar.GUIPaletteNumberCurrent) ' GUICStructVar.GUIPaletteChangingFlag = False 'reset ' Call Msg_Add("Call GUICurtain_HideEx") Else GUICStructVar.GUIPaletteNumberCurrent = GUICStructVar.GUIPaletteNumberOld End If Else GUICStructVar.GUIPaletteNumberCurrent = GUICStructVar.GUIPaletteNumberOld End If Call GUI_Continue End Sub Private Function GUIPalette_PrepareChange(ByVal GUIPaletteNumberOld As Integer, ByVal GUIPaletteNumberNew As Integer) As Boolean 'on error Resume Next 'event, called before a palette is replaced through an other one, note that the palette change may be avoid through code in this sub Dim MousePointerUnchanged As Integer ' 'NOTE: if this function returns False the GUI Palette will not be changed. ' 'preset GUIPalette_PrepareChange = True 'ok 'begin Select Case GUIPaletteNumberOld Case 1 ' 'too slow, written to registry when changes are done '(also read only once in GUIPalette_BeforeChange()) ' If (CSETfrm.Enabled) And (CSETfrm.Visible) Then Call MfrmEnabled.MfrmEnabled_SetFocus 'important (when using Ctrl-N, Mfrm disabled) Call CSETfrm.GFPopUpWindow_Hide 'important (tested) Call SystemForms_Redraw 'important (remove window trash) End If ' Case 2 ' 'too slow, written to registry when changes are done '(also read only once in GUIPalette_BeforeChange()) ' If (CSETfrm.Enabled) And (CSETfrm.Visible) Then Call MfrmEnabled.MfrmEnabled_SetFocus 'important (when using Ctrl-N, Mfrm disabled) Call CSETfrm.GFPopUpWindow_Hide 'important (tested) Call SystemForms_Redraw 'important (remove window trash) End If ' If Not (FileInfoStructNumber = 0) Then If (ConfigSetStructVar.ConfigSetChangingFlag = False) And (GUICStructVar.ConfigSetChangingFlag = False) Then If (CSETfrm.UserConfigSetCreatingFlag = False) And (CSETfrm.UserConfigSetDeletingFlag = False) And (CSETfrm.UserConfigSetRenamingFlag = False) Then If GUI2ChangeDedect_WasChanged = True Then If GUI2StructVar.FilterChangeInfoMessageDisplayedFlag = False Then GUI2StructVar.FilterChangeInfoMessageDisplayedFlag = True MsgBox "Note that you must re-read all file data (step 4) to allocate the file names using the new FileNameFilter settings.", vbOKOnly + vbInformation End If Call GUI2ChangeDedect_Save 'only if a change was detected, not just when palette was changed (otherwise change not recognized when changing configuration) End If End If End If End If ' Case 3 ' 'NOTE: the user cannot go forward to step 4 if the back slash 'isn't cut out or replaced in any TAG item. 'The user can also not continue if the replace settings create 'an endless loop (tested in GUI3_FormatReplaceStruct()). ' If (CSETfrm.Enabled) And (CSETfrm.Visible) Then Call MfrmEnabled.MfrmEnabled_SetFocus 'important (when using Ctrl-N, Mfrm disabled) Call CSETfrm.GFPopUpWindow_Hide 'important (tested) Call SystemForms_Redraw 'important (remove window trash) End If ' Call GUI3CutCharText_LostFocus 'important Call GUI3ReplaceCharText_LostFocusSub(False, True) 'important (update ReplaceStructArray() but formatting done below) Call GUI3NoUCaseText_LostFocus 'important Call GUI3NoLCaseText_LostFocus 'important Call GUI3ExpressionText_LostFocus 'important ' If GUIPalette_PrepareChange = True Then 'verify there's no error yet 'If GUIPaletteNumberNew > GUIPaletteNumberOld Then 'display error message if wanting to go forwards only; no! (why?) If GUI3_IsBackSlashReplaced = False Then GUIPalette_PrepareChange = False 'the back slash is not replaced End If 'End If End If ' If GUIPalette_PrepareChange = True Then 'verify there's no error yet 'If GUIPaletteNumberNew > GUIPaletteNumberOld Then 'display error message if wanting to go forwards only; no! (why?) Select Case GUI3_FormatReplaceStruct(ReplaceStructNumber, ReplaceStructArray()) Case 1 'error GUIPalette_PrepareChange = False 'there's an endless loop Case False 'no changes existing Call GUI3ReplaceCharText_LostFocusSub(False, False) 'don't reformat, don't transfer data to text box Case True 'changes existing Call GUI3ReplaceCharText_LostFocusSub(False, True) 'don't reformat, but transfer data to text box End Select 'End If End If ' If GUIPalette_PrepareChange = True Then 'verify there's no error yet If Not (FileInfoStructNumber = 0) Then If (ConfigSetStructVar.ConfigSetChangingFlag = False) And (GUICStructVar.ConfigSetChangingFlag = False) Then If (CSETfrm.UserConfigSetCreatingFlag = False) And (CSETfrm.UserConfigSetDeletingFlag = False) And (CSETfrm.UserConfigSetRenamingFlag = False) Then If Not ( _ (GUI3CutCharText.TEXT = GUI3StructVar.CutTextUnchanged) And _ (GUI3ReplaceCharText.TEXT = GUI3StructVar.ReplaceTextUnchanged) And _ (GUI3NoLCaseText.TEXT = GUI3StructVar.NoLCaseTextUnchanged) And _ (GUI3NoUCaseText.TEXT = GUI3StructVar.NoUCaseTextUnchanged) And _ (GUI3ExpressionText.TEXT = GUI3StructVar.ExpressionTextUnchanged)) Then If MsgBox("Note that you must re-read all music files (step 4) to make the changes take effect." + Chr$(10) + _ "Alternatively you can make Toricxs now re-format (not re-read) the TAG data so that changes you already did are not all made rejected. But note that it can happen that when you for instance manually set a special capitalization for some files that then the capitalization is reset. Do you agree to re-formatting ?", vbYesNo + vbQuestion) = vbYes Then ' MousePointerUnchanged = Mfrm.MousePointer Mfrm.MousePointer = vbHourglass 'NOTE: we must load the options from step 8 or creating new file names will not work. Call GUI8FromReg 'registry data to controls If ((GUI8ToOptionsStruct(OptionsStructVar) = True) And (GUI8ToFileSystemStruct(FileSystemStructVar) = True)) Then 'control data to structures Call SystemManualMessage_Show("Reformatting, please wait...") Call FileInfoStruct_Reformat(FileInfoStructNumber, FileInfoStructArray()) Call NewFiles_Create(False) 'important, will also use SG system Mfrm.MousePointer = MousePointerUnchanged 'reset ' If MsgBox("Do you want to have a quick look at the new format of your music files ?", vbYesNo + vbQuestion) = vbYes Then Call SystemForms_Redraw 'by MsgBox Call QL_Show 'temporary disables other forms If MsgBox("Are you satisfied with the result or do you want to change the formatting options (press 'Yes' to change) ?", vbYesNo + vbQuestion) = vbYes Then GUIPalette_PrepareChange = False End If End If Else Mfrm.MousePointer = MousePointerUnchanged 'reset MsgBox "Unfortunately there's something wrong with the file name format or directory format, reformatting is not possible (check settings in step 8).", vbOKOnly + vbInformation End If End If GUI3StructVar.CutTextUnchanged = GUI3CutCharText.TEXT 'only if a change was detected, not just when palette is changed GUI3StructVar.ReplaceTextUnchanged = GUI3ReplaceCharText.TEXT GUI3StructVar.NoLCaseTextUnchanged = GUI3NoLCaseText.TEXT GUI3StructVar.NoUCaseTextUnchanged = GUI3NoUCaseText.TEXT GUI3StructVar.ExpressionTextUnchanged = GUI3ExpressionText.TEXT End If End If End If End If End If ' Case 5 If GUI5_Lost = False Then GUIPalette_PrepareChange = False Else If Update_WasUsed = True Then If GUI8_IsAnyNewFileNameCreated(FileInfoStructNumber, FileInfoStructArray()) = True Then 'don't create new file names if not necessary (confusing) Call NewFiles_Create(False) End If End If End If Case 6 If GUI6_Lost = False Then GUIPalette_PrepareChange = False Else If Update_WasUsed = True Then If GUI8_IsAnyNewFileNameCreated(FileInfoStructNumber, FileInfoStructArray()) = True Then 'don't create new file names if not necessary (confusing) Call NewFiles_Create(False) End If End If End If Case 7 Call GUI7ToReg 'list view column width If GUI7_Lost = False Then GUIPalette_PrepareChange = False Else If Update_WasUsed = True Then If GUI8_IsAnyNewFileNameCreated(FileInfoStructNumber, FileInfoStructArray()) = True Then 'don't create new file names if not necessary (confusing) Call NewFiles_Create(False) End If End If End If Case 8 ' If (CSETfrm.Enabled) And (CSETfrm.Visible) Then Call MfrmEnabled.MfrmEnabled_SetFocus 'important (when using Ctrl-N, Mfrm disabled) Call CSETfrm.GFPopUpWindow_Hide 'important (tested) Call SystemForms_Redraw 'important (remove window trash) End If ' If (ConfigSetStructVar.ConfigSetChangingFlag = False) And (GUICStructVar.ConfigSetChangingFlag = False) Then If (CSETfrm.UserConfigSetCreatingFlag = False) And (CSETfrm.UserConfigSetDeletingFlag = False) And (CSETfrm.UserConfigSetRenamingFlag = False) Then If Not ( _ (GUI8FileFormatText.TEXT = GUI8StructVar.FileFormatTextUnchanged) And _ (GUI8DirFormatText.TEXT = GUI8StructVar.DirFormatTextUnchanged) And _ (GUI8NumerateOption.Value = GUI8StructVar.NumerateOrOverwriteFlagUnchanged) And _ ((GUI8RetainAllFileNamesCheck.Value = 1) = GUI8StructVar.RetainAllFileNamesFlag) And _ ((GUI8RetainLongFileNamesCheck.Value = 1) = GUI8StructVar.RetainLongFileNamesFlag) And _ ((GUI8FormatRetainedFileNamesCheck.Value = 1) = GUI8StructVar.FormatRetainedFileNamesFlag) And _ ((GUI8WriteTAGsCheck.Value = 1) = GUI8StructVar.WriteTAGsFlag)) Then If GUI8_IsAnyNewFileNameCreated(FileInfoStructNumber, FileInfoStructArray()) = True Then 'If MsgBox("You must re-create all file names when you change the file name layout (no harms to the TAG data, but takes time). Continue ?", vbYesNo + vbQuestion) = vbYes Then 'don't ask, just do it (don't confuse user) Call GUI8CreateNewFileNamesCommand_Click GUI8StructVar.FileFormatTextUnchanged = GUI8FileFormatText.TEXT 'reset (for next usage); only if a change has been recognized, not just when palette was changed (or no change detected when changing current configuration) GUI8StructVar.DirFormatTextUnchanged = GUI8DirFormatText.TEXT 'reset (for next usage) GUI8StructVar.NumerateOrOverwriteFlagUnchanged = GUI8NumerateOption.Value 'reset (for next usage) GUI8StructVar.RetainAllFileNamesFlag = (GUI8RetainAllFileNamesCheck.Value = 1) GUI8StructVar.RetainLongFileNamesFlag = (GUI8RetainLongFileNamesCheck.Value = 1) GUI8StructVar.FormatRetainedFileNamesFlag = (GUI8FormatRetainedFileNamesCheck.Value = 1) GUI8StructVar.WriteTAGsFlag = (GUI8WriteTAGsCheck.Value = 1) 'Else ' MsgBox "Please set folder for your new collection and the file name format as well as the handling of doubled files. Then re-create new file names by pressing the 'Create new file names' button.", vbOKOnly + vbInformation ' GUIPalette_PrepareChange = False 'don't change palette, but also don't save so that a confused user can restore old settings through restarting (?!?) 'End If ' 'NOTE: the following code produces an error, the config set settings get screwed up. 'I didn't get that working with re-selecting last settings, so we just do nothing (hehe ;-P ). ' ' Else ' GUI8FileFormatText.TEXT = GUI8StructVar.FileFormatTextUnchanged 'reset ' GUI8DirFormatText.TEXT = GUI8StructVar.DirFormatTextUnchanged 'reset ' GUI8NumerateOption.Value = GUI8StructVar.NumerateOrOverwriteFlagUnchanged 'reset ' 'retained file names stuff here ' End If End If End If End If End If ' If GUIPalette_PrepareChange = True Then 'verify there's no error yet Call GUI8ToReg 'important (tested, do not do in any _Click or _Change event to avoid saving ALL current states when ONE control property was changed (loaded)) GUIPalette_PrepareChange = ((GUI8ToOptionsStruct(OptionsStructVar) = True) And (GUI8ToFileSystemStruct(FileSystemStructVar) = True)) End If ' Case 9 If Update_WasUsed = True Then Call NewFiles_Create(False) End If If (SystemForms_IsSystemFormLoaded(LWCfrm)) Then If (LWCfrm.Enabled) And (LWCfrm.Visible) Then GUI9StructVar.LWCfrmClosedBySystemFlag = True Call LWCfrm.LWC_Hide End If End If Call GUI9_Lost Call GUI9ToReg 'list view column width Case 10 Call GUI10_Lost Call GUI10ToReg 'list view column width Case 11 Call GUI11ToReg Case 12 Call GUI12_Lost Call GUI12ToReg Case 99 'used when exitting program, do nothing End Select End Function Private Sub GUIPalette_BeforeChange(ByVal GUIPaletteNumberOld As Integer, ByVal GUIPaletteNumberNew As Integer) 'on error Resume Next 'event, called before the palette items are shown/hidden ' 'NOTE: initialize controls here. ' Select Case GUIPaletteNumberNew Case 1 Call GUI1_Reset Call ConfigSet_ReceiveRegKey(HKEY_LOCAL_MACHINE, RegRootKey + "Scan Directories\") Call ConfigSetList_Reload Call Abort_Disable 'verify Call FileSystemStruct_Sort(FileSystemStructVar) 'sort before loading from Registry If (FileSystemStructVar.SourceDirNumber = 0) Or (GUICStructVar.ConfigSetChangingFlag = True) Then Call GUI1DirListFromReg 'load only if necessary Else Call GUI1DirList_Reload(FileSystemStructVar) End If Case 2 Call GUI2_Reset Call ConfigSet_ReceiveRegKey(HKEY_LOCAL_MACHINE, RegRootKey + "File Name Filters\") Call ConfigSetList_Reload Call Abort_Disable 'verify Call FileSystemStruct_Sort(FileSystemStructVar) If (FilterStructNumber = 0) Or (GUICStructVar.ConfigSetChangingFlag = True) Then Call FilterStructFromReg 'load only if necessary (slow) Else Call GUI2FilterList_Reload(FilterStructNumber, FilterStructArray()) End If If Not (GUIPaletteNumberOld = 2) Then 'not if current configuration was changed Call GUI2ChangeDedect_Save End If Case 3 Call GUI3_Reset Call ConfigSet_ReceiveRegKey(HKEY_LOCAL_MACHINE, RegRootKey + "GUI3\") Call ConfigSetList_Reload If OptionsStructVar.FirstProgramStartUpFlag = True Then 'NOTE: it is important for the ContextHelp that there's some example stuff in the boxes. Call GUI3CutCharDefaultCommand_Click Call GUI3HTMLCommand_Click Call GUI3NoUCaseDefaultCommand_Click Call GUI3NoLCaseDefaultCommand_Click Call GUI3ExpressionDefaultCommand_Click End If Call GUI3FromReg If Not (GUIPaletteNumberOld = 3) Then 'not if current configuration was changed GUI3StructVar.CutTextUnchanged = GUI3CutCharText.TEXT GUI3StructVar.ReplaceTextUnchanged = GUI3ReplaceCharText.TEXT GUI3StructVar.NoLCaseTextUnchanged = GUI3NoLCaseText.TEXT GUI3StructVar.NoUCaseTextUnchanged = GUI3NoUCaseText.TEXT GUI3StructVar.ExpressionTextUnchanged = GUI3ExpressionText.TEXT End If Case 4 Call GUI4_Reset Call GUI4FromReg Call Abort_Disable 'verify Case 5 GuideStructVar.GUI5SongNameCheckedFlag = False 'reset (cannot be done in GUI5_Reset) GuideStructVar.GUI5ArtistNameCheckedFlag = False 'reset (cannot be done in GUI5_Reset) Call GUI5_Reset Call GUI5ItemTypeCombo_Click 'see annotation there Call Abort_Disable 'verify Call Update_ResetUsedFlag 'used to determine if new file names must be created Case 6 GuideStructVar.GUI6SongNameCheckedFlag = False 'reset (cannot be done in GUI5_Reset) GuideStructVar.GUI6ArtistNameCheckedFlag = False 'reset (cannot be done in GUI5_Reset) Call GUI6_Reset Call GUIXProgressLabel_Reset Call GUI6ItemTypeCombo_Click 'see annotation there Call Abort_Disable 'verify Call Update_ResetUsedFlag 'used to determine if new file names must be created Case 7 Call GUI7_Reset Call GUI7FromReg Call Abort_Disable 'verify Call Update_ResetUsedFlag 'used to determine if new file names must be created Case 8 Call GUI8_Reset Call GUI8FromReg Call GUI8ToFileSystemStruct(FileSystemStructVar) 'important for SG system, FileSystemStructVar data must partially be set, do not check return value, system does not require that Call Abort_Disable 'verify If Not (GUIPaletteNumberOld = 8) Then 'not if current configuration was changed GUI8StructVar.FileFormatTextUnchanged = GUI8FileFormatText.TEXT 'preset (important) GUI8StructVar.DirFormatTextUnchanged = GUI8DirFormatText.TEXT 'preset (important) GUI8StructVar.NumerateOrOverwriteFlagUnchanged = GUI8NumerateOption.Value 'preset (important) GUI8StructVar.RetainAllFileNamesFlag = (GUI8RetainAllFileNamesCheck.Value = 1) GUI8StructVar.RetainLongFileNamesFlag = (GUI8RetainLongFileNamesCheck.Value = 1) GUI8StructVar.FormatRetainedFileNamesFlag = (GUI8FormatRetainedFileNamesCheck.Value = 1) GUI8StructVar.WriteTAGsFlag = (GUI8WriteTAGsCheck.Value = 1) End If Case 9 Call GUI9_Reset Call GUI9FromReg Call GUI9ListView_Reload(FileInfoStructNumber, FileInfoStructArray()) Call ProgramMaximizeCommand_Refresh Call ProgramRestoreCommand_Refresh Call Update_ResetUsedFlag 'used to determine if new file names must be created Case 10 Call GUI10_Reset Call GUI10FromReg Call GUI10TreeView_Reload(FileInfoStructNumber, FileInfoStructArray()) Call GUI10TreeView.ExpandAll 'when changed step only Call ProgramMaximizeCommand_Refresh Call ProgramRestoreCommand_Refresh Case 11 Call GUI11_Reset Call GUI11FromReg Call Abort_Disable 'verify Case 12 Call GUI12_Reset Call GUI12FromReg End Select ' Call StepLabel_Update(GUIPaletteNumberOld, GUIPaletteNumberNew) ' End Sub Private Sub StepLabel_Update(ByVal GUIPaletteNumberOld As Integer, ByVal GUIPaletteNumberNew As Integer) 'on error Resume Next 'update the StepLabel (the label hanging around in bottom right form corner) 'reset Call SystemMessage_Hide 'reset (important, or old caption will overwrite newly set one) 'begin Select Case GUIPaletteNumberNew Case 1 StepLabel.Caption = SE_GetSystemText(101) Case 2 StepLabel.Caption = SE_GetSystemText(102) Case 3 StepLabel.Caption = SE_GetSystemText(103) Case 4 StepLabel.Caption = SE_GetSystemText(104) Case 5 StepLabel.Caption = SE_GetSystemText(105) Case 6 StepLabel.Caption = SE_GetSystemText(106) Case 7 StepLabel.Caption = SE_GetSystemText(107) Case 8 StepLabel.Caption = SE_GetSystemText(108) Case 9 StepLabel.Caption = SE_GetSystemText(109) Case 10 StepLabel.Caption = SE_GetSystemText(110) Case 11 StepLabel.Caption = SE_GetSystemText(111) Case 12 StepLabel.Caption = SE_GetSystemText(112) End Select End Sub Private Sub GUIPalette_AfterChange(ByVal GUIPaletteNumberOld As Integer, ByVal GUIPaletteNumberNew As Integer) 'on error Resume Next 'event, called after the palette items are shown/hidden ' 'NOTE: hide special controls here. ' Select Case GUIPaletteNumberNew Case 4 Call GUI4_Refreshed 'like GUI4_Reset or GUI4_Lost Call GUI4_ControlGroup_Disable 'do after palette controls have been shown by GUI system Call GUI4_ControlGroup_ShowEx(GUI4_CONTROLGROUP_BEFOREREAD) 'NOTE: update the color slider as late as possible so that the Skin Engine already set the back color of the color slider (legend) picture box (tested). Call FileSystemStruct_Sort(FileSystemStructVar) 'before initializing ColorSlider Call GUIXColorSlider_Initialize(GUIXColorSlider, GUIXColorSliderPaletteCurrent, FileSystemStructVar, FileInfoStructNumber, FileInfoStructArray()) Call GUIXColorSlider.GFColorSlider_Verify Call GUIXColorSlider.GFColorSlider_ShowProgress(GUIXColorSliderPicture, 0) Call GUIXColorSlider.GFColorSlider_ShowAreaLegend(GUIXColorSliderLegendPicture, 2, 2, GUIXColorSliderLegendPicture.Width / Screen.TwipsPerPixelX - 4, GUIXColorSliderLegendPicture.Height / Screen.TwipsPerPixelY - 4, GUIXColorSliderPaletteCurrent, 1) Case 5 GUIXAnimationControlPicture.Visible = False 'displayed when checking If ProgramCommandStructVar.ExtendedHelpEnabledFlag = False Then _ Call SystemMessage_Display("press F1 for help") Case 6 GUIXAnimationControlPicture.Visible = False 'displayed when checking If ProgramCommandStructVar.ExtendedHelpEnabledFlag = False Then _ Call SystemMessage_Display("press F1 for help") Case 7 GUIXAnimationControlPicture.Visible = False 'displayed when checking If ProgramCommandStructVar.ExtendedHelpEnabledFlag = False Then _ Call SystemMessage_Display("press F1 for help") Case 9 Call ProgramRestoreCommand_Refresh Call ProgramMaximizeCommand_Refresh Call GUI9_MfrmSizeChanged(Mfrm.Width, Mfrm.Height, Mfrm.WindowState) If ProgramCommandStructVar.ExtendedHelpEnabledFlag = False Then _ Call SystemMessage_Display("verify TAG data (press F1 for help)") Case 10 Call ProgramRestoreCommand_Refresh Call ProgramMaximizeCommand_Refresh Call GUI10_MfrmSizeChanged(Mfrm.Width, Mfrm.Height, Mfrm.WindowState) Call Msg_Add("call GUI10TreeView_ProcessClick()") 'do when GUICstructvar.GUIPaletteNumberCurrent has been changed If ProgramCommandStructVar.ExtendedHelpEnabledFlag = False Then _ Call SystemMessage_Display("verify TAG data (press F1 for help)") Case 11 Call GUI11_Refreshed 'NOTE: update the color slider as late as possible so that the Skin Engine already set the back color of the color slider (legend) picture box (tested). Call FileSystemStruct_Sort(FileSystemStructVar) 'before initializing ColorSlider Call GUIXColorSlider_Initialize(GUIXColorSlider, GUIXColorSliderPaletteCurrent, FileSystemStructVar, FileInfoStructNumber, FileInfoStructArray()) Call GUIXColorSlider.GFColorSlider_Verify Call GUIXColorSlider.GFColorSlider_ShowProgress(GUIXColorSliderPicture, 0) Call GUIXColorSlider.GFColorSlider_ShowAreaLegend(GUIXColorSliderLegendPicture, 2, 2, GUIXColorSliderLegendPicture.Width / Screen.TwipsPerPixelX - 4, GUIXColorSliderLegendPicture.Height / Screen.TwipsPerPixelY - 4, GUIXColorSliderPaletteCurrent, 1) End Select Call SGfrm.SGBackUp_Delete 'backup is only possible for the step where it was created End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'on error Resume Next Select Case Button Case vbLeftButton 'NOTE: the Skin Engine moves Mfrm. Case vbRightButton 'NOTE: the Skin Engine sends an SECBMSG_FORM_RBUTTONDOWN message to make Mfrm open the pop up menu. End Select End Sub Public Sub GUICancelCommand_Click() 'on error Resume Next ' 'NOTE: use the Abort sub system to process cancel messages. 'NOTE: there's a second cancel command, the QPCancelCommand 'that is displayed when the GUICancelCommand cannot be pressed 'as Mfrm is disabled. ' Call Msg_AddEx(MSG_NORMAL_EVENT, "-1", "0", "cancel", "") End Sub Private Sub GUINextCommand_Click() 'on error Resume Next Call GUIC_DoPaletteChange(GUICStructVar.GUIPaletteNumberCurrent + 1) End Sub Private Sub GUIBackCommand_Click() 'on error Resume Next Call GUIC_DoPaletteChange(GUICStructVar.GUIPaletteNumberCurrent - 1) End Sub '************************************CALL BACK SUBS************************************ 'NOTE: many General Functions use call back subs. 'Besides the Mfrm call back subs there may exist additional call back subs 'in other forms (e.g. SE_ReceiveCallBackMessage()). ' '******************************CALL BACK SUBS: GFCOMMCTRL****************************** 'NOTE: the following subs are all called by GFCommCtrl_MouseClickmod. Public Sub CC_Click(ByVal CCMCSourceDescription As String, _ ByVal Button As Integer, ByVal X As Single, ByVal Y As Single) 'on error Resume Next Select Case CCMCSourceDescription Case "GUI4TreeView" Call GUI4TreeView_ProcessClick(Button, X, Y) Case "GUI7ListView" Call GUIXListView_ProcessClick(Button, X, Y, GUI7ListView, GUI7ListViewPointerArray()) Case "GUI9ListView" Call GUIXListView_ProcessClick(Button, X, Y, GUI9ListView, GUI9ListViewPointerArray()) Case "GUI10TreeView" Call GUI10TreeView_ProcessClick(Button, X, Y) 'see also GFPMS_ReceiveEventEx() Case "GUI10ListView" Call GUIXListView_ProcessClick(Button, X, Y, GUI10ListView, GUI10ListViewPointerArray()) Case "TAGfrm.TAGListView" Call GUIXListView_ProcessClick(Button, X, Y, TAGListView, TAGListViewPointerArray()) End Select End Sub Public Sub CC_DblClick(ByVal CCMCSourceDescription As String, _ ByVal Button As Integer, ByVal X As Single, ByVal Y As Single) 'on error Resume Next Select Case CCMCSourceDescription Case "GUI4TreeView" Call GUI4TreeView_ProcessDblClick(Button, X, Y) Case "GUI7ListView" Call GUIXListView_ProcessDblClick(Button, X, Y, GUI7ListView, GUI7ListViewPointerArray()) Case "GUI9ListView" Call GUIXListView_ProcessDblClick(Button, X, Y, GUI9ListView, GUI9ListViewPointerArray()) Case "GUI10ListView" Call GUIXListView_ProcessDblClick(Button, X, Y, GUI10ListView, GUI10ListViewPointerArray()) Case "TAGfrm.TAGListView" Call GUIXListView_ProcessDblClick(Button, X, Y, TAGListView, TAGListViewPointerArray()) End Select End Sub Public Sub CC_HeaderClick(ByVal CCMCSourceDescription As String, ByVal ListViewHeaderIndex As Integer) 'on error Resume Next Select Case CCMCSourceDescription Case "GUI7ListView" 'Call GUIXListView_ProcessHeaderClick(0, 0, 0, ListViewHeaderIndex, GUI7ListView, GUI7ListViewPointerArray()) Case "GUI9ListView" Call GUIXListView_ProcessHeaderClick(0, 0, 0, ListViewHeaderIndex, GUI9ListView, GUI9ListViewPointerArray()) Case "TAGfrm.TAGListView" 'Call GUIXListView_ProcessHeaderClick(0, 0, 0, ListViewHeaderIndex, TAGListView, TAGListViewPointerArray()) End Select End Sub Public Sub CC_BeginLabelEdit(ByVal CCMCSourceDescription As String, _ ByVal ItemHandleOrIndex As Long, ByVal ItemTextNew As String, ByRef Cancel As Integer) 'on error Resume Next Select Case CCMCSourceDescription Case "GUI10TreeView" Call GUI10TreeView_BeginLabelEdit(CCMCSourceDescription, ItemHandleOrIndex, ItemTextNew, Cancel) Case "GUI10ListView" Call GUI10ListView_BeginLabelEdit(CCMCSourceDescription, ItemHandleOrIndex, ItemTextNew, Cancel) End Select End Sub Public Sub CC_EndLabelEdit(ByVal CCMCSourceDescription As String, _ ByVal ItemHandleOrIndex As Long, ByVal ItemTextNew As String, ByRef Cancel As Integer) 'on error Resume Next Select Case CCMCSourceDescription Case "GUI10TreeView" Call GUI10TreeView_EndLabelEdit(ItemHandleOrIndex, ItemTextNew, Cancel) 'forward data to processing Case "GUI10ListView" Call GUI10ListView_EndLabelEdit(ItemHandleOrIndex, ItemTextNew, Cancel) 'forward data to processing End Select End Sub ' 'NOTE: there are two drag and drop handling systems: 'the one of the GFCommCtrls and GFCommCtrlDragDrop. 'MP3 Renamer 2 uses GFCommCtrlDragDrop ONLY. ' Public Sub CC_TreeViewDrop(ByVal CCMCSourceDescription As String, _ ByVal TreeViewDragItemHandle As Long, ByVal TreeViewDropItemHandle As Long) 'on error resume next 'see GFCCDD_DragDrop() End Sub Public Sub CC_TreeViewRDrop(ByVal CCMCSourceDescription As String, _ ByVal TreeViewDragItemHandle As Long, ByVal TreeViewDropItemHandle As Long) 'on error resume next 'see GFCCDD_DragDrop() End Sub Public Sub CC_ListViewDrop(ByVal CCMCSourceDescription As String, _ ByVal ListViewDragItemIndex As Long, ByVal ListViewDropItemIndex As Long) 'on error resume next 'see GFCCDD_DragDrop() End Sub Public Sub CC_ListViewRDrop(ByVal CCMCSourceDescription As String, _ ByVal ListViewDragItemIndex As Long, ByVal ListViewDropItemIndex As Long) 'on error resume next 'see GFCCDD_DragDrop() End Sub Public Sub CC_Other(ByVal SourceDescription As String, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean) 'on error reusme next 'receives all messages that are not processed Const WM_KEYDOWN = &H100 'begin Select Case Msg Case WM_KEYDOWN Select Case SourceDescription Case "GUI7ListView" Call GUI7ListView_KeyDown(wParam) Case "GUI9ListView" Call GUI9ListView_KeyDown(wParam) Case "GUI10TreeView" Call GUI10TreeView_KeyDown(wParam) End Select End Select End Sub '**************************END OF CALL BACK SUBS: GFCOMMCTRL*************************** '********************************CALL BACK SUBS: GFCCDD******************************** 'NOTE: the following sub is called by GFCommCtrl_DragDropmod. Public Sub GFCCDD_DragDrop(ByVal SourceControlName As String, ByRef SourceControlObject As Object, ByVal SourceControlType As Integer, ByVal SourceControllParam As Long, _ ByVal TargetControlName As String, ByRef TargetControlObject As Object, ByVal TargetControlType As Integer, ByVal TargetControllParam As Long) 'on error resume next 'call back sub of the GFCCDD (GFCommCtrlDragDrop) system Dim DragDropProcessedFlag As Boolean 'set to True if a source-target relation is valid Dim Tempstr$ ' 'NOTE: this sub is called if the user performed a drag drop operation in any 'of the registered GFCCDD controls (except in GFCCDD_ControlType_Other controls). 'It is possible that source and target control are equal, then the usual GFCommCtrl 'drag drop call back subs should be used to get extended information about the 'performed drag and drop operation. 'The SourceControllParam value depends on the type of the source control: 'GFTreeView: item handle (use IHB system to get extended item information) 'GFListView: item index (0 based) 'ListBox: item index (0 based) ' 'SourceControllParam may be True and TargetControllParam is GFCCDD_DROP_FINISHED 'when the data of the last drag drop item has been forwarded. ' 'NOTE: this sub is also called if the user used the right mouse button during the 'drag and drop operation. MP3 Renamer 2 will NOT open any right click menu like 'e.g. MS Explorer but the drag and drop operation will be performed instantly. ' If (SourceControlName = "GUI1CopyDirList") And (TargetControlName = "GUI1MoveDirList") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED Call GUI1DirListToReg 'save changes Call GUI1DirList_Reload(FileSystemStructVar) 'display changes Call GUI_ContinueEx Case Else If Not ((SourceControllParam < 0) Or (SourceControllParam > (GUI1CopyDirList.ListCount - 1))) Then 'verify Call GUI_Wait Call GUI1CopyDirList_Move(CInt(SourceControllParam), False, False) 'reload and save when GFCCDD_DROP_FINISHED message arrives End If End Select End If If (SourceControlName = "GUI1MoveDirList") And (TargetControlName = "GUI1CopyDirList") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED Call GUI1DirList_Reload(FileSystemStructVar) 'display changes Call GUI_ContinueEx Case Else If Not ((SourceControllParam < 0) Or (SourceControllParam > (GUI1MoveDirList.ListCount))) Then 'verify Call GUI_Wait Call GUI1MoveDirList_Copy(CInt(SourceControllParam), False, False) 'reload and save when GFCCDD_DROP_FINISHED message arrives DragDropProcessedFlag = True End If End Select End If If (SourceControlName = "GUI1CopyDirList") And (Left$(TargetControlName, 21) = "GFStartStationCommand") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (a GFStartStationCommand does not support multi-selection) Case Else If Not ((SourceControllParam < 0) Or (SourceControllParam > (GUI1CopyDirList.ListCount - 1))) Then 'verify Call SourceDirEx_Unpack(Tempstr$, "", GUI1CopyDirList.List(SourceControllParam)) If IsDirExisting(Tempstr$) = True Then Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 'GFStartStartionCommandMovable(# Call GFStartStation_ReceiveFile(Tempstr$, Val(Mid$(TargetControlName, 30, 1))) Case Else 'GFStartStationCommandFixed(# Call GFStartStation_ReceiveFile(Tempstr$, Val(Mid$(TargetControlName, 28, 1))) End Select End If End If End Select End If If (SourceControlName = "GUI1MoveDirList") And (Left$(TargetControlName, 21) = "GFStartStationCommand") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (a GFStartStationCommand does not support multi-selection) Case Else If Not ((SourceControllParam < 0) Or (SourceControllParam > (GUI1MoveDirList.ListCount - 1))) Then 'verify Call SourceDirEx_Unpack(Tempstr$, "", GUI1MoveDirList.List(SourceControllParam)) If IsDirExisting(Tempstr$) = True Then Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 'GFStartStartionCommandMovable(# Call GFStartStation_ReceiveFile(Tempstr$, Val(Mid$(TargetControlName, 30, 1))) Case Else 'GFStartStationCommandFixed(# Call GFStartStation_ReceiveFile(Tempstr$, Val(Mid$(TargetControlName, 28, 1))) End Select End If End If End Select End If If (SourceControlName = "GUI10ListView") And (TargetControlName = "GUI10TreeView") Then 'verify DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED ' 'NOTE: GUI10TreeView_EndDrop_[...] is not to be called if there was 'an error in GUI10TreeView_ProcessDrop_[...]. ' If GUI10StructVar.GUI10TreeView_ProcessDrop_ErrorFlag = False Then Call GUI10TreeView_EndDrop_FromGUI10ListView(SourceControllParam, TargetControllParam) Call GUI_ContinueEx Else GUI10StructVar.GUI10TreeView_ProcessDrop_ErrorFlag = False 'reset Call GUI_ContinueEx End If Case Else If GUI10StructVar.GUI10TreeView_ProcessDrop_ErrorFlag = False Then Call GUI_Wait GUI10StructVar.GUI10TreeView_ProcessDrop_ErrorFlag = Not ( _ GUI10TreeView_ProcessDrop_FromGUI10ListView(SourceControllParam, TargetControllParam)) End If End Select End If If (SourceControlName = "GUI10TreeView") And (TargetControlName = "GUI10TreeView") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (GUI10TreeView does not support multi-selection) Case Else Call GUI10TreeView_ProcessDrop_FromGUI10TreeView(SourceControllParam, TargetControllParam) End Select End If If (SourceControlName = "GUIXItemList") And (TargetControlName = "GUI5DefaultList") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (GUIXItemList does not support multi-selection) Case Else Call GUI5DefaultList_ProcessDrop_FromGUIXItemList(CInt(SourceControllParam)) End Select End If If (SourceControlName = "GUIXItemList") And (TargetControlName = "GUI6DefaultList") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (GUIXItemList does not support multi-selection) Case Else Call GUI6DefaultList_ProcessDrop_FromGUIXItemList(CInt(SourceControllParam)) End Select End If If (SourceControlName = "QPfrm.QPList") And (TargetControlName = "GFTextMarkerPicture") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (QPfrm.QPList does not support multi-selection) Case Else If Not ((SourceControllParam < 0) Or (SourceControllParam > (QPfrm.QPList.ListCount - 1))) Then 'verify Tempstr$ = GetFileMainName(QPfrm.QPList.List(CInt(SourceControllParam))) Call GFTextMarker_ReceiveText(Tempstr$, 0, NULLARRAYINT()) Call GFTextMarker_Refresh(GFTextMarkerStructVar) Call SystemMessage_Display("mark song, artist etc. name and press 'create filter'") End If End Select End If If (SourceControlName = "QPfrm.QPList") And (TargetControlName = "GUI3TestText") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (QPfrm.QPList does not support multi-selection) Case Else If Not ((SourceControllParam < 0) Or (SourceControllParam > (QPfrm.QPList.ListCount - 1))) Then 'verify Call GUI3TestText_ReceiveFile(QPfrm.QPList_GetFileName(CInt(SourceControllParam + 1&))) End If End Select End If If (SourceControlName = "QPfrm.QPList") And (TargetControlName = "GUI9RecoverFileText") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (QPfrm.QPList does not support multi-selection) Case Else If Not ((SourceControllParam < 0) Or (SourceControllParam > (QPfrm.QPList.ListCount - 1))) Then 'verify Call GUI9RecoverFileText_ReceiveFile(QPfrm.QPList_GetFileName(CInt(SourceControllParam + 1&))) End If End Select End If If (SourceControlName = "QPfrm.QPList") And (Left$(TargetControlName, 21) = "GFStartStationCommand") Then DragDropProcessedFlag = True Select Case TargetControllParam Case GFCCDD_DROP_FINISHED 'do nothing (a GFStartStationCommand does not support multi-selection) Case Else If Not ((SourceControllParam < 0) Or (SourceControllParam > (QPfrm.QPList.ListCount - 1))) Then 'verify Tempstr$ = GetDirectoryName(QPfrm.QPList_GetFileName(CInt(SourceControllParam + 1&))) If IsDirExisting(Tempstr$) = False Then 'NOTE: the GFCCDD code will always pass 'GFStartStationCommandFixed(x)' as TargetControlName If (InStr(1, TargetControlName, "Movable", vbTextCompare)) Then 'GFStartStartionCommandMovable(# Call GFStartStation_ReceiveFile(Tempstr$, Val(Mid$(TargetControlName, 30, 1))) Else 'GFStartStationCommandFixed(# Call GFStartStation_ReceiveFile(Tempstr$, Val(Mid$(TargetControlName, 28, 1))) End If End If End If End Select End If If DragDropProcessedFlag = False Then Call SystemMessage_Display("Sorry, this drag and drop operation is not supported !") End If End Sub '****************************END OF CALL BACK SUBS: GFCCDD***************************** '*****************************CALL BACK SUBS: SUBCLASSING****************************** 'NOTE: the following sub is the call back sub of GFSubClassmod. 'Most controls have been subclassed to process WM_DROPFILES messages. Public Sub GFSubClassWindowProcEx(ByVal TargetFormName As String, ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean) 'on error resume next 'see annotations in GFSubClassmod If (Msg = WM_LBUTTONDOWN) Or (Msg = WM_RBUTTONDOWN) Then ' 'NOTE: the idle system requires the target project to 'set the KeyPressedFlag and MousePressedFlag on its own. 'NOTE: although Mfrm should set MousePressedFlag within its 'own subclass call back sub we must use this sub here as not all 'mouse click messages are forwarded to Mfrm's own call back sub. ' IdleStructVar.MousePressedFlag = True End If 'NOTE: pass strings ByVal or errors will appear as arrays are locked when resizing (tested). Select Case TargetFormName Case "GFCommCtrl_DragDropfrm" Call GFCommCtrl_DragDropfrm.GFSubClassWindowProc(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) Case "GFCommCtrl_Eventfrm" Call GFCommCtrl_Eventfrm.GFSubClassWindowProc(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) Case "GFLRC_Receiverfrm" Call GFLRC_Receiverfrm.GFSubClassWindowProc(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) Case "GFSkinEnginefrm" Call GFSkinEnginefrm.GFSubClassWindowProc(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) Case "GFWindowStickfrm" Call GFWindowStickfrm.GFSubClassWindowProc(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) Case "Mfrm" Call Mfrm.GFSubClassWindowProc(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) Case "QPfrm" Call QPfrm.GFSubClassWindowProc(SourceDescription, hwnd, Msg, wParam, lParam, ReturnValue, ReturnValueUsedFlag) End Select End Sub Public Sub GFSubClassWindowProc(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean) 'on error Resume Next 'verify If Msg = WM_PAINT Then Exit Sub 'increase speed If Msg = WM_NCPAINT Then Exit Sub 'increase speed If Msg = WM_ERASEBKGND Then Exit Sub 'increase speed Select Case Msg Case WM_LBUTTONDOWN, WM_LBUTTONUP, WM_RBUTTONDOWN, WM_RBUTTONUP, WM_MOUSEMOVE, WM_DROPFILES Dim Tempstr$ 'declare vars only if necessary to increase speed Case Else Exit Sub 'increase speed (important) End Select 'begin 'GFSTARTSTATION Dim GFStartStationCommandIndex As Integer If Msg = WM_DROPFILES Then 'check first to increase speed Select Case Len(SourceDescription) Case 24 To 29 'check first to increase speed (Integer value in brackets can have 1 to 5 chars) If Left$(SourceDescription, 21) = "GFStartStationCommand" Then 'GFStartStationCommand[Fixed/Movable/""] GFStartStationCommandIndex = Val(Mid$(SourceDescription, 28, 1)) If GFStartStationCommandIndex = 0 Then GFStartStationCommandIndex = Val(Mid$(SourceDescription, 30, 1)) 'exact matching by checking step number failed If Not ((GFStartStationCommandIndex < 1) Or (GFStartStationCommandIndex > GFStartStationStructNumber)) Then 'verify Tempstr$ = String$(MAX_PATH, Chr$(0)) Call DragQueryFile(wParam, 0, Tempstr$, MAX_PATH) 'pass True instead of 0 to get the file count (0 means receive name of first dropped file) Call DragFinish(wParam) If Not (InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) = 0) Then Tempstr$ = Left$(Tempstr$, InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) - 1) End If Call GFStartStation_ReceiveFile(Tempstr$, GFStartStationCommandIndex) ReturnValueUsedFlag = True ReturnValue = 0 End If End If End Select End If 'END OF GFSTARTSTATION Select Case SourceDescription Case "Mfrm" ' 'NOTE: the back picture can be changed by the Skin Engine. ' Case "GUI1CopyDirList" ' 'differs from GUI1MoveDirList as directories are 'to be copied ' If Msg = WM_DROPFILES Then Tempstr$ = String$(MAX_PATH, Chr$(0)) Call DragQueryFile(wParam, 0, Tempstr$, MAX_PATH) 'pass True instead of 0 to get the file count (0 means receive name of first dropped file) Call DragFinish(wParam) If Not (InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) = 0) Then Tempstr$ = Left$(Tempstr$, InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) - 1) End If If Not ((GetAttrSave(Tempstr$) And vbDirectory) = vbDirectory) Then Tempstr$ = GetDirectoryName(Tempstr$) End If If Not (Right$(Tempstr$, 1) = "\") Then 'verify Tempstr$ = Tempstr$ + "\" End If If IsDirExisting(Tempstr$) = True Then If GUI1_ScanControlGroup_Enabled = True Then 'verify no scan operation is currently in progress If GetDirFileCount(Tempstr$) = 0 Then 'no mp3 files in directory to add If MsgBox("Sorry, you cannot add an empty directory !" + Chr$(10) + "Do you want to scan all sub directories now (recommended) ?", vbYesNo + vbExclamation) = vbYes Then GUI1StructVar.UseDefaultMoveOrCopyFlag = True 'reset by called sub GUI1StructVar.DefaultMoveOrCopyFlag = False Call GUI1Dirs_Scan(Tempstr$) ReturnValueUsedFlag = True ReturnValue = 0 Exit Sub 'sub called above displayed result information Else ReturnValueUsedFlag = True ReturnValue = 0 Exit Sub 'error End If Else GUI1StructVar.UseDefaultMoveOrCopyFlag = True 'reset by called sub GUI1StructVar.DefaultMoveOrCopyFlag = False Call GUI1Dirs_Add(Tempstr$, GetDriveSerialNumber(Tempstr$)) End If Else MsgBox "Please wait until the scanning is completed !", vbOKOnly + vbInformation 'no real error End If End If ReturnValueUsedFlag = True ReturnValue = 0 End If Case "GUI1MoveDirList" ' 'differs from GUI1CopyDirList as directories are 'to be moved ' If Msg = WM_DROPFILES Then Tempstr$ = String$(MAX_PATH, Chr$(0)) Call DragQueryFile(wParam, 0, Tempstr$, MAX_PATH) 'pass True instead of 0 to get the file count (0 means receive name of first dropped file) Call DragFinish(wParam) If Not (InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) = 0) Then Tempstr$ = Left$(Tempstr$, InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) - 1) End If If Not ((GetAttrSave(Tempstr$) And vbDirectory) = vbDirectory) Then Tempstr$ = GetDirectoryName(Tempstr$) End If If Not (Right$(Tempstr$, 1) = "\") Then 'verify Tempstr$ = Tempstr$ + "\" End If If IsDirExisting(Tempstr$) = True Then If GUI1_ScanControlGroup_Enabled = True Then 'verify no scan operation is currently in progress If GetDirFileCount(Tempstr$) = 0 Then 'no mp3 files in directory to add If MsgBox("Sorry, you cannot add an empty directory !" + Chr$(10) + "Do you want to scan all sub directories now (recommended) ?", vbYesNo + vbExclamation) = vbYes Then GUI1StructVar.UseDefaultMoveOrCopyFlag = True 'reset by called sub GUI1StructVar.DefaultMoveOrCopyFlag = True Call GUI1Dirs_Scan(Tempstr$) Exit Sub 'sub called above displayed result information Else Exit Sub 'error End If Else GUI1StructVar.UseDefaultMoveOrCopyFlag = True 'reset by called sub GUI1StructVar.DefaultMoveOrCopyFlag = True Call GUI1Dirs_Add(Tempstr$, GetDriveSerialNumber(Tempstr$)) End If Else MsgBox "Please wait until the scanning is completed !", vbOKOnly + vbInformation 'no real error End If End If ReturnValue = 0 ReturnValueUsedFlag = True End If Case "GUI3CutCharText" If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then 'allow opening ControlMenu If Msg = WM_RBUTTONUP Then ReturnValue = 0 ReturnValueUsedFlag = True End If If Msg = WM_RBUTTONUP Then Call GUI3CutCharText_MouseUp(vbRightButton, 0, 0, 0) ReturnValue = 0 ReturnValueUsedFlag = True End If End If Case "GUI3ReplaceCharText" If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then 'allow opening ControlMenu If Msg = WM_RBUTTONDOWN Then ReturnValue = 0 ReturnValueUsedFlag = True End If If Msg = WM_RBUTTONUP Then Call GUI3ReplaceCharText_MouseUp(vbRightButton, 0, 0, 0) ReturnValue = 0 ReturnValueUsedFlag = True End If End If Case "GUI3NoUCaseText" If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then 'allow opening ControlMenu If Msg = WM_RBUTTONDOWN Then ReturnValue = 0 ReturnValueUsedFlag = True End If If Msg = WM_RBUTTONUP Then Call GUI3NoUCaseText_MouseUp(vbRightButton, 0, 0, 0) ReturnValue = 0 ReturnValueUsedFlag = True End If End If Case "GUI3NoLCaseText" If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then 'allow opening ControlMenu If Msg = WM_RBUTTONDOWN Then ReturnValue = 0 ReturnValueUsedFlag = True End If If Msg = WM_RBUTTONUP Then Call GUI3NoLCaseText_MouseUp(vbRightButton, 0, 0, 0) ReturnValue = 0 ReturnValueUsedFlag = True End If End If Case "GUI3ExpressionText" If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then 'allow opening ControlMenu If Msg = WM_RBUTTONDOWN Then ReturnValue = 0 ReturnValueUsedFlag = True End If If Msg = WM_RBUTTONUP Then Call GUI3ExpressionText_MouseUp(vbRightButton, 0, 0, 0) ReturnValue = 0 ReturnValueUsedFlag = True End If End If Case "GUI3TestText" If Msg = WM_DROPFILES Then Tempstr$ = String$(MAX_PATH, Chr$(0)) Call DragQueryFile(wParam, 0, Tempstr$, MAX_PATH) 'pass True instead of 0 to get the file count (0 means receive name of first dropped file) Call DragFinish(wParam) If Not (InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) = 0) Then Tempstr$ = Left$(Tempstr$, InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) - 1) End If Call GUI3TestText_ReceiveFile(Tempstr$) ReturnValue = 0 ReturnValueUsedFlag = True End If If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then 'allow opening ControlMenu If Msg = WM_RBUTTONDOWN Then ReturnValue = 0 ReturnValueUsedFlag = True End If If Msg = WM_RBUTTONUP Then Call GUI3TestText_MouseUp(vbRightButton, 0, 0, 0) ReturnValue = 0 ReturnValueUsedFlag = True End If End If Case "GUI9RecoverFileText" If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then 'allow opening ControlMenu If Msg = WM_RBUTTONDOWN Then ReturnValue = 0 ReturnValueUsedFlag = True End If If Msg = WM_RBUTTONUP Then Call GUI9RecoverFileText_MouseUp(vbRightButton, 0, 0, 0) ReturnValue = 0 ReturnValueUsedFlag = True End If End If If Msg = WM_DROPFILES Then Tempstr$ = String$(MAX_PATH, Chr$(0)) Call DragQueryFile(wParam, 0, Tempstr$, MAX_PATH) 'pass True instead of 0 to get the file count (0 means receive name of first dropped file) Call DragFinish(wParam) If Not (InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) = 0) Then Tempstr$ = Left$(Tempstr$, InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) - 1) End If ReturnValueUsedFlag = True ReturnValue = 0 'important (see VC help, otherwise Windows98 crash) 'NOTE: as there was a msg chaos the target sub (see below) is now called with a delay. Call MsgPacket_Create("call GUI9RecoverFileText_ReceiveFile()") Call MsgPacket_AddItem("call GUI9RecoverFileText_ReceiveFile()", Tempstr$) Call Msg_AddEx(MSG_NORMAL_EVENT, 1, 0, "call GUI9RecoverFileText_ReceiveFile()", "call GUI9RecoverFileText_ReceiveFile()") ReturnValue = 0 ReturnValueUsedFlag = True End If Case "GFTextMarkerPicture" If Msg = WM_DROPFILES Then If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then Tempstr$ = String$(MAX_PATH, Chr$(0)) Call DragQueryFile(wParam, 0, Tempstr$, MAX_PATH) 'pass True instead of 0 to get the file count (0 means receive name of first dropped file) Call DragFinish(wParam) If Not (InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) = 0) Then Tempstr$ = Left$(Tempstr$, InStr(1, Tempstr$, Chr$(0), vbBinaryCompare) - 1) End If Tempstr$ = GetFileName(Tempstr$) If UCase$(Right$(Tempstr$, 4)) = ".MP3" Then Tempstr$ = Left$(Tempstr$, Len(Tempstr$) - 4) If UCase$(Right$(Tempstr$, 4)) = ".WMA" Then Tempstr$ = Left$(Tempstr$, Len(Tempstr$) - 4) If UCase$(Right$(Tempstr$, 4)) = ".WAV" Then Tempstr$ = Left$(Tempstr$, Len(Tempstr$) - 4) Call GFTextMarker_ReceiveText(Tempstr$, 0, NULLARRAYINT()) Call GFTextMarker_Refresh(GFTextMarkerStructVar) 'display changes Call SystemMessage_Display("mark song, artist etc. name and press 'create filter'") ReturnValue = 0 ReturnValueUsedFlag = True Else ' 'NOTE: if UserMove is enabled we allow the Skin Engine to process 'the current file drop so that the user can easily change the picture box back picture. ' End If End If End Select Exit Sub End Sub '*****************************CALL BACK SUBS: SUBCLASSING****************************** '******************************CALL BACK SUBS: SKIN ENGINE***************************** 'NOTE: the following sub is a call back sub of the Skin Engine. 'Various SECBMSG-messages are sent there. 'Note that there are several SE call back subs existing within this project. ' 'Most of the messages processed are used to redraw controls in UserMove mode 'or to verify the UserMove itself can be performed correctly '(controls are shown and enabled only temporary during UserMove mode). Public Sub SE_ReceiveCallBackMessageEx(ByVal TargetFormName As String, ByVal Msg As Integer, ByVal wParam As String, ByVal lParam As String, ByRef ReturnValueUsedFlag As Boolean, ByRef ReturnValue As Long) 'on error resume next ' 'NOTE: when SE_ReceiveCallBackMsgExEnabledFlag in GFSkinEnginemod 'is set to True the the Skin Engine will call 'Mfrm.SE_ReceiveCallBackMessageEx()'. 'Here in this sub we perform further checking to verify that unimportant 'message are not processed (important to increase speed). ' 'NOTE: when doing changes on the messages processed then verify that 'processed messages are not excluded by the following Select Case statement. ' 'verify Select Case Msg Case SECBMSG_SECONTROL_REFRESH Exit Sub 'not processed by any SE_ReceiveCallBackMessage() sub Case SECBMSG_SECONTROL_REFRESHED If (InStr(1, wParam, "Command", vbBinaryCompare)) Then Exit Sub 'NOTE: do not process this message if sent because of a se command 'refreshing, processing would decrease the program speed (tested). End Select 'begin Select Case TargetFormName Case "CSETfrm" If (SystemForms_IsSystemFormLoaded(CSETfrm)) Then Call CSETfrm.SE_ReceiveCallBackMessage(Msg, wParam, lParam, ReturnValueUsedFlag, ReturnValue) End If Case "LWCfrm" If (SystemForms_IsSystemFormLoaded(LWCfrm)) Then Call LWCfrm.SE_ReceiveCallBackMessage(Msg, wParam, lParam, ReturnValueUsedFlag, ReturnValue) End If Case "Mfrm" If (SystemForms_IsSystemFormLoaded(Mfrm)) Then Call Mfrm.SE_ReceiveCallBackMessage(Msg, wParam, lParam, ReturnValueUsedFlag, ReturnValue) End If Case "QPfrm" If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.SE_ReceiveCallBackMessage(Msg, wParam, lParam, ReturnValueUsedFlag, ReturnValue) End If Case "TAGfrm" If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then Call TAGfrm.SE_ReceiveCallBackMessage(Msg, wParam, lParam, ReturnValueUsedFlag, ReturnValue) End If Case "GFContextHelpfrm" If (SystemForms_IsSystemFormLoaded(GFContextHelpfrm)) Then Call GFContextHelpfrm.SE_ReceiveCallBackMessage(Msg, wParam, lParam, ReturnValueUsedFlag, ReturnValue) End If End Select End Sub Public Sub SE_ReceiveCallBackMessage(ByVal Msg As Integer, ByVal wParam As String, ByVal lParam As String, ByRef ReturnValueUsedFlag As Boolean, ByRef ReturnValue As Long) 'on error resume next Dim WindowXPos As Long Dim WindowYPos As Long Dim FrameColor As Long Dim FrameShadowColor As Long Dim SEControlStructIndex As Integer ' 'NOTE: the processed messages are sorted by their frequency, 'the message that appears the most frequent appears at last. ' 'begin Select Case Msg Case SECBMSG_SKIN_ENGINE_NOT_AVAILABLE MsgBox "Please reinstall Toricxs !", vbOKOnly + vbInformation Call Form_Unload(False) 'get out of here Case SECBMSG_KEYHOOKEVENT IdleStructVar.KeyPressedFlag = True 'see annotations in Ide_Update Call SE_ReceiveKeyHookEvent(wParam, lParam, ReturnValueUsedFlag, ReturnValue) ' '***MESSAGE DISPLAYING MESSAGE PROCESSING*** ' Case SECBMSG_DISPLAY_SKIN_NAME 'Ctrl-Shift-F4 Call SystemMessage_Display("Current skin: " + wParam) Case SECBMSG_MESSAGE_SHOW Call SystemManualMessage_Show(wParam) Case SECBMSG_MESSAGE_HIDE Call SystemManualMessage_Hide ' '***END OF MESSAGE DISPLAYING MESSAGE PROCESSING*** '***MENU MESSAGE PROCESSING*** ' Case SECBMSG_FORMMENU_OPENING, SECBMSG_CONTROLMENU_OPENING, SECBMSG_KEYHOOKSHORTCUT_PROCESSING If ((System_IsSystemBusy = True) And (SystemStructVar.SystemBusyButSkinEngineAllowedFlag = False)) Or (System_IsProgramFormFocused = False) Or (Mfrm.WindowState = vbMinimized) Then 'NOTE: do not enable the context help as this could lead to message jams (tested). If SystemStructVar.SystemMsgBoxOpenedFlag = False Then 'verify SystemStructVar.SystemMsgBoxOpenedFlag = True 'NOTE: this message could be sent several times although a MsgBox is opened (damn Windows). If Mfrm.WindowState = vbMinimized Then MsgBox "Please restore the Main Window first !", vbOKOnly + vbInformation Else MsgBox "Please wait until the current operation is finished, then you can edit the skin !", vbOKOnly + vbInformation End If SystemStructVar.SystemMsgBoxOpenedFlag = False 'reset End If ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL End If ' '***END OF MENU MESSAGE PROCESSING*** '***CONTEXTHELP MESSAGE PROCESSING*** ' Case SECBMSG_CONTEXTHELP_ENABLED If ((System_IsSystemBusy = True) And (SystemStructVar.SystemBusyButContextHelpAllowedFlag = False)) Or (System_IsProgramFormFocused = False) Then If SystemStructVar.SystemMsgBoxOpenedFlag = False Then 'verify SystemStructVar.SystemMsgBoxOpenedFlag = True 'NOTE: this message could be sent several times although a MsgBox is opened (damn Windows). MsgBox "Sorry, please wait until the current operation is finished, then click the context help button again.", vbOKOnly + vbInformation 'no real error (user doesn't know) SystemStructVar.SystemMsgBoxOpenedFlag = False 'reset End If ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL End If Case SECBMSG_CONTEXTHELP_REQUESTED 'NOTE: as some help texts refer to special controls they are displayed at a special position. Call ContextHelp_GetContextHelpWindowPos(wParam, Val(lParam), WindowXPos, WindowYPos) 'NOTE: use the GFPMS to 'release' code in GFContextHelpfrm (avoid stack overflow, although almost impossible). Call MsgPacket_Create("ContextHelp parameters") Call MsgPacket_AddItem("ContextHelp parameters", wParam) Call MsgPacket_AddItem("ContextHelp parameters", WindowXPos) Call MsgPacket_AddItem("ContextHelp parameters", WindowYPos) Call Msg_AddEx(MSG_NORMAL_EVENT, "1", "0", "display ContextHelp", "ContextHelp parameters") 'NOTE: to edit the MP3 Renamer 2 ContextHelpFile disable the following line: 'Call SE_EncryptFile(GFContextHelpfrm.GFContextHelp_GetHelpFile, "GFContextHelp", "") Case SECBMSG_CONTEXTHELP_EVENT 'NOTE: events have their descent in the ContextHelpFile. Call ContextHelp_Hide ' 'NOTE: tests showed that it is necessary to process the event not 'before 2 (for safety reasons 3) message circles have passed. 'Otherwise there is an error when pressing 'Read' in context help '(GUI4) as Mfrm will not be enabled before reading is begun. ' Do While Msg_Remove("ContextHelp event") = True Loop 'make sure message is removed Do While Msg_Remove("wait for ContextHelp event") = True Loop 'make sure message is removed Call MsgPacket_Create("ContextHelp event parameters") Call MsgPacket_AddItem("ContextHelp event parameters", wParam) 'include event name Call Msg_AddEx(MSG_EVENT_AFTER_EVENT_REMOVE, "wait for ContextHelp event", "", "ContextHelp event", "ContextHelp event parameters") Call Msg_AddEx(MSG_NORMAL_EVENT, "3", "0", "wait for ContextHelp event", "") ' '***END OF CONTEXTHELP MESSAGE PROCESSING*** '***USERMOVE MESSAGE PROCESSING*** ' Case SECBMSG_SEM_NEW_BACKPICTURE_RESET ' 'NOTE: when the user creates a new skin the Loginfrm 'appearance must not be change as the user has not the 'opportunity to do any changes on Loginfrm. ' Select Case wParam Case "Loginfrm" ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL End Select Case SECBMSG_SEM_NEW_POLYRGN_RESET Select Case wParam Case "Loginfrm" 'for safety reasons only ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL Case "PolyRgn37" 'original poly rgn of Loginfrm ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL End Select Case SECBMSG_SEM_NEW_FINISHED SEControlStructIndex = GetSEControlStructIndex("GFTextMarkerPicture") If Not (SEControlStructIndex = 0) Then 'verify If ISFONTAVAILABLE("Courier") = True Then 'verify ' 'NOTE: GFTextMarkerPicture must have set a font whose letters all have the same width. 'The user can still change the default font (Courier) over the ControlMenu in UserMove mode. ' SEControlStructArray(SEControlStructIndex).SEControl_Font.Name = "Courier" Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(SEControlStructIndex).SEControlName, "fontname", _ SEControlStructArray(SEControlStructIndex).SEControl_Font.Name, False, False) 'save changes Call SE_RefreshControl("GFTextMarkerPicture", 0, SEControlStructIndex) 'display changes Call GFTextMarker_Refresh(GFTextMarkerStructVar) 'important (refreshing this control cleared it) End If End If SEControlStructIndex = GetSEControlStructIndex("StepLabelFixed") If Not (SEControlStructIndex = 0) Then 'verify If ISFONTAVAILABLE("Courier") = True Then 'verify ' 'NOTE: StepLabel must have set a font whose letters all have the same width. 'The user can still change the default font (Courier) over the ControlMenu in UserMove mode. ' SEControlStructArray(SEControlStructIndex).SEControl_Font.Name = "Courier" Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(SEControlStructIndex).SEControlName, "fontname", _ SEControlStructArray(SEControlStructIndex).SEControl_Font.Name, False, False) 'save changes Call SE_RefreshControl("StepLabelFixed", 0, SEControlStructIndex) 'display changes End If Call SEM_ControlHeightToFontHeightSub(SEControlStructIndex) 'we changed the font type (and -size) after we fitted all controls' size to their font height End If SEControlStructIndex = GetSEControlStructIndex("StepLabelMovable") If Not (SEControlStructIndex = 0) Then 'verify If ISFONTAVAILABLE("Courier") = True Then 'verify ' 'NOTE: StepLabel must have set a font whose letters all have the same width. 'The user can still change the default font (Courier) over the ControlMenu in UserMove mode. ' SEControlStructArray(SEControlStructIndex).SEControl_Font.Name = "Courier" Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(SEControlStructIndex).SEControlName, "fontname", _ SEControlStructArray(SEControlStructIndex).SEControl_Font.Name, False, False) 'save changes Call SE_RefreshControl("StepLabelMovable", 0, SEControlStructIndex) 'display changes End If Call SEM_ControlHeightToFontHeightSub(SEControlStructIndex) 'we changed the font type (and -size) after we fitted all controls' size to their font height End If SEControlStructIndex = GetSEControlStructIndex("Statistics1LabelFixed") If Not (SEControlStructIndex = 0) Then 'verify If ISFONTAVAILABLE("Small Fonts") = True Then 'verify ' 'NOTE: Statistics1Label should have set the font 'Small Fonts' with size 6 to 'verify all data fits in the label when it has the same size as in the base skin. ' SEControlStructArray(SEControlStructIndex).SEControl_Font.Name = "Small Fonts" SEControlStructArray(SEControlStructIndex).SEControl_Font.Size = 6 Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(SEControlStructIndex).SEControlName, "fontname", _ SEControlStructArray(SEControlStructIndex).SEControl_Font.Name, False, False) 'save changes Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(SEControlStructIndex).SEControlName, "fontsize", _ CStr(SEControlStructArray(SEControlStructIndex).SEControl_Font.Size), False, False) 'save changes Call SE_RefreshControl("Statistics1LabelFixed", 0, SEControlStructIndex) 'display changes End If Call SEM_ControlHeightToFontHeightSub(SEControlStructIndex) 'we changed the font type (and -size) after we fitted all controls' size to their font height End If SEControlStructIndex = GetSEControlStructIndex("Statistics1LabelMovable") If Not (SEControlStructIndex = 0) Then 'verify If ISFONTAVAILABLE("Small Fonts") = True Then 'verify ' 'NOTE: Statistics1Label should have set the font 'Small Fonts' with size 6 to 'verify all data fits in the label when it has the same size as in the base skin. ' SEControlStructArray(SEControlStructIndex).SEControl_Font.Name = "Small Fonts" SEControlStructArray(SEControlStructIndex).SEControl_Font.Size = 6 Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(SEControlStructIndex).SEControlName, "fontname", _ SEControlStructArray(SEControlStructIndex).SEControl_Font.Name, False, False) 'save changes Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, _ SEControlStructArray(SEControlStructIndex).SEControlName, "fontsize", _ CStr(SEControlStructArray(SEControlStructIndex).SEControl_Font.Size), False, False) 'save changes Call SE_RefreshControl("Statistics1LabelMovable", 0, SEControlStructIndex) 'display changes End If Call SEM_ControlHeightToFontHeightSub(SEControlStructIndex) 'we changed the font type (and -size) after we fitted all controls' size to their font height End If Case SECBMSG_USERMOVESYSTEM_ENABLING 'ContextHelp ' 'NOTE: if the extended help is enabled then display a message about 'the UserMove mode. The user cannot close this message through clicking 'on the label captioned 'Ok' when the UserMove is enabled, so don't allow 'enabling it through returning SECBMSG_REPLY_CANCEL. ' If ProgramCommandStructVar.ExtendedHelpEnabledFlag = True Then If ActionTrackStructVar.UserMoveInfoDisplayedFlag = False Then ActionTrackStructVar.UserMoveInfoDisplayedFlag = True ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL 'or user cannot click on 'Next' or 'Close' any more Call ContextHelp_Show("UserMoveInfo:1", True) End If End If 'Case SECBMSG_USERMOVESYSTEM_DISABLING ' Case SECBMSG_USERMOVESYSTEM_ENABLED ' If SESystemStructVar.SystemSkinNameCurrent = "BASESKIN" Then If ContextHelpStructVar.ContextHelpEnabledFlag = False Then 'verify If ProgramCommandStructVar.ExtendedHelpEnabledFlag = False Then 'verify If ActionTrackStructVar.UserMoveCopyInfoDisplayedFlag = False Then ActionTrackStructVar.UserMoveCopyInfoDisplayedFlag = True If MsgBox("You are attempting to edit the base skin. Do you want to copy the base skin and edit the copy to retain the original base skin ?", vbYesNo + vbQuestion) = vbYes Then Call SEM_UserMove_Disable Call SEM_Skin_Copy Call SEM_UserMove_Enable Exit Sub End If End If End If End If End If ' Call GFCCDD_Abort 'abort any drag and drop operation Call GFCCDDSystem_Disable 'temporary (!) disable the GFCCDD system Call SE_ContextHelp_Abort 'abort any request for context help Call SystemMessage_Display("Skin Engine UserMove enabled.") ' 'NOTE: the next/back command is enabled by default, the cancel command is shown by default '(user does not have the possibility to press the commands during UserMove). ' Call Visible_Set(GUICancelCommand, "SE") Call Enabled_Set(GUINextCommand, "SE") Call Enabled_Set(GUIBackCommand, "SE") Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 GUICancelCommand.Visible = False GUINextCommand.Enabled = True GUIBackCommand.Enabled = True Case Else GUICancelCommand.Visible = True GUINextCommand.Enabled = True GUIBackCommand.Enabled = True End Select ' Select Case GUICStructVar.GUIPaletteNumberCurrent Case 1 ControlGroupStructVar.GUI1_SearchControlGroup_VisibleFlag = GUI1_SearchControlGroup_Visible GUIXAnimationControlPicture.Enabled = True 'set after setting visible flag GUIXAnimationControlPicture.Visible = True Call GUI1_SearchControlGroup_Show Case 4 'manually display and enable all controls the user could not move in any case (these controls are at least hidden through the next palette change) If Not (ControlGroupStructVar.GUI4_ControlGroup_Current = GUI4_CONTROLGROUP_USERMOVE) Then 'verify ControlGroupStructVar.GUI4_ControlGroup_Old = ControlGroupStructVar.GUI4_ControlGroup_Current Call GUI4_ControlGroup_ShowEx(GUI4_CONTROLGROUP_USERMOVE) End If Call Visible_Set(GUI4PauseCommand, "SE") Call Visible_Set(GUI4ResumeCommand, "SE") Call Visible_Set(GUI4ReadCommand, "SE") Call Visible_Set(GUI4ReadNewCommand, "SE") Call Visible_Set(GUI4ReadAllCommand, "SE") GUI4PauseCommand.Visible = True GUI4ResumeCommand.Visible = True GUI4ReadCommand.Visible = True GUI4ReadNewCommand.Visible = True GUI4ReadAllCommand.Visible = True Call Enabled_Set(GUI4PauseCommand, "SE") Call Enabled_Set(GUI4ResumeCommand, "SE") GUI4PauseCommand.Enabled = True GUI4ResumeCommand.Enabled = True Case 5 GUIXAnimationControlPicture.Enabled = True GUIXAnimationControlPicture.Visible = True ControlGroupStructVar.GUI5_ControlGroup_EnabledFlag = GUI5_ControlGroup_Enabled Call GUI5_ControlGroup_Enable Case 6 GUIXAnimationControlPicture.Enabled = True GUIXAnimationControlPicture.Visible = True ControlGroupStructVar.GUI6_ControlGroup_EnabledFlag = GUI6_ControlGroup_Enabled Call GUI6_ControlGroup_Enable Case 7 GUIXAnimationControlPicture.Enabled = True GUIXAnimationControlPicture.Visible = True ControlGroupStructVar.GUI7_ControlGroup_EnabledFlag = GUI7_ControlGroup_Enabled ControlGroupStructVar.GUI7_ControlGroup_VisibleFlag = GUI7_ControlGroup_Visible Call GUI7_ControlGroup_Enable Call GUI7_ControlGroup_Show Case 9 ProgramMaximizeCommand.Enabled = True ProgramMaximizeCommand.Visible = True ProgramRestoreCommand.Enabled = True ProgramRestoreCommand.Visible = True Case 10 ProgramMaximizeCommand.Enabled = True ProgramMaximizeCommand.Visible = True ProgramRestoreCommand.Enabled = True ProgramRestoreCommand.Visible = True Case 11 GUIXAnimationControlPicture.Enabled = True GUIXAnimationControlPicture.Visible = True Call Visible_Set(GUI11PauseCommand, "SE") Call Visible_Set(GUI11ResumeCommand, "SE") GUI11PauseCommand.Visible = True GUI11ResumeCommand.Visible = True Call Enabled_Set(GUI11PauseCommand, "SE") Call Enabled_Set(GUI11ResumeCommand, "SE") GUI11PauseCommand.Enabled = True GUI11ResumeCommand.Enabled = True Case 12 GUI12IncludeDescriptionCheck.Enabled = True 'user cannot check as left click is disabled End Select ' Select Case GUICStructVar.GUIPaletteNumberCurrent 'important to increase speed Case 4 Call GUI4TreeViewPicture_Resize Call GUI4TreeViewPicture_MouseUp(vbLeftButton, 0, 0, 0) Case 7 Call GUI7ListViewPicture_Resize Call GUI7ListViewPicture_MouseUp(vbLeftButton, 0, 0, 0) Case 9 Call GUI9ListViewPicture_Resize Call GUI9ListViewPicture_MouseUp(vbLeftButton, 0, 0, 0) Case 10 Call GUI10TreeViewPicture_Resize Call GUI10TreeViewPicture_MouseUp(vbLeftButton, 0, 0, 0) Call GUI10ListViewPicture_Resize Call GUI10ListViewPicture_MouseUp(vbLeftButton, 0, 0, 0) End Select ' Case SECBMSG_USERMOVESYSTEM_DISABLED ' Call SystemMessage_Display("Skin Engine UserMove disabled.") 'NOTE: control properties are reset at end of this code segment. ' Select Case GUICStructVar.GUIPaletteNumberCurrent Case 1 GUIXAnimationControlPicture.Visible = False GUIXAnimationControlPicture.Enabled = False If ControlGroupStructVar.GUI1_SearchControlGroup_VisibleFlag = False Then Call GUI1_SearchControlGroup_Hide End If Case 4 'hide controls that are usually never displayed (never when enabling the UserMove system is possible) Call Enabled_Get(GUI4PauseCommand, "SE") Call Enabled_Get(GUI4ResumeCommand, "SE") Call Visible_Get(GUI4PauseCommand, "SE") Call Visible_Get(GUI4ResumeCommand, "SE") Call Visible_Get(GUI4ReadCommand, "SE") Call Visible_Get(GUI4ReadNewCommand, "SE") Call Visible_Get(GUI4ReadAllCommand, "SE") Call GUI4_ControlGroup_ShowEx(ControlGroupStructVar.GUI4_ControlGroup_Old) 'restore previous control group Case 5 GUIXAnimationControlPicture.Visible = False GUIXAnimationControlPicture.Enabled = False If ControlGroupStructVar.GUI5_ControlGroup_EnabledFlag = False Then Call GUI5_ControlGroup_Disable End If Case 6 GUIXAnimationControlPicture.Visible = False GUIXAnimationControlPicture.Enabled = False If ControlGroupStructVar.GUI6_ControlGroup_EnabledFlag = False Then Call GUI6_ControlGroup_Disable End If Case 7 GUIXAnimationControlPicture.Visible = False GUIXAnimationControlPicture.Enabled = False If ControlGroupStructVar.GUI7_ControlGroup_VisibleFlag = False Then Call GUI7_ControlGroup_Hide End If If ControlGroupStructVar.GUI7_ControlGroup_EnabledFlag = False Then Call GUI7_ControlGroup_Disable End If Case 9 Call ProgramMaximizeCommand_Refresh Call ProgramRestoreCommand_Refresh Call GUI9_MfrmSizeChanged(Mfrm.Width, Mfrm.Height, Mfrm.WindowState) Case 10 Call ProgramMaximizeCommand_Refresh Call ProgramRestoreCommand_Refresh Call GUI10_MfrmSizeChanged(Mfrm.Width, Mfrm.Height, Mfrm.WindowState) Case 11 GUIXAnimationControlPicture.Visible = False GUIXAnimationControlPicture.Enabled = False Call Enabled_Get(GUI11PauseCommand, "SE") Call Enabled_Get(GUI11ResumeCommand, "SE") Call Visible_Get(GUI11PauseCommand, "SE") Call Visible_Get(GUI11ResumeCommand, "SE") Case 12 GUI12IncludeDescriptionCheck.Enabled = False 'always disabled End Select ' 'NOTE: reset command properties after ControlGroup was executed '(ControlGroup code could have changed command properties, too). ' Call Visible_Get(GUICancelCommand, "SE") Call Enabled_Get(GUINextCommand, "SE") Call Enabled_Get(GUIBackCommand, "SE") ' Select Case GUICStructVar.GUIPaletteNumberCurrent 'important to increase speed Case 4 Call GUI4TreeViewPicture_Resize Call GUI4TreeViewPicture_MouseUp(vbLeftButton, 0, 0, 0) Case 7 Call GUI7ListViewPicture_Resize Call GUI7ListViewPicture_MouseUp(vbLeftButton, 0, 0, 0) Case 9 Call GUI9ListViewPicture_Resize Call GUI9ListViewPicture_MouseUp(vbLeftButton, 0, 0, 0) Case 10 Call GUI10TreeViewPicture_Resize Call GUI10TreeViewPicture_MouseUp(vbLeftButton, 0, 0, 0) Call GUI10ListViewPicture_Resize Call GUI10ListViewPicture_MouseUp(vbLeftButton, 0, 0, 0) End Select ' Call SkinEngine_VerifyAfterUserMove Call GFCCDDSystem_Enable 'call after calling GFCCDDSystem_Disable ' '***END OF USERMOVE MESSAGE PROCESSING*** '***SKINDATAFILE MESSAGE PROCESSING*** ' Case SECBMSG_BEFORE_SKINDATAFILE_RELOAD ' SkinDataFileReloadStructVar.ReloadingFlag = True 'reset when SECBMSG_AFTER_SKINDATAFILE_RELOAD message arrives ' If SkinDataFileReloadStructVar.RecoursiveReloadingFlag = False Then 'don't store window states again, or windows would be gone ' SEControlStructIndex = GetSEControlStructIndex(GetSEControlNameFromControlObject(Mfrm, SECONTROLTYPE_FORM, SESystemStructVar.SystemPaletteNumberCurrent)) If (SEControlStructIndex) Then 'verify (important at start up, then message arrives although system not 'started' completely) SkinDataFileReloadStructVar.MfrmDataValidFlag = True SkinDataFileReloadStructVar.MfrmWindowStateUnchanged = SEFormSystem_GetFormState(SEControlStructArray(SEControlStructIndex).SEControlName) If SkinDataFileReloadStructVar.MfrmWindowStateUnchanged = vbNormal Then SkinDataFileReloadStructVar.MfrmPosUnchanged.X = GetSEControlXPos(SEControlStructIndex) SkinDataFileReloadStructVar.MfrmPosUnchanged.Y = GetSEControlYPos(SEControlStructIndex) SkinDataFileReloadStructVar.MfrmSizeUnchanged.X = GetSEControlXSize(SEControlStructIndex) SkinDataFileReloadStructVar.MfrmSizeUnchanged.Y = GetSEControlYSize(SEControlStructIndex) Else SkinDataFileReloadStructVar.MfrmPosUnchanged.X = SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.FormStateToggleStructVar.FormXPos SkinDataFileReloadStructVar.MfrmPosUnchanged.Y = SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.FormStateToggleStructVar.FormYPos SkinDataFileReloadStructVar.MfrmSizeUnchanged.X = SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.FormStateToggleStructVar.FormXSize SkinDataFileReloadStructVar.MfrmSizeUnchanged.Y = SEControlStructArray(SEControlStructIndex).SEControl_ResizeStruct.FormStateToggleStructVar.FormYSize End If Else SkinDataFileReloadStructVar.MfrmDataValidFlag = False 'something's wrong (at start up) SkinDataFileReloadStructVar.MfrmWindowStateUnchanged = 0 'reset (not set) SkinDataFileReloadStructVar.MfrmPosUnchanged.X = 0 'reset (not set) SkinDataFileReloadStructVar.MfrmPosUnchanged.Y = 0 'reset (not set) SkinDataFileReloadStructVar.MfrmSizeUnchanged.X = 0 'reset (not set) SkinDataFileReloadStructVar.MfrmSizeUnchanged.Y = 0 'reset (not set) End If ' 'NOTE: when the current skin is changed then the subclassing will be 'temporary disabled. To avoid visible (!) displaying errors we temporary 'display the GUICurtain. ' Call GUICurtain_Show ' 'NOTE: we temporary hide all slave windows as redrawing will 'not work during changing SDF (would look ugly). ' SkinDataFileReloadStructVar.WindowStickEnabledFlagUnchanged = GFWindowStickfrm.GFWindowStickSystem_Enabled Call GFWindowStickfrm.GFWindowStickSystem_Enable ' 'NOTE: it is important to disable the GFWindowStick system when 'reloading the SDF as otherwise windows that are located at temporary 'positions could influence the stick type bits (tested). ' If StartUpStructVar.SystemStartingUpFlag = False Then 'if not shown already Call Login_Show Call LogoLine_Refresh("Changing skin, please wait...", True, 10) End If ' SkinDataFileReloadStructVar.QPfrmVisibleFlagUnchanged = SystemForms_GetFormVisibleWithoutLoading(QPfrm) If SystemForms_GetFormVisibleWithoutLoading(QPfrm) = True Then QPfrm.Visible = False QPfrm.Refresh Call SystemForms_Redraw 'allow redrawing all windows (important, tested) End If SkinDataFileReloadStructVar.LWCfrmVisibleFlagUnchanged = SystemForms_GetFormVisibleWithoutLoading(LWCfrm) If SystemForms_GetFormVisibleWithoutLoading(LWCfrm) = True Then LWCfrm.Visible = False LWCfrm.Refresh Call SystemForms_Redraw 'allow redrawing all windows (important, tested) End If SkinDataFileReloadStructVar.TAGfrmVisibleFlagUnchanged = SystemForms_GetFormVisibleWithoutLoading(TAGfrm) If SystemForms_GetFormVisibleWithoutLoading(TAGfrm) = True Then TAGfrm.Visible = False TAGfrm.Refresh Call SystemForms_Redraw 'allow redrawing all windows (important, tested) End If SkinDataFileReloadStructVar.MfrmVisibleFlagUnchanged = SystemForms_GetFormVisibleWithoutLoading(Mfrm) If SystemForms_GetFormVisibleWithoutLoading(Mfrm) = True Then Mfrm.Visible = False Mfrm.Refresh Call SystemForms_Redraw 'allow redrawing all windows (important, tested) End If 'NOTE: when ContextHelpfrm is visible then a skin change should not be possible. ' End If ' Case SECBMSG_AFTER_SKINDATAFILE_RELOAD ' SkinDataFileReloadStructVar.ReloadingFlag = False 'reset instantly as original reloading was already finished ' 'UPDATE OLD VERSIONED SKIN TO NEWEST VERSION ' 'NOTE: create control domains here. If an old skin is updated, the new controls 'will be skinned, but the user must move them to the desired position. ' If SkinDataFileReloadStructVar.RecoursiveReloadingFlag = False Then 'execute following code once only, no recursion ' ' SkinDataFileReloadStructVar.RecoursiveReloadingFlag = True 'FAILED, subclassing fell out ' Dim ReloadFlag As Boolean ' ReloadFlag = False 'reset ' If (SkinDataFile_CreateDomain(SE_GetSkinDataFile, "GUI8RetainAllFileNamesCheck", 8)) Then ReloadFlag = True ' If (SkinDataFile_CreateDomain(SE_GetSkinDataFile, "GUI8RetainLongFileNamesCheck", 8)) Then ReloadFlag = True ' If (SkinDataFile_CreateDomain(SE_GetSkinDataFile, "GUI8FormatRetainedFileNamesCheck", 8)) Then ReloadFlag = True ' If (SkinDataFile_CreateDomain(SE_GetSkinDataFile, "GUI8WriteTAGsCheck", 8)) Then ReloadFlag = True ' If (ReloadFlag) Then ' Call SE_DisplayPalette(GUICStructVar.GUIPaletteNumberOld, GUICStructVar.GUIPaletteNumberCurrent, True, True, True, False) 'ForceSkinDataFileReloadingFlag = True ' End If ' SEControlStructIndex = GetSEControlStructIndex("GUI8RetainAllFileNamesCheck") ' Call SetSEControlXPos(SEControlStructIndex, 0, 0, False) ' Call SetSEControlYPos(SEControlStructIndex, 0, 0, False) ' Call SaveSEControlPos(SEControlStructIndex, 0, 0, 0, 0, False, False) ' Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, "GUI8RetainAllFileNamesCheck", "tooltiptext", "enable to make Toricxs re-use the old file names, if you think they are better") ' SEControlStructIndex = GetSEControlStructIndex("GUI8RetainLongFileNamesCheck") ' Call SetSEControlXPos(SEControlStructIndex, 0, 0, False) ' Call SetSEControlYPos(SEControlStructIndex, 20, 0, False) ' Call SaveSEControlPos(SEControlStructIndex, 0, 20, 0, 0, False, False) ' Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, "GUI8RetainLongFileNamesCheck", "tooltiptext", "enable to make Toricxs re-use the old file name if the one created by Toricxs would be shortened") ' SEControlStructIndex = GetSEControlStructIndex("GUI8FormatRetainedFileNamesCheck") ' Call SetSEControlXPos(SEControlStructIndex, 0, 0, False) ' Call SetSEControlYPos(SEControlStructIndex, 40, 0, False) ' Call SaveSEControlPos(SEControlStructIndex, 0, 40, 0, 0, False, False) ' Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, "GUI8FormatRetainedFileNamesCheck", "tooltiptext", "makes Toricxs capitalize retained file names (like TAGs, see step 3)") ' SEControlStructIndex = GetSEControlStructIndex("GUI8WriteTAGsCheck") ' Call SetSEControlXPos(SEControlStructIndex, 0, 0, False) ' Call SetSEControlYPos(SEControlStructIndex, 60, 0, False) ' Call SaveSEControlPos(SEControlStructIndex, 0, 60, 0, 0, False, False) ' Call SkinDataFile_ChangeProperty(SE_GetSkinDataFile, "GUI8WriteTAGsCheck", "tooltiptext", "Disable to retain the old TAG. Additionally enable file name retaining to move/copy files to new directories without altering the files.") ' SkinDataFileReloadStructVar.RecoursiveReloadingFlag = False 'reset Call Msg_Add("call UpdateSkin") 'process when this reloading here is finished ' End If 'END OF UPDATING SKIN ' 'NOTE: after every SECBMSG_BEFORE_SKINDATAFILE_RELOAD message 'also a SECBMSG_AFTER_SKINDATAFILE_RELOAD message is sent. ' 'NOTE: we want to retain the old skin's form position, size and windowstate. 'Therefore we avoid resizing or -posing form through returning SECBMSG_REPLY_CANCEL 'when the related messages arrive and we manually size and move form after the SDF 'was reloaded. We save the form pos and size instantly after setting it. ' If SkinDataFileReloadStructVar.RecoursiveReloadingFlag = False Then 'execute following code once only, no recursion (important, or Mfrm stays invisible, some error without this line) ' If SkinDataFileReloadStructVar.MfrmDataValidFlag = True Then 'verify Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 If SkinDataFileReloadStructVar.MfrmWindowStateUnchanged = vbNormal Then Call ProgramRestoreCommand_Click 'no matter if visible, do in any case to show/hide commands End If If SkinDataFileReloadStructVar.MfrmWindowStateUnchanged = vbMaximized Then Call ProgramMaximizeCommand_Click 'no matter if visible, do in any case to show/hide commands End If SEControlStructIndex = GetSEControlStructIndex(GetSEControlNameFromControlObject(Mfrm, SECONTROLTYPE_FORM, SESystemStructVar.SystemPaletteNumberCurrent)) If (SEControlStructIndex) Then 'verify (should not happen) If SkinDataFileReloadStructVar.MfrmWindowStateUnchanged = vbNormal Then 'retain restored size Call SEFormSystem_MoveForm(SEControlStructIndex, SkinDataFileReloadStructVar.MfrmPosUnchanged.X, SkinDataFileReloadStructVar.MfrmPosUnchanged.Y) Call SEFormSystem_ResizeForm(SEControlStructIndex, SkinDataFileReloadStructVar.MfrmSizeUnchanged.X, SkinDataFileReloadStructVar.MfrmSizeUnchanged.Y) Call SEFormSystem_SaveFormPos(GetSEControlNameFromControlObject(Mfrm, SECONTROLTYPE_FORM, SESystemStructVar.SystemPaletteNumberCurrent), GetSEControlXPos(SEControlStructIndex), GetSEControlYPos(SEControlStructIndex)) Call SEFormSystem_SaveFormSize(GetSEControlNameFromControlObject(Mfrm, SECONTROLTYPE_FORM, SESystemStructVar.SystemPaletteNumberCurrent), GetSEControlXSize(SEControlStructIndex), GetSEControlYSize(SEControlStructIndex)) Else ' 'NOTE: if the old skin's form (and thus also the new skin's) form was (is) maximized 'then the form state toggle data is exchanged. ' Call FormStateToggle_SetToggleData(SEControlStructIndex, vbNormal, _ SkinDataFileReloadStructVar.MfrmPosUnchanged.X, SkinDataFileReloadStructVar.MfrmPosUnchanged.Y, _ SkinDataFileReloadStructVar.MfrmSizeUnchanged.X, SkinDataFileReloadStructVar.MfrmSizeUnchanged.Y) End If End If Case Else SEControlStructIndex = GetSEControlStructIndex(GetSEControlNameFromControlObject(Mfrm, SECONTROLTYPE_FORM, SESystemStructVar.SystemPaletteNumberCurrent)) If (SEControlStructIndex) Then 'verify (should not happen) 'NOTE: we only transfer the form position, not (in any case) the size, there's also no form state toggle data that could be exchanged. If SkinDataFileReloadStructVar.MfrmWindowStateUnchanged = vbNormal Then 'retain restored size Call SEFormSystem_MoveForm(SEControlStructIndex, SkinDataFileReloadStructVar.MfrmPosUnchanged.X, SkinDataFileReloadStructVar.MfrmPosUnchanged.Y) Call SEFormSystem_SaveFormPos(GetSEControlNameFromControlObject(Mfrm, SECONTROLTYPE_FORM, SESystemStructVar.SystemPaletteNumberCurrent), GetSEControlXPos(SEControlStructIndex), GetSEControlYPos(SEControlStructIndex)) End If End If End Select End If 'redraw color slider and it's area legend (important, tested) Select Case GUICStructVar.GUIPaletteNumberCurrent Case 4, 11 'the drive names would not be displayed without redrawing after the current skin has been changed Call GUIXColorSlider.GFColorSlider_ShowProgress(GUIXColorSliderPicture, GUIXColorSlider.GFColorSlider_GetProgressCurrent) Call GUIXColorSlider.GFColorSlider_ShowAreaLegend(GUIXColorSliderLegendPicture, 2, 2, GUIXColorSliderLegendPicture.Width / Screen.TwipsPerPixelX - 4, GUIXColorSliderLegendPicture.Height / Screen.TwipsPerPixelY - 4, GUIXColorSliderPaletteCurrent, 1) Case 9 'code below is important as controls were incorrectly sized when the current skin was changed Call ProgramMaximizeCommand_Refresh Call ProgramRestoreCommand_Refresh Call GUI9_MfrmSizeChanged(Mfrm.Width, Mfrm.Height, Mfrm.WindowState) Case 10 'code below is important as controls were incorrectly sized when the current skin was changed Call ProgramMaximizeCommand_Refresh Call ProgramRestoreCommand_Refresh Call GUI10_MfrmSizeChanged(Mfrm.Width, Mfrm.Height, Mfrm.WindowState) End Select ' 'NOTE: since the last usage of the new skin the start station command 'content' 'could have been changed (the old images are still saved in the skin data). 'Refresh all commands now. ' If StartUpStructVar.SystemStartingUpFlag = False Then 'not available at first SDF load Dim DisabledPictureCacheDir As String Call DisabledPictureCache_GetCacheDir(DisabledPictureCacheDir) Call StartStation_RefreshCommandSub(1, GetSEControlStructIndex("GFStartStationCommandFixed(1)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(1)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(2, GetSEControlStructIndex("GFStartStationCommandFixed(2)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(2)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(3, GetSEControlStructIndex("GFStartStationCommandFixed(3)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(3)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(4, GetSEControlStructIndex("GFStartStationCommandFixed(4)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(4)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(5, GetSEControlStructIndex("GFStartStationCommandFixed(5)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(5)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(1, GetSEControlStructIndex("GFStartStationCommandMovable(1)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(1)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(2, GetSEControlStructIndex("GFStartStationCommandMovable(2)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(2)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(3, GetSEControlStructIndex("GFStartStationCommandMovable(3)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(3)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(4, GetSEControlStructIndex("GFStartStationCommandMovable(4)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(4)"), DisabledPictureCacheDir, True) 'important (tested) Call StartStation_RefreshCommandSub(5, GetSEControlStructIndex("GFStartStationCommandMovable(5)"), True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(5)"), DisabledPictureCacheDir, True) 'important (tested) End If ' Call GUICurtain_Hide Call SystemForms_Redraw 'allow redrawing windows If SkinDataFileReloadStructVar.WindowStickEnabledFlagUnchanged = True Then Call GFWindowStickfrm.GFWindowStickSystem_Enable 're-enable as temporary disabled Else Call GFWindowStickfrm.GFWindowStickSystem_Disable 'do not enable as has been never enabled End If Call WindowStick_Refresh 'allow posing windows ' 'NOTE: all slave windows have temporary been hidden during reloading 'the current SkinDataFile. WindowStick_Refresh indirectly moved the slave 'windows to their best position, now show windows again. ' If StartUpStructVar.SystemStartingUpFlag = False Then 'if not shown already Call Login_Hide End If ' If SkinDataFileReloadStructVar.MfrmVisibleFlagUnchanged = True Then Mfrm.Visible = True Mfrm.Refresh Call SystemForms_Redraw 'allow redrawing all windows End If If SkinDataFileReloadStructVar.QPfrmVisibleFlagUnchanged = True Then QPfrm.Visible = True QPfrm.Refresh Call SystemForms_Redraw 'allow redrawing all windows End If If SkinDataFileReloadStructVar.LWCfrmVisibleFlagUnchanged = True Then LWCfrm.Visible = True LWCfrm.Refresh Call SystemForms_Redraw 'allow redrawing all windows End If If SkinDataFileReloadStructVar.TAGfrmVisibleFlagUnchanged = True Then TAGfrm.Visible = True TAGfrm.Refresh Call SystemForms_Redraw 'allow redrawing all windows End If ' End If 'end of If RecoursiveReloadingFlag = True ' Case SECBMSG_PALETTECHANGE ' 'NOTE: when the Skin Engine was reloaded, it is necessary to refresh 'special controls. E.g. a back color change of a picture box deletes the 'content of the picture box. ' Select Case Val(wParam) Case 2 Call GFTextMarker_DrawLegend(GFTextMarkerStructVar) Call GFTextMarker_Refresh(GFTextMarkerStructVar) Call GFTextMarkerLegendPicture_MouseDown(vbLeftButton, 0, 1, 1) 'preset End Select ' '***END OF SKINDATAFILE MESSAGE PROCESSING*** '***CUSTOM MESSAGE PROCESSING*** Case SECBMSG_CUSTOMMESSAGE Select Case wParam 'custom message name Case SE_CUSTOMMESSAGE_CONTEXTHELP_MOVES_WINDOW ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL 'NOTE: to avoid errors in the WindowStick system we use the window using the ZoomSlide sub system. Call ZoomSlide_Move(SE_UnpackString(lParam, 1), Val(SE_UnpackString(lParam, 2)), Val(SE_UnpackString(lParam, 3))) Call SystemForms_Redraw End Select '***END OF CUSTOM MESSAGE PROCESSING*** '***FORM MESSAGE PROCESSING*** ' Case SECBMSG_LBUTTONUP_AFTER_FORM_MOVED, SECBMSG_LBUTTONUP_AFTER_FORM_RESIZED SEControlStructIndex = GetSEControlStructIndex(wParam) 'form name If Not (SEControlStructIndex = 0) Then 'verify If SEControlStructArray(SEControlStructIndex).SEControl Is Mfrm Then ' 'NOTE: the GFWindowStick code may have moved slave windows. 'Save those windows' position to avoid they 'jump around' when the 'SkinDataFile is reloaded. ' SEControlStructIndex = GetSEControlStructIndex("LWCfrm") If Not (SEControlStructIndex = 0) Then _ Call SEFormSystem_SaveFormPos(SEControlStructArray(SEControlStructIndex).SEControlName, GetSEControlXPos(SEControlStructIndex), GetSEControlYPos(SEControlStructIndex)) SEControlStructIndex = GetSEControlStructIndex("TAGfrm") If Not (SEControlStructIndex = 0) Then _ Call SEFormSystem_SaveFormPos(SEControlStructArray(SEControlStructIndex).SEControlName, GetSEControlXPos(SEControlStructIndex), GetSEControlYPos(SEControlStructIndex)) SEControlStructIndex = GetSEControlStructIndex("QPfrm") If Not (SEControlStructIndex = 0) Then _ Call SEFormSystem_SaveFormPos(SEControlStructArray(SEControlStructIndex).SEControlName, GetSEControlXPos(SEControlStructIndex), GetSEControlYPos(SEControlStructIndex)) End If End If Case SECBMSG_FORM_BACKPICTURERECREATE ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL Call Msg_AddAndPack("recreate form back picture", lParam) Case SECBMSG_FORM_BEFORE_MOVING If SkinDataFileReloadStructVar.ReloadingFlag = True Then 'NOTE: we don't want to use the form pos & size saved in the SDF of the new skin. ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL End If Case SECBMSG_FORM_MOVED Call SystemForms_Redraw 'allow redrawing, compatibility to SECBMSG_FORM_SIZED Case SECBMSG_FORM_BEFORE_SIZING If SkinDataFileReloadStructVar.ReloadingFlag = True Then Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 'only in these palettes as there a form is resizable by the user 'NOTE: we don't want to use the form pos & size saved in the SDF of the new skin. ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL Case Else 'do not avoid skin-specific form size setting End Select End If 'Call GUICurtain_Show 'slow, does not look better Case SECBMSG_FORM_SIZED 'Call GUICurtain_Hide 'slow, does not look better Call SystemForms_Redraw 'looks much better (tested) Case SECBMSG_FORMTITLEBAR_LBUTTONDBLCLK Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 Select Case SEFormSystem_GetFormState(wParam) Case vbNormal Call SEFormSystem_Maximize(wParam) Call ProgramMaximizeCommand_Refresh Call ProgramRestoreCommand_Refresh Case vbMaximized Call SEFormSystem_Restore(wParam, True, True) Call ProgramMaximizeCommand_Refresh Call ProgramRestoreCommand_Refresh End Select Case Else ' 'NOTE: the SECBMSG_FORMTITLEBAR_LBUTTONDBLCLK message will 'only be sent if the related form is resizable (code below will never be executed :-( ). ' If ProgramCommandStructVar.ExtendedHelpEnabledFlag = True Then MsgBox "The window can be maximized in step 9 & 10 only." + "When you create your own skin then use a pattern as background rather than a picture.", vbOKOnly + vbInformation End If End Select Case SECBMSG_FORM_MAXIMIZED 'arrives when user dbl clicked on form title bar Select Case GUICStructVar.GUIPaletteNumberCurrent 'check [...]Current (tested) Case 9, 10 Call WindowStick_Maximized(wParam) Case Else 'NOTE: the Skin Engine sometimes sends this message although nothing has been maximized '(Microsoft sucks). End Select Case SECBMSG_FORM_RESTORED 'arrives when user dbl clicked on form title bar Select Case GUICStructVar.GUIPaletteNumberCurrent 'check [...]Old and New (tested) Case 9, 10 Call WindowStick_Restored(wParam) Case Else 'NOTE: the Skin Engine sometimes sends this message although nothing has been maximized '(Microsoft sucks). End Select Select Case GUICStructVar.GUIPaletteNumberOld 'check [...]Old (tested) Case 9, 10 Call WindowStick_Restored(wParam) Case Else 'NOTE: the Skin Engine sometimes sends this message although nothing has been maximized '(Microsoft sucks). End Select Case SECBMSG_FORM_RBUTTONUP ' 'NOTE: the Skin Engine sends this message also if the user right- 'clicks on (the invisible part) of any skinned label. 'IMPORTANT: do not open any pop up menu because of a button down 'event, open any pop up menu only at button up event as otherwise 'button up messages will get lost (leads to system errors). ' Select Case wParam 'source form name Case "Mfrm_1", "Mfrm_2", "Mfrm_3", "Mfrm_4", "Mfrm_5", "Mfrm_6", "Mfrm_7", "Mfrm_8", "Mfrm_9", "Mfrm_10", "Mfrm_11", "Mfrm_12" Call ProgramUpdatePopUpMenu(5) 'Menu5 Call ProgramUpdatePopUpMenu(6) 'Menu6 Call ProgramUpdatePopUpMenu(17) 'Menu17 Call ProgramUpdatePopUpMenu(31) 'Menu31 Call ProgramUpdatePopUpMenu(33) 'Menu33 Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 5) 'Menu6 Case "Loginfrm" If ProgramDebugModeSwitch = True Then ' 'NOTE: Loginfrm can only be skinned by *ME*! ' Call SE_OpenFormMenu("Loginfrm", Loginfrm) End If End Select ' '***END OF FORM MESSAGE PROCESSING*** '***SPECIAL SECONTORL MESSAGE PROCESSING*** ' Case SECBMSG_PICTUREBOX_REDRAW Select Case wParam 'control name Case "GFTextMarkerPicture" Call GFTextMarker_Refresh(GFTextMarkerStructVar) Call SE_DrawFrame(wParam) Case "GFTextMarkerLegendPicture" Call GFTextMarker_DrawLegend(GFTextMarkerStructVar) Call SE_DrawFrame(wParam) Case "GUI4ColorSliderPicture", "GUI4ColorSliderLegendPicture", "GUI11ColorSliderPicture", "GUI11ColorSliderLegendPicture" Call GUIXColorSlider.GFColorSlider_ShowProgress(GUIXColorSliderPicture, GUIXColorSlider.GFColorSlider_GetProgressCurrent) Call GUIXColorSlider.GFColorSlider_ShowAreaLegend(GUIXColorSliderLegendPicture, 2, 2, GUIXColorSliderLegendPicture.Width / Screen.TwipsPerPixelX - 4, GUIXColorSliderLegendPicture.Height / Screen.TwipsPerPixelY - 4, GUIXColorSliderPaletteCurrent, 1) Call SE_DrawFrame(wParam) Case "GUI8DoubledFilesPicture" Call SE_DrawFrame(wParam) Case "GUI11ExistingFilesPicture" Call SE_DrawFrame(wParam) Case "GUI10SizeChangePicture" Call SE_DrawFrame(wParam) End Select Case SECBMSG_PICTURE_DROPPED If ((System_IsSystemBusy = True) And (SystemStructVar.SystemBusyButSkinEngineAllowedFlag = False)) Then 'Or (System_IsProgramFormFocused = False) Then 'form cannot be focused when dragging a file over to it MsgBox "Sorry, no drop 'till this here is finished !", vbOKOnly + vbInformation ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL End If Case SECBMSG_FILEDROP_UNPROCESSED If ((System_IsSystemBusy = True) And (SystemStructVar.SystemBusyButSkinEngineAllowedFlag = False)) Then 'Or (System_IsProgramFormFocused = False) Then 'form cannot be focused when dragging a file over to it MsgBox "Sorry, no drop 'till this here is finished !", vbOKOnly + vbInformation Else Call SkinEngine_FileDrop_Unprocessed(wParam) 'this sub will try to process the dropped file End If Case SECBMSG_SECOMMAND_RBUTTONUP Select Case wParam 'control name ' Case "GFStartStationCommand(1)" 'does not work any more in v1.1 ' Call GFStartStationCommand_RButtonUp(1) 'forward to open pop up menu ' Case "GFStartStationCommand(2)" ' Call GFStartStationCommand_RButtonUp(2) ' Case "GFStartStationCommand(3)" ' Call GFStartStationCommand_RButtonUp(3) ' Case "GFStartStationCommand(4)" ' Call GFStartStationCommand_RButtonUp(4) ' Case "GFStartStationCommand(5)" ' Call GFStartStationCommand_RButtonUp(5) ' Case "GFStartStationCommandFixed(1)" Call GFStartStationCommand_RButtonUp(1) 'forward to open pop up menu Case "GFStartStationCommandFixed(2)" Call GFStartStationCommand_RButtonUp(2) Case "GFStartStationCommandFixed(3)" Call GFStartStationCommand_RButtonUp(3) Case "GFStartStationCommandFixed(4)" Call GFStartStationCommand_RButtonUp(4) Case "GFStartStationCommandFixed(5)" Call GFStartStationCommand_RButtonUp(5) ' Case "GFStartStationCommandMovable(1)" Call GFStartStationCommand_RButtonUp(1) 'forward to open pop up menu Case "GFStartStationCommandMovable(2)" Call GFStartStationCommand_RButtonUp(2) Case "GFStartStationCommandMovable(3)" Call GFStartStationCommand_RButtonUp(3) Case "GFStartStationCommandMovable(4)" Call GFStartStationCommand_RButtonUp(4) Case "GFStartStationCommandMovable(5)" Call GFStartStationCommand_RButtonUp(5) End Select Case SECBMSG_SECOMMAND_LBUTTONUP Select Case wParam 'control name ' Case "GFStartStationCommand(1)" 'does not work any more in v1.1 ' Call GFStartStationCommand_LButtonUp(1) 'forward to open pop up menu ' Case "GFStartStationCommand(2)" ' Call GFStartStationCommand_LButtonUp(2) ' Case "GFStartStationCommand(3)" ' Call GFStartStationCommand_LButtonUp(3) ' Case "GFStartStationCommand(4)" ' Call GFStartStationCommand_LButtonUp(4) ' Case "GFStartStationCommand(5)" ' Call GFStartStationCommand_LButtonUp(5) ' Case "GFStartStationCommandFixed(1)" Call GFStartStationCommand_LButtonUp(1) 'forward to open pop up menu Case "GFStartStationCommandFixed(2)" Call GFStartStationCommand_LButtonUp(2) Case "GFStartStationCommandFixed(3)" Call GFStartStationCommand_LButtonUp(3) Case "GFStartStationCommandFixed(4)" Call GFStartStationCommand_LButtonUp(4) Case "GFStartStationCommandFixed(5)" Call GFStartStationCommand_LButtonUp(5) ' Case "GFStartStationCommandMovable(1)" Call GFStartStationCommand_LButtonUp(1) 'forward to open pop up menu Case "GFStartStationCommandMovable(2)" Call GFStartStationCommand_LButtonUp(2) Case "GFStartStationCommandMovable(3)" Call GFStartStationCommand_LButtonUp(3) Case "GFStartStationCommandMovable(4)" Call GFStartStationCommand_LButtonUp(4) Case "GFStartStationCommandMovable(5)" Call GFStartStationCommand_LButtonUp(5) End Select ' '***END OF SPECIAL SECONTROL MESSAGE PROCESSING*** '***(GENERAL) SECONTROL MESSAGE PROCESSING*** ' Case SECBMSG_SECONTROL_LOAD ' 'NOTE: the Skin Engine cannot reload the start station commands 'as those picture's are created through a special algorithm. 'Note that even if the user sizes a start station command in UserMove 'the command is drawn correctly, as the Skin Engine would reload 'the command to create a picture fitting to the new command size. ' Select Case Len(wParam) 'check first to increase speed Case 29&, 31& If STRINGTOBOOL(lParam) = True Then 'ForceRecreateFlag If Not (GFStartStationStructNumber = 0) Then 'verify StartStation has been initialized yet (at start up) SEControlStructIndex = GetSEControlStructIndex(wParam) If SEControlStructIndex = 0 Then Exit Sub 'verify Select Case wParam ' Case "GFStartStationCommand(1)" 'does not work any more in v1.1 ' Call StartStation_RefreshCommandSub(1, SEControlStructIndex) ' 'NOTE: the Skin Engine will load new command pictures automatically ' Case "GFStartStationCommand(2)" ' Call StartStation_RefreshCommandSub(2, SEControlStructIndex) ' Case "GFStartStationCommand(3)" ' Call StartStation_RefreshCommandSub(3, SEControlStructIndex) ' Case "GFStartStationCommand(4)" ' Call StartStation_RefreshCommandSub(4, SEControlStructIndex) ' Case "GFStartStationCommand(5)" ' Call StartStation_RefreshCommandSub(5, SEControlStructIndex) ' Case "GFStartStationCommandFixed(1)" Call StartStation_RefreshCommandSub(1, SEControlStructIndex) 'NOTE: the Skin Engine will load new command pictures automatically Case "GFStartStationCommandFixed(2)" Call StartStation_RefreshCommandSub(2, SEControlStructIndex) Case "GFStartStationCommandFixed(3)" Call StartStation_RefreshCommandSub(3, SEControlStructIndex) Case "GFStartStationCommandFixed(4)" Call StartStation_RefreshCommandSub(4, SEControlStructIndex) Case "GFStartStationCommandFixed(5)" Call StartStation_RefreshCommandSub(5, SEControlStructIndex) ' Case "GFStartStationCommandMovable(1)" Call StartStation_RefreshCommandSub(1, SEControlStructIndex) 'NOTE: the Skin Engine will load new command pictures automatically Case "GFStartStationCommandMovable(2)" Call StartStation_RefreshCommandSub(2, SEControlStructIndex) Case "GFStartStationCommandMovable(3)" Call StartStation_RefreshCommandSub(3, SEControlStructIndex) Case "GFStartStationCommandMovable(4)" Call StartStation_RefreshCommandSub(4, SEControlStructIndex) Case "GFStartStationCommandMovable(5)" Call StartStation_RefreshCommandSub(5, SEControlStructIndex) End Select End If End If End Select Case SECBMSG_SECONTROL_REFRESHED ' 'NOTE: some controls' h scroll bar must be updated when the control is refreshed '(the control's font size or other font settings could have been manipulated). 'Some controls need to be redrawn manually after having been refreshed. ' Select Case wParam 'control name Case "GUI1CopyDirList" Call GFListHScroll_AddScrollBars(GUI1CopyDirList) Case "GUI1MoveDirList" Call GFListHScroll_AddScrollBars(GUI1MoveDirList) Case "GUI2FilterList" Call GFListHScroll_AddScrollBars(GUI2FilterList) Case "GUI5DefaultList" Call GFListHScroll_AddScrollBars(GUI5DefaultList) Case "GUI6DefaultList" Call GFListHScroll_AddScrollBars(GUI6DefaultList) Case "GUIXItemList" Call GFListHScroll_AddScrollBars(GUIXItemList) Case "QPfrm.QPList" If (SystemForms_IsSystemFormLoaded(QPfrm)) Then 'should be true, as control isn't updated when not loaded and thus not visible Call GFListHScroll_AddScrollBars(QPfrm.QPList) End If Case "GUI4ColorSliderPicture" SEControlStructIndex = GetSEControlStructIndex("GUI4ColorSliderPicture") If Not (SEControlStructIndex = 0) Then 'verify If Not ( _ (SEControlStructArray(SEControlStructIndex).SEControl_FrameIndex < LBound(SESystemStructVar.SystemFrameColorArray())) Or _ (SEControlStructArray(SEControlStructIndex).SEControl_FrameIndex > UBound(SESystemStructVar.SystemFrameColorArray()))) Then 'verify frame is not disabled FrameColor = SESystemStructVar.SystemFrameColorArray(SEControlStructArray(SEControlStructIndex).SEControl_FrameIndex) If GFColor_IsBrightnessChangable(FrameColor, -32) = True Then 'must be equal to code in FrameBrushCache_Create() FrameShadowColor = GFColor_ChangeBrightness(FrameColor, -32) Else FrameShadowColor = GFColor_ChangeBrightness(FrameColor, 32) End If Call GUIXColorSlider.GFColorSliderFrame_SetColor(FrameColor, FrameShadowColor) 'NOTE: don't refresh 'GUI4ColorSlider' right here as this leads to frame errors (slider does not have final size). 'Call GUIXColorSlider.GFColorSlider_ShowProgress(GUIXColorSliderPicture, GUIXColorSlider.GFColorSlider_GetProgressCurrent) 'Call GUIXColorSlider.GFColorSlider_ShowAreaLegend(GUIXColorSliderLegendPicture, 2, 2, GUIXColorSliderLegendPicture.Width / Screen.TwipsPerPixelX - 4, GUIXColorSliderLegendPicture.Height / Screen.TwipsPerPixelY - 4, GUIXColorSliderPaletteCurrent, 1) End If End If Case "GUI11ColorSliderPicture" SEControlStructIndex = GetSEControlStructIndex("GUI11ColorSliderPicture") If Not (SEControlStructIndex = 0) Then 'verify If Not ( _ (SEControlStructArray(SEControlStructIndex).SEControl_FrameIndex < LBound(SESystemStructVar.SystemFrameColorArray())) Or _ (SEControlStructArray(SEControlStructIndex).SEControl_FrameIndex > UBound(SESystemStructVar.SystemFrameColorArray()))) Then 'verify frame is not disabled FrameColor = SESystemStructVar.SystemFrameColorArray(SEControlStructArray(SEControlStructIndex).SEControl_FrameIndex) If GFColor_IsBrightnessChangable(FrameColor, -32) = True Then 'must be equal to code in FrameBrushCache_Create() FrameShadowColor = GFColor_ChangeBrightness(FrameColor, -32) Else FrameShadowColor = GFColor_ChangeBrightness(FrameColor, 32) End If Call GUIXColorSlider.GFColorSliderFrame_SetColor(FrameColor, FrameShadowColor) Call GUIXColorSlider.GFColorSlider_ShowProgress(GUIXColorSliderPicture, GUIXColorSlider.GFColorSlider_GetProgressCurrent) Call GUIXColorSlider.GFColorSlider_ShowAreaLegend(GUIXColorSliderLegendPicture, 2, 2, GUIXColorSliderLegendPicture.Width / Screen.TwipsPerPixelX - 4, GUIXColorSliderLegendPicture.Height / Screen.TwipsPerPixelY - 4, GUIXColorSliderPaletteCurrent, 1) End If End If Case "GUI4ColorSliderLegendPicture" 'just redraw, no matter if preset 'NOTE: as the GFColorSlider now draws both the slider- and the legend picture frame the line below is not in use any more. 'Call GUIXColorSlider.GFColorSlider_ShowAreaLegend(GUIXColorSliderLegendPicture, 2, 2, GUIXColorSliderLegendPicture.Width / Screen.TwipsPerPixelX - 4, GUIXColorSliderLegendPicture.Height / Screen.TwipsPerPixelY - 4, GUIXColorSliderPaletteCurrent, 1) Case "GUI11ColorSliderLegendPicture" 'NOTE: as the GFColorSlider now draws both the slider- and the legend picture frame the line below is not in use any more. 'Call GUIXColorSlider.GFColorSlider_ShowAreaLegend(GUIXColorSliderLegendPicture, 2, 2, GUIXColorSliderLegendPicture.Width / Screen.TwipsPerPixelX - 4, GUIXColorSliderLegendPicture.Height / Screen.TwipsPerPixelY - 4, GUIXColorSliderPaletteCurrent, 1) End Select ' '***END OF (GENERAL) SECONTROL MESSAGE PROCESSING*** '***WINDOW OPEN/CLOSE MESSAGE PROCESSING*** ' Case SECBMSG_COLORCHOOSINGBOX_OPENED Call SystemForms_Disable(PROGRAMFORM_ALL) Case SECBMSG_COLORCHOOSINGBOX_CLOSED Call SystemForms_Enable Case SECBMSG_FONTCHOOSINGBOX_OPENED Call SystemForms_Disable(PROGRAMFORM_ALL Xor PROGRAMFORM_GFSELECTFONTFRM) Case SECBMSG_FONTCHOOSINGBOX_CLOSED Call SystemForms_Enable Case SECBMSG_BACKPICTURECHOOSINGBOX_OPENED Call SystemForms_Disable(PROGRAMFORM_ALL) Case SECBMSG_BACKPICTURECHOOSINGBOX_CLOSED Call SystemForms_Enable Case SECBMSG_TITLEBARPICTURECHOOSINGBOX_OPENED Call SystemForms_Disable(PROGRAMFORM_ALL) Case SECBMSG_TITLEBARPICTURECHOOSINGBOX_CLOSED Call SystemForms_Enable If (Len(wParam)) Then 'if user has chosen a picture If ActionTrackStructVar.TitleBarChangeInfoDisplayedFlag = False Then ActionTrackStructVar.TitleBarChangeInfoDisplayedFlag = True MsgBox "Note: if the title bar does not match the window width then it will be stretched at a default position. " + _ "If that stretching obviously messes up your title bar picture then change the stretching options. " + _ "Therefore enable the UserMove mode (Ctrl-Shift-F11) and hold down Ctrl and right-click on the window whose title bar " + _ "picture you just changed to open the Skin Engine Property Edit window. There you can modify " + _ "the values 'titlerbarspawnstartpos' and 'titlebarspawnlength'." + Chr$(13) + Chr$(10) + _ "Set the spawn start pos to a position (in pixels) where there is a part of your titlebar that can be spawned. " + _ "Set the spawn length to the length of the piece that can be spawned (this piece will be duplicated and inserted " + _ "at the start pos until the title bar has the window width)." + Chr$(13) + Chr$(10) + _ Chr$(13) + Chr$(10) + _ "If you have any further questions then mail me (louis@toricxs.com)" + Chr$(13) + Chr$(10) + _ "Have fun!", vbOKOnly + vbInformation End If End If Case SECBMSG_SKINTRANSFERFRM_OPENED Call SystemForms_Disable(PROGRAMFORM_ALL Xor PROGRAMFORM_SKINTRANSFERFRM) Case SECBMSG_SKINTRANSFERFRM_CLOSED Call SystemForms_Enable Case SECBMSG_SKINENGINEFRM_OPENED Call SystemForms_Disable(PROGRAMFORM_ALL Xor PROGRAMFORM_SKINENGINEFRM) Case SECBMSG_SKINENGINEFRM_CLOSED Call SystemForms_Enable Case SECBMSG_POLYRGNDESKFRM_OPENED Call SystemForms_Disable(PROGRAMFORM_ALL Xor PROGRAMFORM_POLYRGNDESKFRM) Case SECBMSG_POLYRGNDESKFRM_CLOSED Call SystemForms_Enable Case SECBMSG_PROPERTYEDITFRM_OPENED 'displayed in vbModal state 'do nothing (displayed in vbModal state) Case SECBMSG_PROPERTYEDITFRM_CLOSED 'do nothing (displayed in vbModal state) Case SECBMSG_FRAMEMAKERFRM_OPENED ' 'NOTE: we don't have a constant for FrameMakerfrm, but that's no 'problem as all forms are disabled when FrameMakerfrm is opened, 'it is not possible to open any other form which would require to 'disable FrameMakerfrm. ' Call SystemForms_Disable(PROGRAMFORM_ALL) ' FrameMakerfrm.Enabled = False 'we don't have a constant for this form, do it on the hard way If ProgramCommandStructVar.ExtendedHelpEnabledFlag = True Then _ Call ContextHelp_Show("SuddenText:40", True) 'tell user what the Frame Maker is good for FrameMakerfrm.Enabled = True 'reset FrameMakerfrm.SetFocus 'important (tested) ' Case SECBMSG_FRAMEMAKERFRM_CLOSED Call SystemForms_Enable End Select ' '***END OF WINDOW OPEN/CLOSE MESSAGE PROCESSING*** ' ' '***CONTEXTHELP EXTRA MESSAGE PROCESSING*** ' Select Case Msg Case SECBMSG_BEFORE_SKIN_SELECT, _ SECBMSG_BEFORE_SKIN_NEXT, _ SECBMSG_BEFORE_SKIN_PREVIOUS, _ SECBMSG_BEFORE_SKIN_COPY, _ SECBMSG_BEFORE_SKIN_DELETE, _ SECBMSG_BEFORE_SKIN_NEW, _ SECBMSG_BEFORE_SKIN_EXPORT, _ SECBMSG_BEFORE_SKIN_IMPORT If (SystemForms_IsSystemFormLoaded(GFContextHelpfrm)) Then If GFContextHelpfrm.Visible = True Then Call SEM_UserMove_Enable 'was disabled before through SE key hook event processing code MsgBox "Please close Context Help first (Esc) !", vbOKOnly + vbInformation ReturnValueUsedFlag = True ReturnValue = SECBMSG_REPLY_CANCEL End If End If End Select ' '***END OF CONTEXTHELP EXTRA MESSAGE PROCESSING*** ' Exit Sub End Sub Private Sub SE_ReceiveKeyHookEvent(ByVal wParam As String, ByVal lParam As String, ByRef ReturnValueUsedFlag As Boolean, ByRef ReturnValue As Long) 'on error resume next Dim KeyHookKeyCode As Integer Dim KeyHookShift As Integer Dim KeyHookKeyCodeString As String Dim KeyHookShiftString As String ' 'NOTE: this sub is MP3 Renamer 2 specific. It is called by SE_ReceiveCallBackMessage() 'and processes keyhook events so that short cuts are usable within MP3 Renamer 2 '(note that the Skin Engine also processes short cut key presses, but only Skin Engine 'specific short cuts such as Ctrl-Shift-F10). ' 'NOTE: always check the state of both special keys (Ctrl and Shift). 'Also check if the system is currently busy or if the target form of the short cut is disabled, 'then don't perform the short cut key action. ' 'If (KeyHook Shift And ...) Then ' If (Targetfrm.Enabled = True) And (Targetfrm.Visible = True) Then ' If ... Then ' Call TargetSub '[...] ' 'preset Call SPLITSTRINGS(lParam, KeyHookKeyCodeString, KeyHookShiftString) KeyHookKeyCode = Val(KeyHookKeyCodeString) KeyHookShift = Val(KeyHookShiftString) 'begin If UserMoveControlStructVar.UserMoveSystemEnabledFlag = False Then Select Case KeyHookKeyCode Case vbKeyH If KeyHookShift = (vbCtrlMask Or vbShiftMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If ProgramCommandStructVar.ExtendedHelpEnabledFlag = False Then If System_IsSystemBusy = False Then 'NOTE: see also ProgramReceivePopUpMenu_Click(). Call ContextHelp_ExtendedHelp_Enable Else MsgBox "Sorry, help is temporary unavailable !", vbOKOnly + vbInformation End If Else Call ContextHelp_ExtendedHelp_Disable End If End If End If Case vbKeyN If KeyHookShift = (vbCtrlMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If GUINextCommand.Enabled = True Then Call GUINextCommand_Click Else Select Case GUICStructVar.GUIPaletteNumberCurrent Case 1 Call SystemMessage_Display("Please add at least one scan directory !") Case 2 Call SystemMessage_Display("Please create at least one File Name Filter !") Case 4 Call SystemMessage_Display("Please read file data first !") Case 8 Call SystemMessage_Display("Please create new file names first !") End Select End If End If End If Case vbKeyB If KeyHookShift = (vbCtrlMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If GUIBackCommand.Enabled = True Then Call GUIBackCommand_Click End If End If Case vbKeyF1 If (KeyHookShift = 0) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If (System_IsSystemBusy = False) Then ' 'NOTE: the following line resets ContextHelp vars, enables the extended help system '(if not done yet) and displays the current StepDescription. ' 'Call ContextHelp_ExtendedHelp_Enable 'no, just display step description to keep ANT help enabled Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:" + LTrim$(Str$(GUICStructVar.GUIPaletteNumberCurrent))) Else MsgBox "Please wait for the current operation to be finished !", vbOKOnly + vbInformation 'no real error End If End If End If Case vbKeyF5 'NOT done by VB now through menu short cut (VB sucks!) If (SystemForms_IsSystemFormLoaded(Mfrm)) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then Select Case KeyHookShift Case 0 Call ZoomSlide_Center("Mfrm_1") Call SystemMessage_Display("Main Window centered.") Case vbShiftMask If Not (Mfrm.WindowState = vbNormal) Then Mfrm.WindowState = vbNormal Case vbCtrlMask If Not (Mfrm.WindowState = vbMinimized) Then Mfrm.WindowState = vbMinimized End Select End If End If Case vbKeyF6 If (SystemForms_IsSystemFormLoaded(QPfrm)) Then If (QPfrm.Enabled = True) And (QPfrm.Visible = True) And (QPfrm.WindowState = vbNormal) Then 'verify Select Case KeyHookShift Case 0 Call ZoomSlide_Center("QPfrm") Call SystemMessage_Display("Quick Play Window centered.") Case vbShiftMask If Not (QPfrm.WindowState = vbNormal) Then QPfrm.WindowState = vbNormal Case vbCtrlMask If Not (QPfrm.WindowState = vbMinimized) Then QPfrm.WindowState = vbMinimized End Select End If End If Case vbKeyF7 If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then If (TAGfrm.Enabled = True) And (TAGfrm.Visible = True) And (TAGfrm.WindowState = vbNormal) Then 'verify Select Case KeyHookShift Case 0 Call ZoomSlide_Center("TAGfrm") Call SystemMessage_Display("TAG Edit Window centered.") Case vbShiftMask If Not (TAGfrm.WindowState = vbNormal) Then TAGfrm.WindowState = vbNormal Case vbCtrlMask If Not (TAGfrm.WindowState = vbMinimized) Then TAGfrm.WindowState = vbMinimized End Select End If End If Case vbKeyF8 If (SystemForms_IsSystemFormLoaded(LWCfrm)) Then If (LWCfrm.Enabled = True) And (LWCfrm.Visible = True) And (LWCfrm.WindowState = vbNormal) Then 'verify Select Case KeyHookShift Case 0 Call ZoomSlide_Center("LWCfrm") Call SystemMessage_Display("Tool Window centered.") Case vbShiftMask If Not (LWCfrm.WindowState = vbNormal) Then LWCfrm.WindowState = vbNormal Case vbCtrlMask If Not (LWCfrm.WindowState = vbMinimized) Then LWCfrm.WindowState = vbMinimized End Select End If End If Case vbKeyL If KeyHookShift = (vbCtrlMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If System_IsSystemBusy = False Then 'don't show QLfrm if the system is busy as in QLfrm there are further actions done (avoid recursion with DoEvents) Call QL_Show End If End If End If Case vbKeyQ If KeyHookShift = (vbCtrlMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If System_IsSystemBusy = False Then 'don't show QPfrm if the system is busy or there will be problems with its enabled/disabled states Call QPfrm.QP_Show End If End If End If Case vbKeyP If KeyHookShift = (vbCtrlMask) Then 'If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then Call QPfrm.QPList_RandomPlay 'End If End If Case vbKeyF If KeyHookShift = (vbCtrlMask) Then If (LWCfrm.Enabled = True) And (LWCfrm.Visible = True) And (LWCfrm.WindowState = vbNormal) Then If System_IsSystemBusy = False Then Call LWCfrm.LWCSearchNextCommand_Click End If End If End If Case vbKeyG If KeyHookShift = (vbCtrlMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If System_IsSystemBusy = False Then Call Fun_AgentTest End If End If End If Case vbKeyH If KeyHookShift = (vbCtrlMask) Then If (SystemForms_IsSystemFormLoaded(LWCfrm)) Then If (LWCfrm.Enabled = True) And (LWCfrm.Visible = True) And (LWCfrm.WindowState = vbNormal) Then If System_IsSystemBusy = False Then Call LWCfrm.LWCSearchAllCommand_Click End If End If End If End If Case vbKeyA If KeyHookShift = (vbCtrlMask) Then If (SystemForms_IsSystemFormLoaded(LWCfrm)) Then If (LWCfrm.Enabled = True) And (LWCfrm.Visible = True) And (LWCfrm.WindowState = vbNormal) Then If System_IsSystemBusy = False Then Call LWCfrm.LWCSelectAllCommand_Click End If End If End If If GUICStructVar.GUIPaletteNumberCurrent = 1 Then If System_IsSystemBusy = False Then Call GUI1AddCommand_Click End If End If End If Case vbKeyS If KeyHookShift = (vbCtrlMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If GUICStructVar.GUIPaletteNumberCurrent = 1 Then If System_IsSystemBusy = False Then Call GUI1ScanCommand_Click End If End If End If End If Case vbKeyM If KeyHookShift = (vbCtrlMask Or vbShiftMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If GUICStructVar.GUIPaletteNumberCurrent = 1 Then If System_IsSystemBusy = False Then Call GUI1MegaScanCommand_Click End If End If End If End If Case vbKeyD If KeyHookShift = (vbCtrlMask Or vbShiftMask) Then If (SystemForms_IsSystemFormLoaded(LWCfrm)) Then If (LWCfrm.Enabled = True) And (LWCfrm.Visible = True) And (LWCfrm.WindowState = vbNormal) Then If System_IsSystemBusy = False Then Call LWCfrm.LWCSelectNoneCommand_DblClick End If End If End If End If Case vbKeyT If KeyHookShift = (vbCtrlMask) Then If (Mfrm.Visible = True) And (Mfrm.Enabled = True) And (Mfrm.WindowState = vbNormal) Then If System_IsSystemBusy = False Then If GUICStructVar.GUIPaletteNumberCurrent = 9 Then Call GUI9_SelectionToTop(FileInfoStructNumber, FileInfoStructArray(), GUIXListViewStructVar) End If End If End If End If Case vbKey1 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 1)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(1) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey2 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 2)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(2) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey3 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 3)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(3) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey4 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 4)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(4) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey5 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 5)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(5) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey6 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 6)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(6) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey7 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 7)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(7) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey8 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 8)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(8) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey9 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 9)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(9) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKey0 If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 10)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(10) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKeyE If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 11)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(11) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKeyR If (Mfrm.Enabled) And (Mfrm.Visible) And (Mfrm.WindowState = vbNormal) And KeyHookShift = (vbCtrlMask) And (Not (GUICStructVar.GUIPaletteNumberCurrent = 12)) Then If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(12) Else MsgBox "Sorry, you cannot go to an other step as currently any operation is performed.", vbOKOnly + vbInformation End If End If Case vbKeyEscape If (KeyHookShift = 0) Then If GFCCDD_IsDragExisting = True Then Call GFCCDD_Abort 'to hell with drop GoTo Jump: End If If ContextHelpStructVar.ContextHelpEnabledFlag = True Then Call SE_ContextHelp_Disable GoTo Jump: End If If Fun_IsSoundPlaying = True Then 'NOTE: when the message below is removed, message "call Fun_DeleteSound()" is sent automatically. Call Msg_Remove("wait for call Fun_DeleteSound()") GoTo Jump: End If If (SystemForms_IsSystemFormLoaded(GFContextHelpfrm)) Then If (GFContextHelpfrm.Enabled) And (GFContextHelpfrm.Visible) Then Call GFContextHelpfrm.ContextHelp_Hide 'to hell with context help GoTo Jump: End If End If If (GUICancelCommand.Visible = True) And (System_IsSystemBusy = True) Then 'GUICancelCommand also visible in UserMove mode, check if system is busy Call GUICancelCommand_Click GoTo Jump: End If Jump: End If End Select End If End Sub '**************************END OF CALL BACK SUBS: SKIN ENGINE************************** '************************CALL BACK SUBS: PROGRAM MESSAGE SYSTEM************************ 'NOTE: the program message system is an important part of this project. 'The program messages are mostly used to perform any action with a delay 'so that the message-creating sub/function can be left before the message 'action is performed. 'The program message system is also used to call special subs/function 'periodically (e.g. reloading GUI10ListView). Public Sub GFPMS_ReceiveEventEx(ByVal MsgName As String, ByRef MsgParamArray() As String, ByVal MsgParamNumber As Integer) 'on error Resume Next 'sub belonging to the GFPMS system Dim SEControlStructIndex As Integer Dim ScreenMousePointerUnchanged As Integer Dim Temp As Long Dim TempBoolean As Boolean 'begin Call DEBUG_LogFile_Entry("Program Message: " + MsgName) Select Case MsgName ' '***FORWARDING MESSAGES*** ' Case "call GUI1Dirs_Add()" If MsgParamNumber = 1 Then 'verify Dim AddDir As String Dim AddDirSerialNumber As String AddDir = MsgParamArray(1) AddDirSerialNumber = GetDriveSerialNumber(AddDir) If GetDirFileCount(AddDir) = 0 Then 'no mp3 files in directory to add If MsgBox("Sorry, you cannot add an empty directory !" + Chr$(10) + "Do you want to scan all sub directories now (recommended) ?", vbYesNo + vbExclamation) = vbYes Then Call GUI1Dirs_Scan(AddDir) End If Else Call GUI1Dirs_Add(AddDir, AddDirSerialNumber) 'would add an empty directory End If End If Case "call GUI1Dirs_Scan()" If MsgParamNumber = 1 Then 'verify Dim ScanDir As String 'scan directory ScanDir = MsgParamArray(1) Call GUI1Dirs_Scan(ScanDir) 'display info message if necessary If FileInfoStructNumber > 0 Then If GUI1StructVar.ReadNewInfoMessageDisplayedFlag = False Then GUI1StructVar.ReadNewInfoMessageDisplayedFlag = True MsgBox "Note: you must read the files of newly added directories by pressing the 'Read New' button in step 4." + Chr$(10) + "Changes done to the TAG data of already read files will be retained.", vbOKOnly + vbInformation End If End If End If Case "call GUI1MegaScanCommand_Click" Call GUI1MegaScanCommand_Click Case "after GUI5 artist name check" 'called AFTER a check has been executed ' 'NOTE: the GuideStructVar flags are reset in GUIPalette_BeforeChange(). ' Select Case GUI5StructVar.CheckItemType Case CONST_SONGNAME GuideStructVar.GUI5SongNameCheckedFlag = True Case CONST_ARTISTNAME GuideStructVar.GUI5ArtistNameCheckedFlag = True End Select If (GuideStructVar.GUI5SongNameCheckedFlag = True) And (GuideStructVar.GUI5ArtistNameCheckedFlag = False) Then If MsgBox("Do you also want to check the artist names for spelling errors ?", vbYesNo + vbQuestion) = vbYes Then 'perform song name check GUI5ItemTypeCombo.TEXT = GUI5ItemTypeCombo.List(1) 'artist name Call GUI5CheckCommand_Click Else 'goto GUI6 Call MsgPacket_Create("GUI palette number") Call MsgPacket_AddItem("GUI palette number", "6") Call Msg_AddEx(MSG_NORMAL_EVENT, "1", "0", "change GUI palette", "GUI palette number") End If End If If (GuideStructVar.GUI5SongNameCheckedFlag = False) And (GuideStructVar.GUI5ArtistNameCheckedFlag = True) Then If MsgBox("Do you also want to check the song names for spelling errors ?", vbYesNo + vbQuestion) = vbYes Then 'perform song name check GUI5ItemTypeCombo.TEXT = GUI5ItemTypeCombo.List(0) 'song name Call GUI5CheckCommand_Click Else 'goto GUI6 Call MsgPacket_Create("GUI palette number") Call MsgPacket_AddItem("GUI palette number", "6") Call Msg_AddEx(MSG_NORMAL_EVENT, "1", "0", "change GUI palette", "GUI palette number") End If End If If (GuideStructVar.GUI5SongNameCheckedFlag = True) And (GuideStructVar.GUI5ArtistNameCheckedFlag = True) Then 'goto GUI6 Call MsgPacket_Create("GUI palette number") Call MsgPacket_AddItem("GUI palette number", "6") Call Msg_AddEx(MSG_NORMAL_EVENT, "1", "0", "change GUI palette", "GUI palette number") End If Case "after GUI6 artist name check" 'called AFTER a check has been executed Select Case GUI6StructVar.CheckItemType Case CONST_SONGNAME GuideStructVar.GUI6SongNameCheckedFlag = True Case CONST_ARTISTNAME GuideStructVar.GUI6ArtistNameCheckedFlag = True End Select If (GuideStructVar.GUI6SongNameCheckedFlag = True) And (GuideStructVar.GUI6ArtistNameCheckedFlag = False) Then If MsgBox("Do you also want to check the artist names for inclusion errors ?", vbYesNo + vbQuestion) = vbYes Then 'perform song name check GUI6ItemTypeCombo.TEXT = GUI6ItemTypeCombo.List(1) 'artist name Call GUI6CheckCommand_Click Else 'goto GUI7 Call MsgPacket_Create("GUI palette number") Call MsgPacket_AddItem("GUI palette number", "7") Call Msg_AddEx(MSG_NORMAL_EVENT, "1", "0", "change GUI palette", "GUI palette number") End If End If If (GuideStructVar.GUI6SongNameCheckedFlag = False) And (GuideStructVar.GUI6ArtistNameCheckedFlag = True) Then If MsgBox("Do you also want to check the song names for inclusion errors ?", vbYesNo + vbQuestion) = vbYes Then 'perform song name check GUI6ItemTypeCombo.TEXT = GUI6ItemTypeCombo.List(0) 'song name Call GUI6CheckCommand_Click Else 'goto GUI7 Call MsgPacket_Create("GUI palette number") Call MsgPacket_AddItem("GUI palette number", "7") Call Msg_AddEx(MSG_NORMAL_EVENT, "1", "0", "change GUI palette", "GUI palette number") End If End If If (GuideStructVar.GUI6SongNameCheckedFlag = True) And (GuideStructVar.GUI6ArtistNameCheckedFlag = True) Then 'goto GUI7 Call MsgPacket_Create("GUI palette number") Call MsgPacket_AddItem("GUI palette number", "7") Call Msg_AddEx(MSG_NORMAL_EVENT, "1", "0", "change GUI palette", "GUI palette number") End If Case "call GUI9ListView_SelectionChanged" Call GUI9ListView_SelectionChanged 'refresh LWCSelectionInfoLabel (selection changes AFTER click-event) Case "call GUI9RecoverFileText_ReceiveFile()" Call GUI9RecoverFileText_ReceiveFile(MsgParamArray(1)) Call Msg_Remove(MsgName) 'reset Case "call GUI9_MfrmSizeChange_Save" 'NOTE: we avoid ruckling etc. when currently sizing form through checking the LBUTTON state. If (GetAsyncKeyState(VK_LBUTTON)) Then If GetMsgStructIndex("call GUI9_MfrmSizeChange_Save") = 0 Then Call Msg_Add("call GUI9_MfrmSizeChange_Save") 'delay message processing Else Call GUI9_MfrmSizeChange_Save End If Case "call GUI10_MfrmSizeChange_Save" 'NOTE: we avoid ruckling etc. when currently sizing form through checking the LBUTTON state. If (GetAsyncKeyState(VK_LBUTTON)) Then If GetMsgStructIndex("call GUI10_MfrmSizeChange_Save") = 0 Then Call Msg_Add("call GUI10_MfrmSizeChange_Save") 'delay message processing Else Call GUI10_MfrmSizeChange_Save End If Case "call GUI10TreeView_ProcessClick()" ' 'NOTE: the SelectedItemName property changes when the mouse 'button is released. As the stupid Windows does not send a 'WM_LBUTTONUP message, this message system loop must 'be used to check if the selected item has been changed. 'Note that GUI10TreeView_ProcessClick() is called permanently 'through the GFPMS, and also through CC_Click() to process 'right-click messages. When the palette changes to GUI10 then a 'call GUI10TreeView_ProcessClick()-message is added to 'begin the process click-message loop. ' Call GUI10TreeView_ProcessClick(vbLeftButton, 0, 0) Call Msg_Remove(MsgName) 'reset ' If GUICStructVar.GUIPaletteNumberCurrent = 10 Then Call Msg_Add("call GUI10TreeView_ProcessClick()") End If ' Case "call ZoomSlide_MoveSub()" Call ZoomSlide_MoveSub(ZoomSlideStructVar) Case "call ZoomSlide_SaveFormPos()" Call ZoomSlide_SaveFormPos(ZoomSlideStructVar) 'Case "call Idle_Update()" 'see SystemUpdateTimer ' Call Idle_Update(False) ' Call Msg_Add("call Idle_Update()") 'endless message loop Case "call TAGfrm.ChangePreview_Tick" 'see SystemUpdateTimer Call TAGfrm.ChangePreview_Tick Case "call Agent_Hide" Call Agent_Hide Case "call UpdateSkin" If (System_IsSystemBusy = False) And (SE_IsSystemBusy = False) Then 'do not reload when currently reloading Call UpdateSkin Else If GetMsgStructIndex("call UpdateSkin") = 0 Then Msg_Add ("call UpdateSkin") End If ' '***END OF FORWARDING MESSAGES*** '***FUN MESSAGES*** ' Case "call Fun_FormQuake()" Call Fun_FormQuake(MsgParamArray(1)) Case "call Fun_DeleteSound()" Call Fun_DeleteSound(MsgParamArray(1)) ' '***END OF FUN MESSAGES*** '***GUI MESSAGES*** ' Case "change GUI palette" Call Msg_Remove(MsgName) 'reset Call MsgPacket_Remove("GUI palette number") 'reset (important) If (Not ((Val(MsgParamArray(1)) < GUICStructVar.GUIPaletteStartIndex) Or (Val(MsgParamArray(1)) > GUICStructVar.GUIPaletteEndIndex))) Or _ (Val(MsgParamArray(1)) = 12) Then 'verify 'NOTE: the user can go to step 12 after renaming files in any case. If System_IsSystemBusy = False Then Call GUIC_DoPaletteChange(Val(MsgParamArray(1))) Else 'try in next loop circle (until palette change is possible, good thing to wait, saves much work (bless it :-] )) Call MsgPacket_Create("GUI palette number") Call MsgPacket_AddItem("GUI palette number", MsgParamArray(1)) Call Msg_AddEx(MSG_NORMAL_EVENT, "1", "0", "change GUI palette", "GUI palette number") End If End If Case "Call GUICurtain_Hide" Call GUICurtain_Hide Case "Call GUICurtain_HideEx" Call GUICurtain_HideEx ' '***END OF GUI MESSAGES*** '***RESTORE MESSAGES*** ' Case "restore Mfrm" Mfrm.Enabled = True Mfrm.Visible = True Mfrm.WindowState = vbNormal Mfrm.Refresh Case "restore StepLabel.Caption" Call Msg_Remove("wait for restore StepLabel.Caption") 'reset If SystemMessageStructVar.StepLabelCaptionUnchangedStoredFlag = True Then 'verify SystemMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False 'reset If StepLabel.Caption = SystemMessageStructVar.StepLabelCaptionTemp Then 'verify StepLabel.Caption = SystemMessageStructVar.StepLabelCaptionUnchanged StepLabel.Refresh 'important Else 'StepLabel caption has been changed by system, neither the temporary system message 'nor the stored unchanged caption is valid any more. End If End If Case "restore LWCfrm.LWCSelectionInfoLabel.Caption" Call Msg_Remove("wait for restore LWCfrm.LWCSelectionInfoLabel.Caption") 'reset Call LWCfrm.LWCMessage_Remove Case "recreate form back picture" ScreenMousePointerUnchanged = Screen.MousePointer Screen.MousePointer = vbHourglass If MsgParamNumber = 1 Then 'verify SEControlStructIndex = Val(MsgParamArray(1)) If Not ((SEControlStructIndex < 1) Or (SEControlStructIndex > SEControlStructNumber)) Then 'verify Call SE_UnloadControl(SEControlStructArray(SEControlStructIndex).SEControlName, SEControlStructIndex) Call SE_LoadControl(SEControlStructArray(SEControlStructIndex).SEControlName, True, SEControlStructIndex) Call SE_RefreshControl(SEControlStructArray(SEControlStructIndex).SEControlName, 0, SEControlStructIndex) End If End If Screen.MousePointer = ScreenMousePointerUnchanged 'reset ' '***END OF RESTORE MESSAGES*** '***UPDATE SYSTEM MESSAGES*** ' Case "FilterStructArray() changed" ' 'NOTE: call GUIC_Refresh() after GUICStruct_Update() to allow 'enabling the GUINextCommand (system requires to do this). ' Call GUICStruct_Update(GUICStructVar) Call GUIC_VerifyPaletteNumber(GUICStructVar.GUIPaletteNumberCurrent) Call GUIC_RefreshCommands(GUICStructVar) Call Msg_Remove(MsgName) 'reset Case "FileSystemStructVar changed" Call Statistics1Label_Update Call GUICStruct_Update(GUICStructVar) Call GUIC_VerifyPaletteNumber(GUICStructVar.GUIPaletteNumberCurrent) Call GUIC_RefreshCommands(GUICStructVar) Call QPList_Reload 'display changes (also through Update System) Call Msg_Remove(MsgName) 'reset Case "GUI3StructVar changed" Call GUICStruct_Update(GUICStructVar) Call GUIC_VerifyPaletteNumber(GUICStructVar.GUIPaletteNumberCurrent) Call GUIC_RefreshCommands(GUICStructVar) Call Msg_Remove(MsgName) 'reset Case "FileInfoStructArray() changed" Call Statistics1Label_Update Call GUICStruct_Update(GUICStructVar) Call GUIC_VerifyPaletteNumber(GUICStructVar.GUIPaletteNumberCurrent) Call GUIC_RefreshCommands(GUICStructVar) Call Msg_Remove(MsgName) 'reset Case "update GUI10" Call GUI_Wait Call GUI10TreeView_Reload(FileInfoStructNumber, FileInfoStructArray()) Call GUI10ListView_Reload(GUI10TreeView.SelectedItemName) Call GUI_Continue ' '***END OF UPDATE SYSTEM MESSAGES*** '***CONTEXT HELP MESSAGES*** ' Case "display mouse pointer at control pos" ' 'NOTE: use this message to set the mouse pointer to the right bottom corner 'of the control whose SEControlStructIndex is the first message parameter. 'A mouse animation will be played , too. 'Move the mouse pointer to any control that is to gain the user's attention. ' If MsgParamNumber = 1 Then 'verify If Not ((MsgParamArray(1) < 1) Or (MsgParamArray(1) > SEControlStructNumber)) Then 'verify Call MousePointer_Move(MsgParamArray(1), True) End If End If ' Case "simulate ProgramContextHelpCommand click" Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 'tests showed that it is important to choose the command to press Call MessageRestore_BroadcastMsg("ProgramContextHelpCommandMovable", ProgramContextHelpCommand.hwnd, WM_LBUTTONDOWN, 0, 0, Temp, TempBoolean) Call MessageRestore_BroadcastMsg("ProgramContextHelpCommandMovable", ProgramContextHelpCommand.hwnd, WM_LBUTTONUP, 0, 0, Temp, TempBoolean) Case Else Call MessageRestore_BroadcastMsg("ProgramContextHelpCommandFixed", ProgramContextHelpCommand.hwnd, WM_LBUTTONDOWN, 0, 0, Temp, TempBoolean) Call MessageRestore_BroadcastMsg("ProgramContextHelpCommandFixed", ProgramContextHelpCommand.hwnd, WM_LBUTTONUP, 0, 0, Temp, TempBoolean) End Select Case "ContextHelp event" Call ContextHelp_ReceiveEvent(MsgParamArray(1), "") Case "display ContextHelp" 'NOTE: generally GFContextHelp will ignore StayOnTopFlag = True if no links are displayed. Do While Msg_Remove("display ContextHelp") = True Loop 'verify all messages are removed (necessary, tested) Call ContextHelpHeader_Refresh(MsgParamArray(1)) 'control name 'NOTE: as ContextHelp_GetContextHelpWindowPos() was already used we call ContextHelp_ShowEx() (extended). Call ContextHelp_ShowEx(MsgParamArray(1), MsgParamArray(2), MsgParamArray(3), True) Case "display ContextHelp centered" Do While Msg_Remove("display ContextHelp centered") = True Loop 'verify all messages are removed (necessary, tested) Call ContextHelpHeader_Refresh(MsgParamArray(1)) 'control name 'NOTE: as ContextHelp_GetContextHelpWindowPos() was already used we call ContextHelp_ShowEx() (extended). Call ContextHelp_ShowEx(MsgParamArray(1), GFCONTEXTHELP_CENTERED, GFCONTEXTHELP_CENTERED, True) Case "display ContextHelp at mouse pointer position" Do While Msg_Remove("display ContextHelp at mouse pointer position") = True Loop 'verify all messages are removed (necessary, tested) Call ContextHelpHeader_Refresh(MsgParamArray(1)) 'control name 'NOTE: as ContextHelp_GetContextHelpWindowPos() was already used we call ContextHelp_ShowEx() (extended). Call ContextHelp_ShowEx(MsgParamArray(1), GFCONTEXTHELP_ATMOUSEPOINTERPOS, GFCONTEXTHELP_ATMOUSEPOINTERPOS, True) ' 'NOTE: about context help: '-to display context help centered use the message 'display ContextHelp centered'; '-to display context help at the cursor position (without GFMouseGuide animation) ' use the message 'display ContextHelp at mouse pointer position'; '-to display context help at the related control's position with a GFMouseGuide ' animation use the procedure SE_ContextHelp_ReceiveControlName(). ' SE_ContextHelp_ReceiveControlName() will indirectly call the procedure ' ContextHelp_GetContextHelpWindowPos() and will indirectly use the ' message 'display ContextHelp'. ' '***END OF CONTEXT HELP MESSAGES*** '***OTHER*** ' ' Case "call SystemForms_GarbageCollect" 'see SystemUpdateTimer ' Do While Msg_Remove("call SystemForms_GarbageCollect") = True ' Loop 'verify ' Call SystemForms_GarbageCollect ' Call Msg_Add("call SystemForms_GarbageCollect") 'do it again in next loop circle Case "cancel" ' 'NOTE: cancel messages are processed by the Abort sub system. ' End Select End Sub '********************END OF CALL BACK SUBS: PROGRAM MESSAGE SYSTEM********************* '********************************CALL BACK SUBS: OTHER********************************* Public Sub GFCompression_CallBackSub(ByVal ProcedureName As String, _ ByVal FileNumberCurrent As Integer, ByVal FileNumberTotal As Integer, _ ByVal FileName As String, ByVal BytesProcessed As Long, ByVal BytesTotal As Long, _ ByRef CancelFlag As Boolean) 'on error resume next ' 'NOTE: if ProcedureName is GFCompression_CompressFile() or 'GFCompression_DecompressFile() then BytesProcessed and BytesTotal are 'valid. The call back sub is called after the whole file or the maximal possible 'block length has been processed. 'If ProcedureName is GFCompression_CompressionPack_Create() or 'GFCompression_CompressionPack_Unpack() then FileNumberCurrent and 'FileNumberTotal are valid. The call back sub is called before a file is packed 'or unpacked. FileName is always valid, it contains a full path to the file that is 'currently compressed or decompressed, packed or unpacked. The call back sub 'is also called if a file has been processed (ProcedureName + ": ok") or if there 'has been an error processing the current file (ProcedureName + ": error"). ' Select Case ProcedureName Case "GFCompression_CompressionPack_Create()" Call SystemManualMessage_Show("Packing file " + LTrim$(Str$(FileNumberCurrent)) + " of " + LTrim$(Str$(FileNumberTotal)) + ": " + GetFileName(FileName)) Case "GFCompression_CompressionPack_Create(): ok" Call SystemManualMessage_Hide Case "GFCompression_CompressionPack_Create(): error" Call SystemManualMessage_Hide Case "GFCompression_CompressionPack_Unpack()" Call SystemManualMessage_Show("Unpacking file " + LTrim$(Str$(FileNumberCurrent)) + " of " + LTrim$(Str$(FileNumberTotal)) + ": " + GetFileName(FileName)) Case "GFCompression_CompressionPack_Unpack(): ok" Call SystemManualMessage_Hide Case "GFCompression_CompressionPack_Unpack(): error" Call SystemManualMessage_Hide Case "GFCompression_CompressFile()" Call System_DoEvents 'allow redrawing windows Case "GFCompression_DecompressFile()" Call System_DoEvents 'allow redrawing windows End Select End Sub Public Sub GFInfoTrailer_Tick() 'on error resume next 'not in use, for compatibility reasons only End Sub Private Sub MfrmSizeChanged(ByVal MfrmWidthOld As Single, ByVal MfrmHeightOld As Single, ByVal MfrmWindowStateOld As Integer, ByVal MfrmWidthNew As Single, ByVal MfrmHeightNew As Single, ByVal MfrmWindowStateNew As Integer) 'on error resume next 'format: Twips Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9 Call GUI9_MfrmSizeChanged(MfrmWidthNew, MfrmHeightNew, MfrmWindowStateNew) Case 10 Call GUI10_MfrmSizeChanged(MfrmWidthNew, MfrmHeightNew, MfrmWindowStateNew) End Select End Sub '****************************END OF CALL BACK SUBS: OTHER****************************** '********************************END OF CALL BACK SUBS********************************* '*************************************CONTEXT HELP************************************* 'NOTE: the ContextHelp code is an MP3 Renamer 2 specific extension of the 'GFContextHelp system. Private Sub ContextHelp_ExtendedHelp_Enable() 'on error resume next ProgramCommandStructVar.ExtendedHelpEnabledFlag = True ' ExtendedHelpStructVar.GUI5SolvingTipGivenFlag = False 'reset ExtendedHelpStructVar.GUI6SolvingTipGivenFlag = False 'reset ExtendedHelpStructVar.GUI7SolvingTipGivenFlag = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(1) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(2) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(3) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(4) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(5) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(6) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(7) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(8) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(9) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(10) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(11) = False 'reset GUICStructVar.GUIPaletteStepDescriptionDisplayedFlagArray(12) = False 'reset 'NOTE: the ActionTrackStructVar members are not reset. ' Call SystemMessage_Display("Extended help enabled") Call Msg_AddAndPack("display ContextHelp centered", "StepDescription:" + LTrim$(Str$(GUICStructVar.GUIPaletteNumberCurrent))) End Sub Private Sub ContextHelp_ExtendedHelp_Disable() 'on error resume next ProgramCommandStructVar.ExtendedHelpEnabledFlag = False Call SystemMessage_Display("Extended help disabled") Call ContextHelp_Hide 'although Mfrm should be disabled when context help is displayed End Sub Public Sub ContextHelp_GetContextHelpWindowPos(ByVal ControlName As String, ByVal WindowPosProposed As Long, ByRef WindowXPos As Long, ByRef WindowYPos As Long) 'also used by Pmod 'on Leave resume next 'moves window if context help form must be located under a special control (usable during wizard help); WindowPosProposed is passed as lParam in Skin Engine message; format: pixels Dim SEControlStructIndex1 As Integer 'control parent form index Dim SEControlStructIndex2 As Integer 'control index ' 'NOTE: WindowXPos may be set to GFCONTEXTHELP_ATSECONTROLPOS 'to make the context help system display a mouse animation that demonstrates 'the user the position of the related control. 'The window will be placed within the screen rect automatically, but note that 'then the context help window may not be placed exactly below the control. ' 'IMPORTANT: do not use 'GUI4TreeView', use 'GUI4TreeViewPicture' '(the tree view itself is at position 0, 0), ' Select Case ControlName 'see MP3 Renamer 2 ContextHelpFile, case sensitive Case "WizardHelp:110" SEControlStructIndex2 = GetSEControlStructIndex("GUI1AddCommand") GoSub WindowPosFromControlPos: Case "WizardHelp:120" SEControlStructIndex2 = GetSEControlStructIndex("GUI1ScanCommand") GoSub WindowPosFromControlPos: Case "WizardHelp:130" SEControlStructIndex2 = GetSEControlStructIndex("GUI1MegaScanCommand") GoSub WindowPosFromControlPos: Case "WizardHelp:260" SEControlStructIndex2 = GetSEControlStructIndex("GUI2SongNameStartStringText") GoSub WindowPosFromControlPos: Case "WizardHelp:270" SEControlStructIndex2 = GetSEControlStructIndex("GFTextMarkerPicture") GoSub WindowPosFromControlPos: Case "GFTextMarkerPicture" SEControlStructIndex2 = GetSEControlStructIndex("GFTextMarkerPicture") GoSub WindowPosFromControlPos: Case "WizardHelp:310" SEControlStructIndex2 = GetSEControlStructIndex("GUI3CutCharText") GoSub WindowPosFromControlPos: Case "WizardHelp:320" SEControlStructIndex2 = GetSEControlStructIndex("GUI3ReplaceCharText") GoSub WindowPosFromControlPos: Case "WizardHelp:330" SEControlStructIndex2 = GetSEControlStructIndex("GUI3NoUCaseText") GoSub WindowPosFromControlPos: Case "WizardHelp:340" SEControlStructIndex2 = GetSEControlStructIndex("GUI3NoLCaseText") GoSub WindowPosFromControlPos: Case "WizardHelp:350" SEControlStructIndex2 = GetSEControlStructIndex("GUI3ExpressionText") GoSub WindowPosFromControlPos: Case "WizardHelp:360" SEControlStructIndex2 = GetSEControlStructIndex("GUI3TestText") GoSub WindowPosFromControlPos: Case "WizardHelp:410" SEControlStructIndex2 = GetSEControlStructIndex("GUI4TreeViewPicture") GoSub WindowPosFromControlPos: Case "WizardHelp:520" SEControlStructIndex2 = GetSEControlStructIndex("GUI5DefaultList") GoSub WindowPosFromControlPos: Case "WizardHelp:540" SEControlStructIndex2 = GetSEControlStructIndex("GUI5NewText") GoSub WindowPosFromControlPos: Case "WizardHelp:550" SEControlStructIndex2 = GetSEControlStructIndex("GUI5ItemList") GoSub WindowPosFromControlPos: Case "WizardHelp:630" SEControlStructIndex2 = GetSEControlStructIndex("GUI6DefaultList") GoSub WindowPosFromControlPos: Case "WizardHelp:640" SEControlStructIndex2 = GetSEControlStructIndex("GUI6NewText") GoSub WindowPosFromControlPos: Case "WizardHelp:650" SEControlStructIndex2 = GetSEControlStructIndex("GUI6ItemList") GoSub WindowPosFromControlPos: Case "WizardHelp:710" SEControlStructIndex2 = GetSEControlStructIndex("GUI7ListViewPicture") GoSub WindowPosFromControlPos: Case "WizardHelp:720" SEControlStructIndex2 = GetSEControlStructIndex("GUI7SwappedCommand") GoSub WindowPosFromControlPos: Case "WizardHelp:730" SEControlStructIndex2 = GetSEControlStructIndex("GUI7ArtistNameErrorCommand") GoSub WindowPosFromControlPos: Case "WizardHelp:740" SEControlStructIndex2 = GetSEControlStructIndex("GUI7OkCommand") GoSub WindowPosFromControlPos: Case "WizardHelp:810" SEControlStructIndex2 = GetSEControlStructIndex("GUI8FileFormatText") GoSub WindowPosFromControlPos: Case "WizardHelp:820" SEControlStructIndex2 = GetSEControlStructIndex("GUI8DirFormatText") GoSub WindowPosFromControlPos: Case "WizardHelp:850" SEControlStructIndex2 = GetSEControlStructIndex("GUI8DeleteEmptySourceFoldersCheck") GoSub WindowPosFromControlPos: Case "WizardHelp:860" SEControlStructIndex2 = GetSEControlStructIndex("GUI8DoubledFilesPicture") GoSub WindowPosFromControlPos: Case "WizardHelp:880" SEControlStructIndex2 = GetSEControlStructIndex("GUI8LogFileEnabledCheck") GoSub WindowPosFromControlPos: Case "WizardHelp:881" SEControlStructIndex2 = GetSEControlStructIndex("GUI8RetainAllFileNamesCheck") GoSub WindowPosFromControlPos: Case "WizardHelp:882" SEControlStructIndex2 = GetSEControlStructIndex("GUI8RetainLongFileNamesCheck") GoSub WindowPosFromControlPos: Case "WizardHelp:883" SEControlStructIndex2 = GetSEControlStructIndex("GUI8FormatRetainedFileNamesCheck") GoSub WindowPosFromControlPos: Case "WizardHelp:884" SEControlStructIndex2 = GetSEControlStructIndex("GUI8WriteTAGsCheck") GoSub WindowPosFromControlPos: Case "WizardHelp:890" SEControlStructIndex2 = GetSEControlStructIndex("GUI8CreateNewFileNamesCommand") GoSub WindowPosFromControlPos: Case "WizardHelp:910" SEControlStructIndex2 = GetSEControlStructIndex("GUI9ListViewPicture") GoSub WindowPosFromControlPos: Case "WizardHelp:940" SEControlStructIndex2 = GetSEControlStructIndex("GUI9ToolsCommand") GoSub WindowPosFromControlPos: Case "WizardHelp:950" Call SystemForms_Redraw 'remove ContextHelp-window-trash Call GUI9ToolsCommand_Click 'done when WizardHelp:950 is displayed Call SystemForms_Redraw Call ZoomSlide_Center("LWCfrm") Call SystemForms_Redraw Call LWCfrm.LWC_SelectTabHeader(1) 'show select files tab header Call SystemForms_Redraw WindowXPos = WindowPosProposed 'may be -1 or -2, 'translated' by code of GFContextHelpfrm WindowYPos = WindowPosProposed 'may be -1 or -2, 'translated' by code of GFContextHelpfrm Case "WizardHelp:960" Call SystemForms_Redraw 'remove ContextHelp-window-trash Call GUI9ToolsCommand_Click 'set focus Call SystemForms_Redraw Call LWCfrm.LWC_SelectTabHeader(1) 'show select files tab header Call SystemForms_Redraw SEControlStructIndex1 = GetSEControlStructIndex("LWCfrm") SEControlStructIndex2 = GetSEControlStructIndex("LWCfrm.LWCSearchTypeCombo") GoSub WindowPosFromControlPosEx: Case "WizardHelp:970" Call SystemForms_Redraw 'remove ContextHelp-window-trash Call GUI9ToolsCommand_Click 'set focus Call SystemForms_Redraw Call LWCfrm.LWC_SelectTabHeader(1) 'show select files tab header Call SystemForms_Redraw SEControlStructIndex1 = GetSEControlStructIndex("LWCfrm") SEControlStructIndex2 = GetSEControlStructIndex("LWCfrm.LWCSearchCombo") GoSub WindowPosFromControlPosEx: Case "WizardHelp:980" Call SystemForms_Redraw 'remove ContextHelp-window-trash Call GUI9ToolsCommand_Click 'set focus Call SystemForms_Redraw Call LWCfrm.LWC_SelectTabHeader(1) 'show select files tab header Call SystemForms_Redraw SEControlStructIndex1 = GetSEControlStructIndex("LWCfrm") SEControlStructIndex2 = GetSEControlStructIndex("LWCfrm.LWCSearchNextCommand") GoSub WindowPosFromControlPosEx: Case "WizardHelp:990" Call SystemForms_Redraw 'remove ContextHelp-window-trash Call GUI9ToolsCommand_Click 'set focus Call SystemForms_Redraw Call LWCfrm.LWC_SelectTabHeader(1) 'show select files tab header Call SystemForms_Redraw SEControlStructIndex1 = GetSEControlStructIndex("LWCfrm") SEControlStructIndex2 = GetSEControlStructIndex("LWCfrm.LWCSearchAllCommand") GoSub WindowPosFromControlPosEx: Case "WizardHelp:992" Call SystemForms_Redraw 'remove ContextHelp-window-trash Call GUI9ToolsCommand_Click 'set focus Call SystemForms_Redraw Call LWCfrm.LWC_SelectTabHeader(2) 'show edit files tab header Call SystemForms_Redraw WindowXPos = WindowPosProposed 'may be -1 or -2, 'translated' by code of GFContextHelpfrm WindowYPos = WindowPosProposed 'may be -1 or -2, 'translated' by code of GFContextHelpfrm Case "WizardHelp:994" Call SystemForms_Redraw 'remove ContextHelp-window-trash Call GUI9ToolsCommand_Click 'set focus Call SystemForms_Redraw Call LWCfrm.LWC_SelectTabHeader(1) 'show select files tab header Call SystemForms_Redraw WindowXPos = WindowPosProposed 'may be -1 or -2, 'translated' by code of GFContextHelpfrm WindowYPos = WindowPosProposed 'may be -1 or -2, 'translated' by code of GFContextHelpfrm Case "WizardHelp:1010" SEControlStructIndex2 = GetSEControlStructIndex("GUI10TreeViewPicture") GoSub WindowPosFromControlPos: Case "WizardHelp:1020" SEControlStructIndex2 = GetSEControlStructIndex("GUI10ListViewPicture") GoSub WindowPosFromControlPos: Case "WizardHelp:1110" SEControlStructIndex2 = GetSEControlStructIndex("GUI11ExistingFilesPicture") GoSub WindowPosFromControlPos: Case "WizardHelp:1210" SEControlStructIndex2 = GetSEControlStructIndex("GUI12AuthorText") GoSub WindowPosFromControlPos: Case "WizardHelp:1220" SEControlStructIndex2 = GetSEControlStructIndex("GUI12CommentText") GoSub WindowPosFromControlPos: Case "WizardHelp:1230" SEControlStructIndex2 = GetSEControlStructIndex("GUI12MP3ListFileText") GoSub WindowPosFromControlPos: Case Else WindowXPos = WindowPosProposed 'may be -1 or -2, 'translated' by code of GFContextHelpfrm WindowYPos = WindowPosProposed 'may be -1 or -2, 'translated' by code of GFContextHelpfrm Exit Sub End Select Leave: Exit Sub WindowPosFromControlPos: SEControlStructIndex1 = GetSEControlStructIndex("Mfrm_1") WindowPosFromControlPosEx: 'set SEControlStructIndex1 and jump here if Mfrm isn't parent window If SEControlStructIndex1 = 0 Then GoTo Leave: 'verify If SEControlStructIndex2 = 0 Then GoTo Leave: 'verify WindowXPos = GFCONTEXTHELP_ATSECONTROLPOS Call CopyMemory(ByVal VarPtr(WindowYPos) + 0, SEControlStructIndex1, 2) 'HIWORD Call CopyMemory(ByVal VarPtr(WindowYPos) + 2, SEControlStructIndex2, 2) 'LOWORD Return End Sub Public Sub ContextHelp_ReceiveEvent(ByVal EventName As String, ByVal Reserved As String) 'Public for compatibility with ContextHelp_GetContextHelpWindowPos() On Error Resume Next 'important (because of Shell()); receives a ContextHelp event; GFContextHelpfrm should already be closed (call this sub through the GFPMS) If Left$(EventName, 3) = "ANT" Then Call GUIC_ProcessANT(Val(Mid$(EventName, 4))) End If Select Case EventName Case "read file data" Call GUI4ReadCommand_Click 'will also work if only 'read new' command is visible Case "perform sample spelling error check" GUI5ItemTypeCombo.TEXT = GUI5ItemTypeCombo.List(1) 'artist name Call GUI5CheckCommand_Click Case "perform sample inclusion error check" GUI6ItemTypeCombo.TEXT = GUI6ItemTypeCombo.List(1) 'artist name Call GUI6CheckCommand_Click Case "perform sample swap check" Call GUI7CheckCommand_Click Case "close ContextHelp" 'important as GFContextHelpfrm always stays on top Call ContextHelp_Hide 'although already done when processing ContextHelp event Case "enable UserMove" 'after displaying UserMoveInfo help texts Call SEM_UserMove_Enable Case "start Starter" If Not (DirSave(ProgramFilesStructVar.StarterFile) = "") Then Call Shell("""" + ProgramFilesStructVar.StarterFile + """", vbNormalFocus) Else MsgBox "Starter is gone. I'm VERY sorry !", vbOKOnly + vbExclamation, "Program gone" End If End Select End Sub Public Sub GFContextHelp_ReceiveEvent(ByVal EventName As String, ByVal EventString As String) 'on error resume next Select Case EventName Case "ContextHelpString_Print" Call Agent_Speak(EventString) Case "Link_ShowLink" 'Call Agent_Speak(EventString) 'stops previous speaking :( Case "LinkLabel_MouseUp" 'Call Agent_Speak(EventString) 'Do While GFAgent_IsSpeaking = True 'not supported ' Call System_DoEventsEx 'Loop 'Call Sleep(1000) 'lame End Select End Sub '*********************************END OF CONTEXT HELP********************************** '************************************MOUSE POINTER************************************* 'NOTE: the mouse pointer is moved by ContextHelp code. Private Sub MousePointer_Move(ByVal SEControlStructIndex As Integer, ByVal PlayMouseAnimationFlag As Boolean) 'on error resume next 'moves the cursor to the right bottom corner of the passed control Dim AreaLeft As Long Dim AreaTop As Long Dim AreaRight As Long Dim AreaBottom As Long Dim POINTAPIVar As POINTAPI ' 'NOTE: the control related to SEControlStructIndex must have a hWnd property '(do not use this sub in combination with VB Labels and Lines). ' 'preset Call GFTaskBarInfo_GetVisibleScreenArea(AreaLeft, AreaTop, AreaRight, AreaBottom) 'begin If Not ((SEControlStructIndex < 1) Or (SEControlStructIndex > SEControlStructNumber)) Then 'verify POINTAPIVar.X = 0 'control-related coordinates POINTAPIVar.Y = 0 'control-related coordinates Call ClientToScreen(SEControlStructArray(SEControlStructIndex).SEControl.hwnd, POINTAPIVar) POINTAPIVar.X = POINTAPIVar.X + CLng(CSng(GetSEControlXSize(SEControlStructIndex)) * 0.5!) POINTAPIVar.Y = POINTAPIVar.Y + CLng(CSng(GetSEControlYSize(SEControlStructIndex)) * 0.5!) If Not ( _ (POINTAPIVar.X < (AreaLeft / Screen.TwipsPerPixelX)) Or (POINTAPIVar.X > (AreaRight / Screen.TwipsPerPixelX)) Or _ (POINTAPIVar.Y < (AreaTop / Screen.TwipsPerPixelY)) Or (POINTAPIVar.Y > (AreaBottom / Screen.TwipsPerPixelY))) Then 'verify ' 'NOTE: the cursor position is not set if outside the visible screen area '(then the cursor will stay unmoved). ' Call SetCursorPos(POINTAPIVar.X, POINTAPIVar.Y) If PlayMouseAnimationFlag = True Then _ Call GFMouseGuide_PlayAnimation(POINTAPIVar.X, POINTAPIVar.Y, 0, 1) End If Else MsgBox "internal error in MousePointer_Move(): passed value invalid !", vbOKOnly + vbExclamation End If End Sub '********************************END OF MOUSE POINTER********************************** '**************************************CONFIGSET*************************************** Public Function ConfigSet_Changing(ByVal ConfigSetIndexNew As Integer, ByVal ConfigSetNameNew As String) 'on error resume next ConfigSetStructVar.ConfigSetChangingFlag = True If GUIPalette_PrepareChange((GUICStructVar.GUIPaletteNumberCurrent + 0), (GUICStructVar.GUIPaletteNumberCurrent + 1)) = True Then Select Case GUICStructVar.GUIPaletteNumberCurrent Case 1 ' 'NOTE: when the user changes the current configuration then FileInfoStructArray() 'will be reset; display a warning message. 'The config set changing can be avoided through returning False. 'Note that this function here is not called if the current config set was changed 'by the system instead of the user '(this is the case when the user creates a new configuration or deletes an existing one). ' If Not (FileInfoStructNumber = 0) Then ConfigSet_Changing = (MsgBox("If you change the current configuration then all read file data is reset, ALL CHANGES POSSIBLY DONE TO THE TAG DATA GET LOST. Continue ?", vbYesNo + vbQuestion) = vbYes) Else ConfigSet_Changing = True End If Case Else ConfigSet_Changing = True End Select Else ConfigSet_Changing = False End If ConfigSetStructVar.ConfigSetChangingFlag = False End Function Public Function ConfigSet_Creating(ByVal CreateConfigSetName As String) As Boolean 'on error resume next ConfigSetStructVar.ConfigSetCreatingFlag = True Select Case GUICStructVar.GUIPaletteNumberCurrent Case 1 If Not (FileInfoStructNumber = 0) Then ConfigSet_Creating = (MsgBox("If you create a new configuration then all read file data is reset, ALL CHANGES POSSIBLY DONE TO THE TAG DATA GET LOST. Continue ?", vbYesNo + vbQuestion) = vbYes) Else ConfigSet_Creating = True End If Case Else ConfigSet_Creating = True End Select ConfigSetStructVar.ConfigSetCreatingFlag = False End Function Public Function ConfigSet_Deleting(ByVal DeleteConfigSetName As String) As Boolean 'on error resume next ConfigSetStructVar.ConfigSetDeletingFlag = True Select Case GUICStructVar.GUIPaletteNumberCurrent Case 1 If Not (FileInfoStructNumber = 0) Then ConfigSet_Deleting = (MsgBox("If you delete the current configuration then all read file data is reset, ALL CHANGES POSSIBLY DONE TO THE TAG DATA GET LOST. Continue ?", vbYesNo + vbQuestion) = vbYes) Else ConfigSet_Deleting = True End If Case Else ConfigSet_Deleting = True End Select ConfigSetStructVar.ConfigSetDeletingFlag = False End Function Public Function ConfigSet_Renaming(ByVal RenameConfigSetName As String) As Boolean 'on error resume next ConfigSetStructVar.ConfigSetRenamingFlag = True 'nothing to ask, no problem with already read file data ConfigSetStructVar.ConfigSetRenamingFlag = False ConfigSet_Renaming = True End Function Public Sub ConfigSet_Changed(ByVal ConfigSetIndexNew As Integer, ByVal ConfigSetNameNew As String, ByVal ForceReloadFlag As Boolean) 'on error resume next ' 'NOTE: ForceReloadFlag is False if not the user but the system changed 'a config set. In this case the system refreshes the controls on its own. ' 'begin If ForceReloadFlag = True Then ' Call SystemForms_Redraw 'remove window trash (sometimes important, tested) ' Select Case GUICStructVar.GUIPaletteNumberCurrent Case 1 FileInfoStructNumber = 0 'reset ReDim FileInfoStructArray(1 To 1) As FileInfoStruct 'reset Call Msg_Add("FileInfoStructArray() changed") End Select ' GUIXConfigSetNameLabel.Caption = "Changing configuration......" GUIXConfigSetNameLabel.Refresh GUICStructVar.SkinEnginePaletteChangeDisabledFlag = True 'update control content only, not their appearance GUICStructVar.ConfigSetChangingFlag = True Call GUIC_DoPaletteChange(GUICStructVar.GUIPaletteNumberCurrent) 'will reload current palette GUICStructVar.ConfigSetChangingFlag = False 'reset (important) GUICStructVar.SkinEnginePaletteChangeDisabledFlag = False 'reset (important) End If ' 'NOTE: DIRTY HACK: 'when we create new file names, GUI2FromReg is called, which calls ConfigSet_ReceiveRegKey(). 'So the config set name is changed even during creating new file names. 'The system works, but the user temporary sees an other config set name. 'The error only appears in step 8, when creating new file names and GUI2FromReg is called. ' If (InStr(1, CSETfrm.ConfigSet_GetRegKey, "File Name Filters", vbBinaryCompare)) Then 'DIRTY, if user uses config set name 'File Name Filters' then he'll get confused If GUICStructVar.GUIPaletteNumberCurrent = 8 Then GoTo Jump: End If GUIXConfigSetNameLabel.Caption = "Current config: " + ConfigSetNameNew GUIXConfigSetNameLabel.Refresh Jump: End Sub '**********************************END OF CONFIGSET*************************************** '*****************************************IDLE***************************************** 'NOTE: the system is idle ("faul") when no program window is the foreground window 'or if the mouse was not moved and no key was pressed. 'Furthermore the program- or Skin Engine system must not be busy. 'The Idle sub system is MP3 Renamer 2 specific, but parts of it may be copied to 'other projects, too. Private Sub Idle_Update(ByVal ForceUpdateFlag As Boolean) 'on error resume next Dim UpdateFlag As Boolean ' 'NOTE: IdleStructVar is only updated in special intervals, except 'ForceUpdateFlag is True, then IdleStructVar is updated immediately. ' 'preset IdleStructVar.TickCountCurrent = GetTickCount() If IdleStructVar.IdleAnimationPlayedFlag = True Then If (IdleStructVar.TickCountCurrent - IdleStructVar.TickCountOld) > 100 Then UpdateFlag = True 'check more frequently to allow aborting Idle animation immediately Else If (IdleStructVar.TickCountCurrent - IdleStructVar.TickCountOld) > 1000 Then UpdateFlag = True End If 'begin If (UpdateFlag = True) Or (ForceUpdateFlag = True) Then ' 'NOTE: update data every second only to save CPU time. IdleStructVar.ProgramMousePosXCurrent = ProgramGetMousePosX IdleStructVar.ProgramMousePosYCurrent = ProgramGetMousePosY IdleStructVar.IsSystemIdleFlag = Idle_IsSystemIdle ' 'NOTE: any code must set .KeyPressedFlag to True whenever a key is pressed 'within the current application (in MP3 Renamer 2 this is done when an 'SECBMSG_KEYHOOK_EVENT message arrives). ' If Not (IdleStructVar.IsSystemIdleFlag = IdleStructVar.IsSystemIdleFlagOld) Then Select Case IdleStructVar.IsSystemIdleFlag Case True Call Idle_GotFocus Case False Call Idle_LostFocus End Select End If ' If IdleStructVar.IsSystemIdleFlag = True Then Call Idle_Tick(IdleStructVar.TickCountCurrent - IdleStructVar.Idle_GotFocus_TickCount) End If ' IdleStructVar.IsSystemIdleFlagOld = IdleStructVar.IsSystemIdleFlag IdleStructVar.ProgramMousePosXOld = IdleStructVar.ProgramMousePosXCurrent IdleStructVar.ProgramMousePosYOld = IdleStructVar.ProgramMousePosYCurrent IdleStructVar.KeyPressedFlag = False 'reset (after calling Idle_IsSystemIdle) IdleStructVar.MousePressedFlag = False 'reset (after calling Idle_IsSystemIdle) IdleStructVar.TickCountOld = IdleStructVar.TickCountCurrent 'not to be set before Current-value ' End If End Sub Private Function Idle_IsSystemIdle() As Boolean 'on error resume next If IdleStructVar.IdleAnimationPlayedFlag = False Then Idle_IsSystemIdle = _ (Not (IdleStructVar.KeyPressedFlag)) And _ (Not (IdleStructVar.MousePressedFlag)) And _ (IdleStructVar.ProgramMousePosXCurrent = IdleStructVar.ProgramMousePosXOld) And _ (IdleStructVar.ProgramMousePosYCurrent = IdleStructVar.ProgramMousePosYOld) And _ (Not (System_IsSystemBusy())) And _ (Not (SE_IsSystemBusy())) Else Idle_IsSystemIdle = _ (Not (IdleStructVar.KeyPressedFlag)) And _ (Not (IdleStructVar.MousePressedFlag)) And _ (IdleStructVar.ProgramMousePosXCurrent = IdleStructVar.ProgramMousePosXOld) And _ (IdleStructVar.ProgramMousePosYCurrent = IdleStructVar.ProgramMousePosYOld) And _ (Not (SE_IsSystemBusy())) 'NOTE: when any Idle animation is played then the system is busy by default. End If End Function Private Sub Idle_GotFocus() 'on error resume next IdleStructVar.Idle_GotFocus_TickCount = IdleStructVar.TickCountCurrent End Sub Private Sub Idle_Tick(ByVal IdleTime As Long) 'on error resume next Select Case IdleTime Case 5& * 1000& To 10& * 1000& If Screen.ActiveForm Is Mfrm Then 'don't play any animation is an other window has the focus as this would be very annoying If FunControlStructVar.FunAnimationEnabledFlag = True Then If GFLabelAnimationfrm.GFLabelAnimation_IsAnimationPlaying = False Then If SystemMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False Then 'tests showed that otherwise SystemMessage text could stay ('hang') If SystemManualMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False Then 'compatibility to SystemMessage (maybe the same error, but not tested) Call GFLabelAnimationfrm.GFLabelAnimation_SwipSwap(StepLabel, 1, 2!, Int((5 - 2 + 1) * Rnd(1) + 2), True, Mfrm) End If End If End If End If End If End Select End Sub Private Sub Idle_LostFocus() 'on error resume next IdleStructVar.Idle_LostFocus_TickCount = IdleStructVar.TickCountCurrent End Sub Public Sub GFLabelAnimation_Tick(ByRef CancelAnimationFlag As Boolean, ByRef ResetLabelTextPosFlag As Boolean) 'on error resume next 'call back sub of the GFLabelAnimation code, set CancelAnimationFlag to True to abort any label animation If IdleStructVar.MousePressedFlag = True Then ' 'NOTE: when the mouse button is pressed we must cancel the 'animation as otherwise the current palette cannot be changed '(if e.g. the 'Next' or the 'Back' command is pressed). ' Call Idle_Update(True) 'important or animation will be re-started ' CancelAnimationFlag = True 'exit immediately, no time for processing messages ResetLabelTextPosFlag = True IdleStructVar.IdleAnimationPlayedFlag = False 'reset Else ' 'NOTE: this sub is called through the processing of a program message, 'as we do not allow 'recursive message processing' the system will not 'process the call Idle_Update() message any more, so we must call 'Idle_Update() manually. ' Call Idle_Update(True) 'important or animation will not stop when the mouse is moved ' If (GetMsgStructIndex("call Idle_Update()") = 0) Then Call Msg_Add("call Idle_Update()") 'avoid that 'chain-message' aborts (important) Call System_DoEventsEx 'important to update GFPMS which updates the Idle sub system 'no! (see above) ' CancelAnimationFlag = Not (IdleStructVar.IsSystemIdleFlag) ResetLabelTextPosFlag = True IdleStructVar.IdleAnimationPlayedFlag = False 'reset End If End Sub '*************************************END OF IDLE************************************** '************************************START STATION************************************* 'NOTE: the 'Start Station' is a set of 5 se commands that allow the user to quickly 'start any program. The user can set the started program just by dragging the program 'or one of its associated files on one of the commands. 'Note that the MP3 Renamer 2 Start Station system consists of the general function 'GFStartStation and additional code to extend the functionality of the general function. Private Sub StartStation_RefreshCommandSub(ByVal StartStationCommandIndex As Integer, ByVal SEControlStructIndex As Integer, Optional ByVal ForceRecreateFlag As Boolean = False) 'on error resume next 'THIS SUB IS TORICXS SPECIFIC Dim CommandPictureName As String Dim CommandCaption As String Dim CommandCaptionUnchanged As String Dim SkinDataFileString As String Dim ForeColorUnchanged As Long Dim DrawLoop As Integer ' 'NOTE: a StartStationCommand looks the following: '-frame border, 1 pixel width, color is se system fore color '-back color is the se system back color '-the icon of the application to start is drawn centered on the command (supposed size: 32x32 pixels) '-the ToolTipText is set to the application's main name (without directory, e.g. 'Napster'), ' and this text is also printed at the bottom of the command 'NOTE: steps to create the command picture. '-a temp file namedStartStationCommand([1/2/3/4/5])_[Up/MoveOver/Down].bmp is ' created in the current skin's directory '-SESystemStructVar.SystemTempPicture2 is set to the current command's size '-SESystemStructVar.SystemTempPicture2's back color is set to the control back color '-The application's icon is drawn using DrawIcon() '-The SkinDataFile properties are changes so that the current skin uses the created command picture. ' 'Note that the StartStationCommand pictures will not be visible for an other user 'when the skin is exported as the pictures will be overwritten instantly after 'program start up (see DefineStartStation). ' 'verify If (SEControlStructIndex < 1) Or (SEControlStructIndex > SEControlStructNumber) Then Exit Sub 'verify If (StartStationCommandIndex < GFStartStationCommand.LBound) Or (StartStationCommandIndex > GFStartStationCommand.UBound) Then Exit Sub 'verify 'preset Select Case GFStartStationStructArray(StartStationCommandIndex).StartApplicationType Case GFSTARTSTATION_FILE CommandCaptionUnchanged = GetFileMainName(GetFileName(GFStartStationStructArray(StartStationCommandIndex).StartApplicationName)) 'e.g. Duke3d.exe (yeah!) Case GFSTARTSTATION_DIRECTORY CommandCaptionUnchanged = GetFileName(Left$(GFStartStationStructArray(StartStationCommandIndex).StartApplicationName, Len(GFStartStationStructArray(StartStationCommandIndex).StartApplicationName) - 1)) 'e.g. Windows If Len(CommandCaptionUnchanged) = 0 Then CommandCaptionUnchanged = GFStartStationStructArray(StartStationCommandIndex).StartApplicationName 'e.g. 'C:\' End Select 'begin ' 'NOTE: call this sub to update the start station command picture file. 'No Skin Engine load, refresh or unload function is called through this sub. 'Call this sub before an STS command is refreshed. ' If Not (StartStationCommandIndex > StartStationRefreshStructNumber) Then If ( _ (StartStationRefreshStructArray(StartStationCommandIndex).CommandCaptionUnchangedOld = CommandCaptionUnchanged) And _ (StartStationRefreshStructArray(StartStationCommandIndex).CommandWidthOld = SEControlStructArray(SEControlStructIndex).SEControl_XSize * Screen.TwipsPerPixelX + (4 * Screen.TwipsPerPixelX)) And _ (StartStationRefreshStructArray(StartStationCommandIndex).CommandHeightOld = SEControlStructArray(SEControlStructIndex).SEControl_YSize * Screen.TwipsPerPixelY + (4 * Screen.TwipsPerPixelX)) And _ (StartStationRefreshStructArray(StartStationCommandIndex).SystemForeColorOld = SESystemStructVar.SystemForeColor) And _ (StartStationRefreshStructArray(StartStationCommandIndex).SystemBackColorOld = SESystemStructVar.SystemBackColor) And _ (StartStationRefreshStructArray(StartStationCommandIndex).SystemFont.Name = SESystemStructVar.SystemFont.Name) And _ (StartStationRefreshStructArray(StartStationCommandIndex).SystemFont.Size = SESystemStructVar.SystemFont.Size) And _ (StartStationRefreshStructArray(StartStationCommandIndex).SystemFont.Bold = SESystemStructVar.SystemFont.Bold) And _ (StartStationRefreshStructArray(StartStationCommandIndex).SystemFont.Italic = SESystemStructVar.SystemFont.Italic) And _ (StartStationRefreshStructArray(StartStationCommandIndex).SystemFont.Underline = SESystemStructVar.SystemFont.Underline) And _ (StartStationRefreshStructArray(StartStationCommandIndex).SystemFont.StrikeThrough = SESystemStructVar.SystemFont.StrikeThrough)) And _ (ForceRecreateFlag = False) Then Exit Sub 'nothing changed Else StartStationRefreshStructArray(StartStationCommandIndex).CommandCaptionUnchangedOld = CommandCaptionUnchanged StartStationRefreshStructArray(StartStationCommandIndex).CommandWidthOld = SEControlStructArray(SEControlStructIndex).SEControl_XSize * Screen.TwipsPerPixelX + (4 * Screen.TwipsPerPixelX) StartStationRefreshStructArray(StartStationCommandIndex).CommandHeightOld = SEControlStructArray(SEControlStructIndex).SEControl_YSize * Screen.TwipsPerPixelY + (4 * Screen.TwipsPerPixelX) StartStationRefreshStructArray(StartStationCommandIndex).SystemForeColorOld = SESystemStructVar.SystemForeColor StartStationRefreshStructArray(StartStationCommandIndex).SystemBackColorOld = SESystemStructVar.SystemBackColor StartStationRefreshStructArray(StartStationCommandIndex).SystemFont = SESystemStructVar.SystemFont End If Else StartStationRefreshStructNumber = StartStationCommandIndex 'cannot be 0 ReDim Preserve StartStationRefreshStructArray(1 To StartStationCommandIndex) As StartStationRefreshStruct End If ' With SESystemStructVar Call SkinDataFile_ReadString(SE_GetSkinDataFile, SkinDataFileString) ' 'UP PICTURE ' 'preset for picture creation .SystemTempPicture2.ScaleMode = vbTwips 'verify .SystemTempPicture2.BackColor = .SystemBackColor .SystemTempPicture2.ForeColor = GFColor_ChangeBrightness(.SystemForeColor, -24) .SystemTempPicture2.Font.Name = "Small Fonts" 'SESystemStructVar.SystemFont.Name .SystemTempPicture2.Font.Size = 6 'SESystemStructVar.SystemFont.Size .SystemTempPicture2.Font.Bold = SESystemStructVar.SystemFont.Bold .SystemTempPicture2.Font.Italic = SESystemStructVar.SystemFont.Italic .SystemTempPicture2.Font.Underline = SESystemStructVar.SystemFont.Underline .SystemTempPicture2.Font.StrikeThrough = SESystemStructVar.SystemFont.StrikeThrough .SystemTempPicture2.Width = SEControlStructArray(SEControlStructIndex).SEControl_XSize * Screen.TwipsPerPixelX + (4 * Screen.TwipsPerPixelX) '4 pixels for borders (se command has no borders, picture box has) .SystemTempPicture2.Height = SEControlStructArray(SEControlStructIndex).SEControl_YSize * Screen.TwipsPerPixelY + (4 * Screen.TwipsPerPixelY) '4 pixels for borders (se command has no borders, picture box has) 'create up picture CommandPictureName = .SystemSkinDirectory + "GFStartStationCommand(" + LTrim$(Str$(StartStationCommandIndex)) + ")_Up.bmp" Call SE_DeletePictureBox(.SystemTempPicture2) 'draw background GoSub DrawCommandBackGround: 'print icon If (GFStartStationStructArray(StartStationCommandIndex).IconHandle) Then 'verify Call DrawIcon(.SystemTempPicture2.hDC, _ Int((.SystemTempPicture2.ScaleWidth / 2 / Screen.TwipsPerPixelX) - (32 / 2)), _ 2, GFStartStationStructArray(StartStationCommandIndex).IconHandle) Else Call GFMaskPrint(.SystemTempPicture2, _ Int((.SystemTempPicture2.ScaleWidth / 2 / Screen.TwipsPerPixelX) - STSPicture.Width / Screen.TwipsPerPixelX / 2!) + 2, _ Int((.SystemTempPicture2.ScaleHeight / 2 / Screen.TwipsPerPixelY) - STSPicture.Height / Screen.TwipsPerPixelY / 2!) + 2, _ STSPicture, STSMaskPicture) '2 pixels for whatever (otherwise not centered) End If CommandCaption = FixMaxLineLengthAtEnd(CommandCaptionUnchanged, 10) 'almost optimized for good old 8.3 format 'print font shadow ForeColorUnchanged = .SystemTempPicture2.ForeColor .SystemTempPicture2.ForeColor = GFColor_MixColor(GFColor_ToBlackWhiteShadowColor(ForeColorUnchanged), .SystemTempPicture2.BackColor, 0.33!) .SystemTempPicture2.CurrentX = Screen.TwipsPerPixelX + Int((.SystemTempPicture2.ScaleWidth / 2!) - (.SystemTempPicture2.TextWidth(CommandCaption) / 2!)) .SystemTempPicture2.CurrentY = 0! + .SystemTempPicture2.ScaleHeight - .SystemTempPicture2.TextHeight(Chr$(32)) - 2! * Screen.TwipsPerPixelY .SystemTempPicture2.Print CommandCaption .SystemTempPicture2.ForeColor = ForeColorUnchanged 'reset 'print font .SystemTempPicture2.CurrentX = Int((.SystemTempPicture2.ScaleWidth / 2!) - (.SystemTempPicture2.TextWidth(CommandCaption) / 2!)) .SystemTempPicture2.CurrentY = .SystemTempPicture2.ScaleHeight - .SystemTempPicture2.TextHeight(Chr$(32)) - 2! * Screen.TwipsPerPixelY .SystemTempPicture2.Print CommandCaption 'transfer picture .SystemTempPicture2.Picture = .SystemTempPicture2.Image Call SE_PictureBoxToFile(.SystemTempPicture2, CommandPictureName) SEControlStructArray(SEControlStructIndex).SEControl_UpPicture = CommandPictureName Call SkinDataFile_ChangePropertySub(SkinDataFileString, SEControlStructArray(SEControlStructIndex).SEControlName, _ "uppicture", CommandPictureName, False, False) ' 'MOVE OVER PICTURE ' 'create move over picture 'NOTE: the move over picture has a higher brightness than the normal picture. CommandPictureName = .SystemSkinDirectory + "GFStartStationCommand(" + LTrim$(Str$(StartStationCommandIndex)) + ")_MoveOver.bmp" Call GFAlphaBlendfrm.GFAlphaBlend_AdjustBrightness(.SystemTempPicture2.hDC, .SystemTempPicture2.ScaleWidth / TX(1), .SystemTempPicture2.ScaleHeight / TY(1), 1.15!) Call SE_PictureBoxToFile(.SystemTempPicture2, CommandPictureName) SEControlStructArray(SEControlStructIndex).SEControl_MoveOverPicture = CommandPictureName Call SkinDataFile_ChangePropertySub(SkinDataFileString, SEControlStructArray(SEControlStructIndex).SEControlName, _ "moveoverpicture", CommandPictureName, False, False) ' 'DOWN PICTURE ' 'preset for picture creation .SystemTempPicture2.BackColor = .SystemBackColor .SystemTempPicture2.ForeColor = GFColor_ChangeBrightness(.SystemForeColor, -48) .SystemTempPicture2.Width = SEControlStructArray(SEControlStructIndex).SEControl_XSize * Screen.TwipsPerPixelX + (4 * Screen.TwipsPerPixelX) '4 pixels for borders (se command has no borders, picture box has) .SystemTempPicture2.Height = SEControlStructArray(SEControlStructIndex).SEControl_YSize * Screen.TwipsPerPixelY + (4 * Screen.TwipsPerPixelY) '4 pixels for borders (se command has no borders, picture box has) 'create down picture 'NOTE: in the down picture the icon and the font is shifted. CommandPictureName = .SystemSkinDirectory + "GFStartStationCommand(" + LTrim$(Str$(StartStationCommandIndex)) + ")_Down.bmp" Call SE_DeletePictureBox(.SystemTempPicture2) 'draw background GoSub DrawCommandBackGround: 'print icon If (GFStartStationStructArray(StartStationCommandIndex).IconHandle) Then 'verify Call DrawIcon(.SystemTempPicture2.hDC, _ Int((.SystemTempPicture2.ScaleWidth / 2 / Screen.TwipsPerPixelX) - (32 / 2)) + 1, _ 3, GFStartStationStructArray(StartStationCommandIndex).IconHandle) Else Call GFMaskPrint(.SystemTempPicture2, _ Int((.SystemTempPicture2.ScaleWidth / 2 / Screen.TwipsPerPixelX) - STSPicture.Width / Screen.TwipsPerPixelX / 2!) + 2 + 1, _ Int((.SystemTempPicture2.ScaleHeight / 2 / Screen.TwipsPerPixelY) - STSPicture.Height / Screen.TwipsPerPixelY / 2!) + 2 + 1, _ STSPicture, STSMaskPicture) '2 pixels for whatever (otherwise not centered) End If 'print font shadow CommandCaption = FixMaxLineLengthAtEnd(CommandCaptionUnchanged, 10) 'almost optimized for good old 8.3 format 'print font shadow ForeColorUnchanged = .SystemTempPicture2.ForeColor .SystemTempPicture2.ForeColor = GFColor_MixColor(GFColor_ToBlackWhiteShadowColor(ForeColorUnchanged), .SystemTempPicture2.BackColor, 0.33!) .SystemTempPicture2.CurrentX = Screen.TwipsPerPixelX + Int((.SystemTempPicture2.ScaleWidth / 2!) - (.SystemTempPicture2.TextWidth(CommandCaption) / 2!)) + Screen.TwipsPerPixelX .SystemTempPicture2.CurrentY = 0! + .SystemTempPicture2.ScaleHeight - .SystemTempPicture2.TextHeight(Chr$(32)) - 1! * Screen.TwipsPerPixelY .SystemTempPicture2.Print CommandCaption .SystemTempPicture2.ForeColor = ForeColorUnchanged 'reset 'print font .SystemTempPicture2.CurrentX = Int((.SystemTempPicture2.ScaleWidth / 2!) - (.SystemTempPicture2.TextWidth(CommandCaption) / 2!)) + Screen.TwipsPerPixelX .SystemTempPicture2.CurrentY = .SystemTempPicture2.ScaleHeight - .SystemTempPicture2.TextHeight(Chr$(32)) - 1! * Screen.TwipsPerPixelY .SystemTempPicture2.Print CommandCaption 'transfer picture .SystemTempPicture2.Picture = .SystemTempPicture2.Image Call SE_PictureBoxToFile(.SystemTempPicture2, CommandPictureName) Call SE_DeletePictureBox(.SystemTempPicture2) SEControlStructArray(SEControlStructIndex).SEControl_DownPicture = CommandPictureName Call SkinDataFile_ChangePropertySub(SkinDataFileString, SEControlStructArray(SEControlStructIndex).SEControlName, _ "downpicture", CommandPictureName, False, False) 'disabled picture SEControlStructArray(SEControlStructIndex).SEControl_DisabledPicture = "" 'reset (system should recreate picture) 'set ToolTipText SEControlStructArray(SEControlStructIndex).SEControl_ToolTipText = CommandCaptionUnchanged 'unchanged caption was not shortened Call SkinDataFile_ChangePropertySub(SkinDataFileString, SEControlStructArray(SEControlStructIndex).SEControlName, _ "tooltiptext", SEControlStructArray(SEControlStructIndex).SEControl_ToolTipText, False, False) 'end of picture creation Call SkinDataFile_WriteString(SE_GetSkinDataFile, SkinDataFileString) End With Exit Sub DrawCommandBackGround: With SESystemStructVar ' 'create frame (linear gradient frame edges) ' If GFColormod.GFColor_IsBrightnessChangable(.SystemTempPicture2.ForeColor, -96) = True Then 'verify ' For DrawLoop = 1 To .SystemTempPicture2.ScaleWidth ' .SystemTempPicture2.PSet (DrawLoop, 0), _ ' GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, -(CSng(DrawLoop) / .SystemTempPicture2.ScaleWidth * 48!) - 0) ' Next DrawLoop ' For DrawLoop = 1 To .SystemTempPicture2.ScaleHeight ' .SystemTempPicture2.PSet (.SystemTempPicture2.ScaleWidth - TX(1), DrawLoop), _ ' GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, -(CSng(DrawLoop) / .SystemTempPicture2.ScaleHeight * 48!) - 48) ' Next DrawLoop ' For DrawLoop = .SystemTempPicture2.ScaleWidth To 1 Step -TX(1) ' .SystemTempPicture2.PSet (DrawLoop, .SystemTempPicture2.ScaleHeight - TY(1)), _ ' GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, -(CSng(DrawLoop) / .SystemTempPicture2.ScaleWidth * 48!) - 48) ' Next DrawLoop ' For DrawLoop = .SystemTempPicture2.ScaleHeight To 1 Step -TY(1) ' .SystemTempPicture2.PSet (0, DrawLoop), _ ' GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, -(CSng(DrawLoop) / .SystemTempPicture2.ScaleHeight * 48!) - 0) ' Next DrawLoop ' Else ' For DrawLoop = 1 To .SystemTempPicture2.ScaleWidth ' .SystemTempPicture2.PSet (DrawLoop, 0), _ ' GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, (CSng(DrawLoop) / .SystemTempPicture2.ScaleWidth * 48!) - 0) ' Next DrawLoop ' For DrawLoop = 1 To .SystemTempPicture2.ScaleHeight ' .SystemTempPicture2.PSet (.SystemTempPicture2.ScaleWidth - TX(1), DrawLoop), _ ' GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, (CSng(DrawLoop) / .SystemTempPicture2.ScaleHeight * 48!) + 48) ' Next DrawLoop ' For DrawLoop = .SystemTempPicture2.ScaleWidth To 1 Step -TX(1) ' .SystemTempPicture2.PSet (DrawLoop, .SystemTempPicture2.ScaleHeight - TX(1)), _ ' GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, (CSng(DrawLoop) / .SystemTempPicture2.ScaleWidth * 48!) + 48) ' Next DrawLoop ' For DrawLoop = .SystemTempPicture2.ScaleHeight To 1 Step -TY(1) ' .SystemTempPicture2.PSet (0, DrawLoop), _ ' GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, (CSng(DrawLoop) / .SystemTempPicture2.ScaleHeight * 48!) + 0) ' Next DrawLoop ' End If 'create frame (solid color frame edges) .SystemTempPicture2.Line (0, 0)-(.SystemTempPicture2.ScaleWidth - Screen.TwipsPerPixelX, .SystemTempPicture2.ScaleHeight - Screen.TwipsPerPixelY), .SystemTempPicture2.ForeColor, B .SystemTempPicture2.Line (0, .SystemTempPicture2.ScaleHeight - Screen.TwipsPerPixelY)-(.SystemTempPicture2.ScaleWidth - Screen.TwipsPerPixelX, .SystemTempPicture2.ScaleHeight - Screen.TwipsPerPixelY), GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, 24) .SystemTempPicture2.Line (.SystemTempPicture2.ScaleWidth - Screen.TwipsPerPixelX, 0)-(.SystemTempPicture2.ScaleWidth - Screen.TwipsPerPixelX, .SystemTempPicture2.ScaleHeight - Screen.TwipsPerPixelY), GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, 24) 'create frame dark edges .SystemTempPicture2.Line (0, .SystemTempPicture2.ScaleHeight - Screen.TwipsPerPixelY)-(.SystemTempPicture2.ScaleWidth - Screen.TwipsPerPixelX, .SystemTempPicture2.ScaleHeight - Screen.TwipsPerPixelY), _ GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, -32) .SystemTempPicture2.Line (.SystemTempPicture2.ScaleWidth - Screen.TwipsPerPixelX, 0)-(.SystemTempPicture2.ScaleWidth - Screen.TwipsPerPixelX, .SystemTempPicture2.ScaleHeight - Screen.TwipsPerPixelY), _ GFColor_ChangeBrightness(.SystemTempPicture2.ForeColor, -32) 'create liniar gradient If GFColormod.GFColor_IsBrightnessChangable(.SystemTempPicture2.BackColor, -64) = True Then 'verify 'darken back color from top to bottom For DrawLoop = 1 To 20 .SystemTempPicture2.Line (TX(1), (.SystemTempPicture2.ScaleHeight - TY(3)) * CSng(DrawLoop - 1) / 20! + TY(1))-(.SystemTempPicture2.ScaleWidth - TX(2), (.SystemTempPicture2.ScaleHeight - TY(3)) * CSng(DrawLoop) / 20! + TY(1)), _ GFColor_ChangeBrightness(.SystemTempPicture2.BackColor, -((CSng(20 - DrawLoop) / 19!) * 64!)), BF Next DrawLoop Else 'lighten back color from top to bottom For DrawLoop = 1 To 20 .SystemTempPicture2.Line (TX(1), (.SystemTempPicture2.ScaleHeight - TY(3)) * CSng(DrawLoop - 1) / 20! + TY(1))-(.SystemTempPicture2.ScaleWidth - TX(2), (.SystemTempPicture2.ScaleHeight - TY(3)) * CSng(DrawLoop) / 20! + TY(1)), _ GFColor_ChangeBrightness(.SystemTempPicture2.BackColor, ((CSng(20 - DrawLoop) / 19!) * 64!)), BF Next DrawLoop End If End With Return End Sub Private Sub GFStartStationCommand_LButtonUp(ByVal StartStationCommandIndex As Integer) 'on error resume next 'verify If (StartStationCommandIndex < 1) Or (StartStationCommandIndex > GFStartStationStructNumber) Then Exit Sub 'verify 'begin If GFStartStationStructArray(StartStationCommandIndex).StartApplicationType = 0 Then Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 Call StartStationMenu_Browse("GFStartStationCommandMovable(" + LTrim$(Str$(StartStationCommandIndex)) + ")") Case Else Call StartStationMenu_Browse("GFStartStationCommandFixed(" + LTrim$(Str$(StartStationCommandIndex)) + ")") End Select End If End Sub Private Sub GFStartStationCommand_RButtonUp(ByVal StartStationCommandIndex As Integer) 'on error resume next 'this sub is called as a result of a SECBMSG_SECOMMAND_RBUTTONUP message ProgramPopUpMenuStructVar.SourceDescription = LTrim$(Str$(StartStationCommandIndex)) 'used by ProgramUpdatePopUpMenu Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 Call ProgramUpdatePopUpMenu(30) 'Menu30 Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 25, "GFStartStationCommandMovable(" + LTrim$(Str$(StartStationCommandIndex)) + ")", Nothing) 'Menu30 Case Else Call ProgramUpdatePopUpMenu(30) 'Menu30 Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 25, "GFStartStationCommandFixed(" + LTrim$(Str$(StartStationCommandIndex)) + ")", Nothing) 'Menu30 End Select End Sub Private Sub StartStationMenu_Start(ByVal StartStationCommandName As String) 'on error resume next Dim CommandIndex As Integer 'preset Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 CommandIndex = Val(Mid$(StartStationCommandName, 30, 1)) Case Else CommandIndex = Val(Mid$(StartStationCommandName, 28, 1)) End Select If (CommandIndex < GFStartStationCommand.LBound) Or (CommandIndex > GFStartStationCommand.UBound) Then Exit Sub 'verify 'begin Call GFStartStationCommand_Click(CommandIndex) End Sub Private Sub StartStationMenu_Browse(ByVal StartStationCommandName As String) 'on error resume next Dim CommandIndex As Integer Dim BrowseName As String 'chosen file Dim CustomButtonCaptionArray(1 To 3) As String 'preset Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 CommandIndex = Val(Mid$(StartStationCommandName, 30, 1)) Case Else CommandIndex = Val(Mid$(StartStationCommandName, 28, 1)) End Select If (CommandIndex < GFStartStationCommand.LBound) Or (CommandIndex > GFStartStationCommand.UBound) Then Exit Sub 'verify CustomButtonCaptionArray(1) = "Start an application" CustomButtonCaptionArray(2) = "Browse a directory" CustomButtonCaptionArray(3) = "None of these (Cancel)" 'begin Select Case Pmod.GFMsgBox("I want to use this Start Station command to...", vbQuestion, "Start Station configuration", 3, CustomButtonCaptionArray()) Case 1 ReDo1: BrowseName = GFCDGetFileName("Select file for Start Station command...", 0, NULLARRAYSTRING(), NULLARRAYSTRING(), 0, GetRootDir(App.Path)) If BrowseName = "" Then Exit Sub 'user canceled If GFFileAccess_IsFileExisting(BrowseName) = False Then MsgBox "This file does not exist, please try again !", vbOKOnly + vbExclamation GoTo ReDo1: End If Call GFStartStation_ReceiveFile(BrowseName, CommandIndex) Case 2 ReDo2: BrowseName = GFSelectDirectory(GetRootDir(App.Path), "Please select a directory to browse:") If BrowseName = "" Then Exit Sub 'user canceled If IsDirExisting(BrowseName) = False Then MsgBox "This directory is invalid, please try again !", vbOKOnly + vbExclamation GoTo ReDo2: End If Call GFStartStation_ReceiveFile(BrowseName, CommandIndex) Case 3 'do nothing (user canceled) End Select Exit Sub End Sub Private Sub StartStationMenu_Reset(ByVal StartStationCommandName As String) 'on error resume next Dim CommandIndex As Integer 'preset Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 CommandIndex = Val(Mid$(StartStationCommandName, 30, 1)) Case Else CommandIndex = Val(Mid$(StartStationCommandName, 28, 1)) End Select If (CommandIndex < GFStartStationCommand.LBound) Or (CommandIndex > GFStartStationCommand.UBound) Then Exit Sub 'verify 'begin Call GFStartStation_ResetCommand(CommandIndex) End Sub '********************************END OF START STATION********************************** '************************************GFSTARTSTATION************************************ Private Sub GFStartStation_Initialize(ByVal RegMainKey As Long, ByVal RegRootKey As String, _ ByVal FolderIconFile As String, ByVal FolderIconIndex As Integer, ByVal ExecutableIconFile As String, ByVal ExecutableIconIndex As Integer) 'on error resume next Dim CommandLoop As Integer ' 'NOTE: the following default values should be passed: 'FolderIconFile: shell32.dll 'FolderIconIndex: 20 'ExecutableIconFile: shell32.dll 'ExecutableIconIndex: 2 'Do not use these default values if better ones are existing 'within the target project environment. ' 'preset If Not (Right$(RegRootKey, 1) = "\") Then RegRootKey = RegRootKey + "\" GFStartStationControlStructVar.RegMainKey = RegMainKey GFStartStationControlStructVar.RegRootKey = RegRootKey 'e.g. Software\MyApp\ (sub key will be added automatically) GFStartStationControlStructVar.FolderIconFile = FolderIconFile GFStartStationControlStructVar.FolderIconIndex = FolderIconIndex GFStartStationControlStructVar.ExecutableIconFile = ExecutableIconFile GFStartStationControlStructVar.ExecutableIconIndex = ExecutableIconIndex 'begin GFStartStationStructNumber = GFStartStationCommand.UBound If Not (GFStartStationStructNumber = 0) Then ReDim GFStartStationStructArray(1 To GFStartStationStructNumber) As GFStartStationStruct Else ReDim GFStartStationStructArray(1 To 1) As GFStartStationStruct End If For CommandLoop = 1 To GFStartStationStructNumber Call DragAcceptFiles(GFStartStationCommand(CommandLoop).hwnd, 1) Call GFSubClass(GFStartStationCommand(CommandLoop), "GFStartStationCommandFixed(" + LTrim$(Str$(CommandLoop)) + ")", Me, True) Call GFSubClass(GFStartStationCommand(CommandLoop), "GFStartStationCommandMovable(" + LTrim$(Str$(CommandLoop)) + ")", Me, True) Next CommandLoop End Sub Private Sub GFStartStationToReg() 'on error resume next Dim StructLoop As Integer 'reset Call Rmod.RegDeleteSubKey(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\") Call Rmod.RegCreateSubKey(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\") 'begin Call Rmod.RegSetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "browse application", CVar(GFStartStationControlStructVar.BrowseApplicationName), REG_SZ) For StructLoop = 1 To GFStartStationStructNumber 'NOTE: all structure elemts are written, also if they contain no valid data. Call Rmod.RegSetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "file type" + LTrim$(Str$(StructLoop)), CVar(GFStartStationStructArray(StructLoop).StartApplicationType), REG_SZ) Call Rmod.RegSetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "file type description" + LTrim$(Str$(StructLoop)), CVar(GFStartStationStructArray(StructLoop).StartApplicationTypeDescription), REG_SZ) Call Rmod.RegSetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "application command" + LTrim$(Str$(StructLoop)), CVar(GFStartStationStructArray(StructLoop).StartApplicationCommand), REG_SZ) Call Rmod.RegSetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "application name" + LTrim$(Str$(StructLoop)), CVar(GFStartStationStructArray(StructLoop).StartApplicationName), REG_SZ) Call Rmod.RegSetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "icon file" + LTrim$(Str$(StructLoop)), CVar(GFStartStationStructArray(StructLoop).StartAplicationIconFile), REG_SZ) Call Rmod.RegSetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "icon index" + LTrim$(Str$(StructLoop)), CVar(GFStartStationStructArray(StructLoop).StartAplicationIconIndex), REG_SZ) Next StructLoop End Sub Private Sub GFStartStationFromReg() 'on error resume next Dim StructLoop As Integer Dim Temp As Long 'begin GFStartStationControlStructVar.BrowseApplicationName = Rmod.RegGetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "browse application") If GFStartStationControlStructVar.BrowseApplicationName = "" Then GFStartStationControlStructVar.BrowseApplicationName = "explorer.exe" 'preset For StructLoop = 1 To GFStartStationStructNumber GFStartStationStructArray(StructLoop).StartApplicationType = Val(Left$(Rmod.RegGetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "file type" + LTrim$(Str$(StructLoop))), 4)) 'use Left$() to avoid Interger overflow GFStartStationStructArray(StructLoop).StartApplicationTypeDescription = Rmod.RegGetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "file type description" + LTrim$(Str$(StructLoop))) GFStartStationStructArray(StructLoop).StartApplicationName = Rmod.RegGetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "application name" + LTrim$(Str$(StructLoop))) GFStartStationStructArray(StructLoop).StartApplicationCommand = Rmod.RegGetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "application command" + LTrim$(Str$(StructLoop))) GFStartStationStructArray(StructLoop).StartAplicationIconFile = Rmod.RegGetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "icon file" + LTrim$(Str$(StructLoop))) Temp = Val(Left$(Rmod.RegGetKeyValue(GFStartStationControlStructVar.RegMainKey, GFStartStationControlStructVar.RegRootKey + "GFStartStation\", "icon index" + LTrim$(Str$(StructLoop))), 8)) 'use Left$() to avoid Long overflow If Temp < -32767& Then Temp = -32767& If Temp > 32767& Then Temp = 32767& GFStartStationStructArray(StructLoop).StartAplicationIconIndex = CInt(Temp) Next StructLoop 'realod icons For StructLoop = 1 To GFStartStationStructNumber Select Case GFStartStationStructArray(StructLoop).StartApplicationType Case GFSTARTSTATION_DIRECTORY Call DeleteObject(GFStartStationStructArray(StructLoop).IconHandle) 'reset GFStartStationStructArray(StructLoop).IconHandle = ExtractIcon(App.hInstance, GFStartStationControlStructVar.FolderIconFile, GFStartStationControlStructVar.FolderIconIndex) 'stays in memory until being overwritten or until program termination Case GFSTARTSTATION_FILE Select Case UCase$(Right$(GFStartStationStructArray(StructLoop).StartApplicationName, 4)) Case ".EXE", ".COM" Call DeleteObject(GFStartStationStructArray(StructLoop).IconHandle) 'reset 'first try to extract first icon from current application GFStartStationStructArray(StructLoop).IconHandle = ExtractIcon(App.hInstance, GFStartStationStructArray(StructLoop).StartApplicationName, 0) 'try to extract the file's default icon 'if failed, extract default executable icon If GFStartStationStructArray(StructLoop).IconHandle = 0 Then GFStartStationStructArray(StructLoop).IconHandle = ExtractIcon(App.hInstance, GFStartStationControlStructVar.ExecutableIconFile, GFStartStationControlStructVar.ExecutableIconIndex) 'stays in memory until being overwritten or until program termination End If Case Else Call DeleteObject(GFStartStationStructArray(StructLoop).IconHandle) 'reset GFStartStationStructArray(StructLoop).IconHandle = ExtractIcon(App.hInstance, GFStartStationControlStructVar.ExecutableIconFile, GFStartStationControlStructVar.ExecutableIconIndex) 'stays in memory until being overwritten or until program termination End Select End Select Next StructLoop Exit Sub End Sub Private Sub GFStartStation_RefreshAll() 'on error resume next 'call to refresh all commands, e.g. after reading data from registry Dim StructLoop As Integer 'begin For StructLoop = 1 To GFStartStationStructNumber Call GFStartStation_Refresh(StructLoop) Next StructLoop End Sub Private Sub GFStartStation_ResetCommand(ByVal GFStartStationCommandIndex As Integer) 'on error resume next 'to be called by target project, e.g. as reaction on a pop up menu click 'verify If (GFStartStationCommandIndex < 1) Or (GFStartStationCommandIndex > GFStartStationStructNumber) Then Exit Sub 'verify 'begin GFStartStationStructArray(GFStartStationCommandIndex).StartApplicationType = 0 'reset GFStartStationStructArray(GFStartStationCommandIndex).StartApplicationTypeDescription = "" 'reset GFStartStationStructArray(GFStartStationCommandIndex).StartApplicationCommand = "" 'reset GFStartStationStructArray(GFStartStationCommandIndex).StartApplicationName = "" 'reset GFStartStationStructArray(GFStartStationCommandIndex).StartAplicationIconFile = "" 'reset GFStartStationStructArray(GFStartStationCommandIndex).StartAplicationIconIndex = 0 'reset Call DeleteObject(GFStartStationStructArray(GFStartStationCommandIndex).IconHandle) GFStartStationStructArray(GFStartStationCommandIndex).IconHandle = 0 'reset Call GFStartStationToReg 'save changes Call GFStartStation_Refresh(GFStartStationCommandIndex) 'display changes End Sub Private Sub GFStartStation_Terminate() 'on error resume next 'call when unloading target project Dim CommandLoop As Integer For CommandLoop = 1 To GFStartStationStructNumber Call DragAcceptFiles(GFStartStationCommand(CommandLoop).hwnd, 0) Call GFSubClass_UnSubclass("GFStartStationCommandFixed(" + LTrim$(Str$(CommandLoop)) + ")", Me) Call GFSubClass_UnSubclass("GFStartStationCommandMovable(" + LTrim$(Str$(CommandLoop)) + ")", Me) Call DeleteObject(GFStartStationStructArray(CommandLoop).IconHandle) Next CommandLoop End Sub Private Sub GFStartStationCommand_Click(Index As Integer) On Error Resume Next 'important (if any error occurs during starting application) Dim ApplicationName As String Dim ApplicationDirectory As String Dim DirectoryName As String Dim Tempdbl# 'begin If Not ((Index < 1) Or (Index > GFStartStationStructNumber)) Then 'verify Select Case GFStartStationStructArray(Index).StartApplicationType Case GFSTARTSTATION_FILE ApplicationName = GFStartStationStructArray(Index).StartApplicationName If Not (ApplicationName = "") Then 'verify (do not use DirSave() as ApplicationName could contain parameters) '***MP3 RENAMER SPECIFIC*** 'NOTE: under WinXP, a program's path could be e.g. '%SystemRoot%\Notepad.exe'. Dim Temp As Long Temp = InStr(1, ApplicationName, "%systemroot%", vbTextCompare) If Not (Temp = 0) Then ApplicationName = Left$(ApplicationName, Temp - 1) + GFShellRegistration_GetWinDir + Right$(ApplicationName, Len(ApplicationName) - Temp - Len("%systemroot%") + 1) End If '***END OF MP3 RENAMER SPECIFIC*** ApplicationDirectory = GetDirectoryName(ApplicationName) If IsDirExisting(ApplicationDirectory) = True Then ChDir ApplicationDirectory 'check also for "" Tempdbl# = Shell(ApplicationName, vbNormalFocus) ChDir App.Path 'reset If Tempdbl# = 0 Then MsgBox LANG_Translate(37, "Error starting application '") + ApplicationName + LANG_Translate(38, "' !"), vbOKOnly + vbExclamation End If Case GFSTARTSTATION_DIRECTORY DirectoryName = GFStartStationStructArray(Index).StartApplicationName If IsDirExisting(DirectoryName) = True Then ReDo: ApplicationDirectory = GetDirectoryName(GFStartStationControlStructVar.BrowseApplicationName) If IsDirExisting(ApplicationDirectory) = True Then ChDir ApplicationDirectory 'check also for "" Tempdbl# = Shell(GFStartStationControlStructVar.BrowseApplicationName + " " + DirectoryName, vbNormalFocus) ChDir App.Path 'reset If Tempdbl# = 0 Then GFStartStationControlStructVar.BrowseApplicationName = Pmod.GFInputBox("Please enter path to browse application (" + GFStartStationControlStructVar.BrowseApplicationName + " not found):", "Error during browsing", "") If Not (GFStartStationControlStructVar.BrowseApplicationName = "") Then 'verify user didn't cancel Call GFStartStationToReg 'save changes GoTo ReDo: End If End If End If End Select End If End Sub Private Sub GFStartStation_Refresh(ByVal GFStartStationCommandIndex As Integer) 'on error resume next 'call back sub Dim DisabledPictureCacheDir As String ' 'NOTE: the content of this must be made fit to the requirements/coding possibilities 'of the target project. When this sub is called, the user dropped a valid file over 'an GFStartStationCommand, and the GFStartStationStructArray() data has been changed. 'The target project should change the appearance of the related command button. ' '***MP3 RENAMER 2 SPECIFIC*** 'preset Call DisabledPictureCache_GetCacheDir(DisabledPictureCacheDir) 'begin 'NOTE: the SECBMSG_SECONTROL_LOAD message will be processed and new command pictures are created. Select Case GUICStructVar.GUIPaletteNumberCurrent Case 9, 10 'don't force loading a control that is not in the current palette or the Skin Engine will display multiple (disabled) pictures (thinks LoadedControl_IsLoaded() = True) ' 'NOTE: as we load the control twice we also create its pictures twice (not that fast). 'See GFSkinEnginefrm.UserMove_Disable for further information. ' Call SE_UnloadControl("GFStartStationCommandMovable(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")") Call SE_LoadControl("GFStartStationCommandMovable(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")", True) Call SE_RefreshControl("GFStartStationCommandMovable(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")", 0) 'NOTE: recreate disabled picture of BOTH command sets (important, tested). Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")"), DisabledPictureCacheDir, True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")"), DisabledPictureCacheDir, True) Call SE_LoadControl("GFStartStationCommandMovable(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")", True) Call SE_RefreshControl("GFStartStationCommandMovable(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")", 0) Case Else Call SE_UnloadControl("GFStartStationCommandFixed(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")") Call SE_LoadControl("GFStartStationCommandFixed(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")", True) Call SE_RefreshControl("GFStartStationCommandFixed(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")", 0) 'NOTE: recreate disabled picture of BOTH command sets (important, tested). Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandMovable(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")"), DisabledPictureCacheDir, True) Call DisabledPictureCache_CreateSub(GetSEControlStructIndex("GFStartStationCommandFixed(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")"), DisabledPictureCacheDir, True) Call SE_LoadControl("GFStartStationCommandFixed(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")", True) Call SE_RefreshControl("GFStartStationCommandFixed(" + LTrim$(Str$(GFStartStationCommandIndex)) + ")", 0) End Select '***END OF MP3 RENAMER 2 SPECIFIC*** End Sub Private Sub GFStartStation_ReceiveFile(ByVal FilePassed As String, ByVal StartStationCommandIndex As Integer) 'on error resume next 'FilePassed can be either a file name or a directory Dim FileTypeDescription As String Dim FileActionCommand As String Dim FileActionApplication As String Dim IconFile As String Dim IconIndex As Integer Dim StructLoop As Integer 'verify If Len(FilePassed) = 0 Then Exit Sub 'verify If (StartStationCommandIndex < 1) Or (StartStationCommandIndex > GFStartStationStructNumber) Then Exit Sub 'verify 'begin If (GetAttr(FilePassed) And vbDirectory) = vbDirectory Then If Not (Right$(FilePassed, 1) = "\") Then FilePassed = FilePassed + "\" 'verify For StructLoop = 1 To GFStartStationStructNumber If Not (StructLoop = StartStationCommandIndex) Then 'do not check stuff to overwrite If UCase$(GFStartStationStructArray(StructLoop).StartApplicationName) = UCase$(FilePassed) Then If MsgBox("You already added this browse directory, add it twice ?", vbYesNo + vbQuestion) = vbNo Then GoTo Jump: Else Exit For 'don't ask twice End If End If End If Next StructLoop GFStartStationStructArray(StartStationCommandIndex).StartApplicationType = GFSTARTSTATION_DIRECTORY GFStartStationStructArray(StartStationCommandIndex).StartApplicationName = FilePassed GFStartStationStructArray(StartStationCommandIndex).StartApplicationTypeDescription = "Directory" GFStartStationStructArray(StartStationCommandIndex).StartAplicationIconFile = "" GFStartStationStructArray(StartStationCommandIndex).StartAplicationIconIndex = 0 GFStartStationStructArray(StartStationCommandIndex).StartApplicationCommand = "" Call DeleteObject(GFStartStationStructArray(StartStationCommandIndex).IconHandle) 'reset GFStartStationStructArray(StartStationCommandIndex).IconHandle = ExtractIcon(App.hInstance, GFStartStationControlStructVar.FolderIconFile, GFStartStationControlStructVar.FolderIconIndex) 'stays in memory until being overwritten or until program termination Call GFStartStation_Refresh(StartStationCommandIndex) 'display changes Call GFStartStationToReg 'save changes Else Select Case UCase$(Right$(FilePassed, 4)) Case ".EXE", ".COM" For StructLoop = 1 To GFStartStationStructNumber If Not (StructLoop = StartStationCommandIndex) Then 'do not check stuff to overwrite If UCase$(GFStartStationStructArray(StructLoop).StartApplicationName) = UCase$(FilePassed) Then If MsgBox("You already added this application, add it twice ?", vbYesNo + vbQuestion) = vbNo Then GoTo Jump: Else Exit For 'don't ask twice End If End If End If Next StructLoop GFStartStationStructArray(StartStationCommandIndex).StartApplicationType = GFSTARTSTATION_FILE GFStartStationStructArray(StartStationCommandIndex).StartApplicationTypeDescription = "Executable" GFStartStationStructArray(StartStationCommandIndex).StartApplicationName = FilePassed GFStartStationStructArray(StartStationCommandIndex).StartApplicationCommand = "" 'reset GFStartStationStructArray(StartStationCommandIndex).StartAplicationIconFile = "" 'reset GFStartStationStructArray(StartStationCommandIndex).StartAplicationIconIndex = 0 'reset Call DeleteObject(GFStartStationStructArray(StartStationCommandIndex).IconHandle) 'reset 'first try to extract first icon from current application GFStartStationStructArray(StartStationCommandIndex).IconHandle = ExtractIcon(App.hInstance, FilePassed, 0) 'try to extract the file's default icon 'if failed, extract default executable icon If GFStartStationStructArray(StartStationCommandIndex).IconHandle = 0 Then GFStartStationStructArray(StartStationCommandIndex).IconHandle = ExtractIcon(App.hInstance, GFStartStationControlStructVar.ExecutableIconFile, GFStartStationControlStructVar.ExecutableIconIndex) 'stays in memory until being overwritten or until program termination End If Call GFStartStation_Refresh(StartStationCommandIndex) 'display changes Call GFStartStationToReg 'save changes Case Else If GFGetFileTypeInfo(FilePassed, "open", FileTypeDescription, FileActionCommand, FileActionApplication, IconFile, IconIndex) = True Then If Len(FileActionApplication) = 0 Then 'verify MsgBox "Sorry, this file cannot be executed !", vbOKOnly + vbInformation GoTo Jump: End If For StructLoop = 1 To GFStartStationStructNumber If Not (StructLoop = StartStationCommandIndex) Then 'do not check stuff to overwrite If UCase$(GFStartStationStructArray(StructLoop).StartApplicationName) = UCase$(FileActionApplication) Then If MsgBox(LANG_Translate(39, "You already added the application '") + FileActionApplication + LANG_Translate(40, "', add it twice ?"), vbYesNo + vbQuestion) = vbNo Then GoTo Jump: Else Exit For 'don't ask twice End If End If End If Next StructLoop GFStartStationStructArray(StartStationCommandIndex).StartApplicationType = GFSTARTSTATION_FILE GFStartStationStructArray(StartStationCommandIndex).StartApplicationTypeDescription = FileTypeDescription GFStartStationStructArray(StartStationCommandIndex).StartApplicationCommand = FileActionCommand GFStartStationStructArray(StartStationCommandIndex).StartApplicationName = FileActionApplication GFStartStationStructArray(StartStationCommandIndex).StartAplicationIconFile = IconFile GFStartStationStructArray(StartStationCommandIndex).StartAplicationIconIndex = IconIndex Call DeleteObject(GFStartStationStructArray(StartStationCommandIndex).IconHandle) 'reset GFStartStationStructArray(StartStationCommandIndex).IconHandle = ExtractIcon(App.hInstance, IconFile, IconIndex) 'stays in memory until being overwritten or until program termination Call GFStartStation_Refresh(StartStationCommandIndex) 'display changes Call GFStartStationToReg 'save changes Jump: Else MsgBox "Sorry, this file type is not associated with any application that could be started !", vbOKOnly + vbInformation 'no real error End If End Select End If End Sub Private Function GFGetFileTypeInfo(ByVal FilePassed As String, ByVal ActionPassed As String, ByRef FileTypeDescription As String, ByRef FileActionCommand As String, ByRef FileActionApplication As String, ByRef IconFile As String, ByRef IconIndex As Integer) As Boolean 'on error resume next 'returns True if a file type is associated with passed file, False if not Dim RemoveApplicationQutationFlag As Boolean Dim FileTypeDescriptionInternal As String Dim FileTypeDescriptionSubKey As String Dim FileApplication As String Dim FileApplicationNew As String Dim FileIconApplication As String Dim Temp As Long ' 'NOTE: pass 'open' for ActionPassed. Some file types don't have an open action, 'then this function will return "" as FileActionCommand and FileActionApplication. 'If it is known that 'open' will not work something else can be passed. 'NOTE: the following values are returned (var name: description) 'FileActionCommand: string read out of registry related to ActionCommand 'FileActionApplication: full path to application associated with file type ('%1' is removed, but not additional comments like '/n') 'IconFile: full path to file that contains icon related to file type 'IconIndex: index of icon in IconFile ' 'begin; read data out of registry FileTypeDescriptionInternal = Rmod.RegGetKeyValue(HKEY_CLASSES_ROOT, "." + GetFileNameSuffix(FilePassed), "") 'e.g. Winamp.File If Len(FileTypeDescriptionInternal) = 0 Then GFGetFileTypeInfo = False 'error Exit Function End If FileTypeDescription = Rmod.RegGetKeyValue(HKEY_CLASSES_ROOT, FileTypeDescriptionInternal, "") 'e.g. Winamp media file FileTypeDescriptionSubKey = FileTypeDescriptionInternal: If Not (Right$(FileTypeDescriptionSubKey, 1) = "\") Then FileTypeDescriptionSubKey = FileTypeDescriptionSubKey + "\" 'verify FileApplication = Trim$(Rmod.RegGetKeyValue(HKEY_CLASSES_ROOT, FileTypeDescriptionSubKey + "shell\" + ActionPassed + "\command", "")) 'e.g. "C:\PROGRAMME\WINAMP\WINAMP.EXE" "%1" or C:\PROGRAMME\MICROSOFT OFFICE\OFFICE\binder.exe -nologo %1 FileIconApplication = Trim$(Rmod.RegGetKeyValue(HKEY_CLASSES_ROOT, FileTypeDescriptionSubKey + "DefaultIcon", "")) 'e.g. C:\PROGRAMME\MICROSOFT OFFICE\OFFICE\binder.exe,3 'format read data 'NOTE: "s are removed, as well as all chars after (including) %1. For Temp = 1 To Len(FileApplication) If Mid$(FileApplication, Temp, 1) = """" Then If Temp = 1 Then RemoveApplicationQutationFlag = True Else If RemoveApplicationQutationFlag = True Then RemoveApplicationQutationFlag = False 'reset Else Exit For End If End If Else If Mid$(FileApplication, Temp, 2) = "%1" Then Exit For Else FileApplicationNew = FileApplicationNew + Mid$(FileApplication, Temp, 1) End If End If Next Temp For Temp = 1 To Len(FileIconApplication) If Mid$(FileIconApplication, Temp, 1) = "," Then IconFile = Left$(FileIconApplication, Temp - 1) IconIndex = Val(Right(FileIconApplication, Len(FileIconApplication) - Temp)) Exit For End If Next Temp 'create return values FileTypeDescription = FileTypeDescription FileActionCommand = Trim$(FileApplication) FileActionApplication = Trim$(FileApplicationNew) IconFile = Trim$(IconFile) IconIndex = IconIndex 'verify return values 'If ((Dirsave(FileActionApplication) = "") Or (Right$(FileActionApplication, 1) = "\") Or (FileActionApplication = "")) Then FileActionApplication = "" 'reset (error) 'no! (as e.g. C:\Command.com /p) 'If ((Dirsave(IconFile) = "") Or (Right$(IconFile, 1) = "\") Or (IconFile = "")) Then IconFile = "" 'reset (error) 'no! (as e.g. just 'shell32.dll') GFGetFileTypeInfo = True 'ok Exit Function End Function '********************************END OF GFSTARTSTATION********************************* '************************************SYSTEM MESSAGE************************************ 'NOTE: a system message has nothing to do with the internal system but is an info text 'displayed to the user in StepLabel. The original caption of StepLabel is temporary 'replaced through the system message text. After a defined time (depending on the 'length of the system message text) the original StepLabel is restored. Private Sub SystemMessage_Display(ByVal SystemMessageText As String) 'on error resume next Dim SystemMessageDisplayTime As Single 'how long system message will be displayed (in seconds) 'preset SystemMessageDisplayTime = 1! + CSng(Len(SystemMessageText)) * 0.1! 'user can read 10 letters per second (except he/she is blind/"Legastemiker") SystemMessageStructVar.StepLabelCaptionTemp = SystemMessageText If (SystemMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False) And _ (Len(StepLabel.Caption)) Then 'verify original message is not overwritten 'NOTE: do not store StepLabel.Caption if it hasn't been initialized yet, 'or there will be the error that StepLabel.Caption is reset to nothing although 'it should display e.g. 'Step 1' (tested). ' SystemMessageStructVar.StepLabelCaptionUnchangedStoredFlag = True ' If SystemManualMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False Then ' 'NOTE: if the original step label caption hasn't been stored yet by the 'SystemMessage or the systemManualMessage system we store it now ' SystemMessageStructVar.StepLabelCaptionUnchanged = StepLabel.Caption Else ' 'NOTE: if the original StepLabel caption has already been stored then we must not 'define the current StepLabel.Caption as original StepLabel caption. ' SystemMessageStructVar.StepLabelCaptionUnchanged = SystemManualMessageStructVar.StepLabelCaptionUnchanged End If End If StepLabel.Caption = SystemMessageText StepLabel.Refresh 'important 'begin 'NOTE: a message loop lasts 100 ms. Do While (Msg_Remove("wait for restore StepLabel.Caption") = True) 'reset Loop Do While (Msg_Remove("restore StepLabel.Caption") = True) 'reset Loop Call Msg_AddEx(MSG_NORMAL_EVENT, LTrim$(Str$(Int(SystemMessageDisplayTime * 10))), "0", "wait for restore StepLabel.Caption", "") 'does nothing, just usable for following message Call Msg_AddEx(MSG_EVENT_AFTER_EVENT_REMOVE, "wait for restore StepLabel.Caption", "", "restore StepLabel.Caption", "") End Sub Private Sub SystemMessage_Hide() 'on error resume next 'call to hide any currently displayed SystemMessage (important when changing StepLabel.Caption) SystemMessageStructVar.StepLabelCaptionTemp = "" 'reset SystemMessageStructVar.StepLabelCaptionUnchanged = "" 'reset SystemMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False 'reset Do While (Msg_Remove("wait for restore StepLabel.Caption") = True) 'reset Loop Do While (Msg_Remove("restore StepLabel.Caption") = True) 'reset Loop End Sub '********************************END OF SYSTEM MESSAGE********************************* '********************************SYSTEM MANUAL MESSAGE********************************* 'NOTE: the SystemManualMessage is shown and hidden manually, it does not disappear 'after a special time amount. Private Sub SystemManualMessage_Show(ByVal SystemManualMessageText As String) 'on error resume next SystemManualMessageStructVar.StepLabelCaptionTemp = SystemManualMessageText If (SystemManualMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False) And _ (Len(StepLabel.Caption)) Then 'verify original message is not overwritten ' 'NOTE: do not save StepLabel.Caption if it hasn't been intialized yet '(see also SystemMessage_Display). ' SystemManualMessageStructVar.StepLabelCaptionUnchangedStoredFlag = True ' If SystemMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False Then SystemManualMessageStructVar.StepLabelCaptionUnchanged = StepLabel.Caption Else ' 'NOTE: if the original StepLabel caption has already been stored then we must not 'define the current StepLabel.Caption as original StepLabel caption. ' SystemManualMessageStructVar.StepLabelCaptionUnchanged = SystemMessageStructVar.StepLabelCaptionUnchanged End If End If StepLabel.Caption = SystemManualMessageText StepLabel.Refresh 'important End Sub Private Sub SystemManualMessage_Hide() 'on error resume next If SystemManualMessageStructVar.StepLabelCaptionUnchangedStoredFlag = True Then 'verify SystemManualMessageStructVar.StepLabelCaptionUnchangedStoredFlag = False If StepLabel.Caption = SystemManualMessageStructVar.StepLabelCaptionTemp Then 'verify StepLabel.Caption = SystemManualMessageStructVar.StepLabelCaptionUnchanged StepLabel.Refresh 'important Else 'StepLabel caption has been changed by system, neither the temporary system message 'nor the stored unchanged caption is valid any more. End If End If End Sub '****************************END OF SYSTEM MANUAL MESSAGE****************************** '************************************UPDATE SYSTEM************************************* Public Sub Update_FileSystemStruct_DirsAdded() 'on error resume next Call GUI1_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI2_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI3_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI4_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI5_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI6_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI7_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI8_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI9_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI10_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI11_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) Call GUI12_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.QP_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) End If If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then Call TAGfrm.TAG_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) End If Call GUIXItemList_Update(UPDATE_DIRSADDED, "", 0, NULLARRAYINT()) End Sub Private Sub Update_FileSystemStruct_DirsRemoved() 'on error resume next Call GUI1_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI2_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI3_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI4_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI5_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI6_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI7_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI8_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI9_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI10_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI11_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) Call GUI12_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.QP_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) End If If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then Call TAGfrm.TAG_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) End If Call GUIXItemList_Update(UPDATE_DIRSREMOVED, "", 0, NULLARRAYINT()) End Sub Private Sub Update_FileSystemStruct_CDDescriptionChanged(ByVal CDDescriptionNew As String) 'on error resume next Call GUI1_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI2_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI3_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI4_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI5_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI6_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI7_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI8_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI9_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI10_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI11_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) Call GUI12_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.QP_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) End If If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then Call TAGfrm.TAG_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) End If Call GUIXItemList_Update(UPDATE_CDDESCRIPTIONCHANGED, CDDescriptionNew, 0, NULLARRAYINT()) End Sub '***FILEINFOSTRUCT UPDATE*** 'IMPORTANT: there a three ways to update the system after 'the data of one or more files has been changed: '-UpdateFileCollect system: ' -call UpdateFileCollect_Reset before changing file data ' -call UpdateFileCollect_ReceiveFile() right after changing data of a file ' -call UpdateFileCollect_AllocateFiles() after changing file data is finished '-Update_FileInfoStruct_FileChanged(): call when it is sure that not more than 1 file is to be changed '-Update_FileInfoStruct_FilesChanged(): call when a pointer array of the changed files is already existing ' 'NOTE: you should use Update_FileInfoStruct_FileChanged() if one file is to be changed, 'and UpdateFileCollect_[...] if several files are to be changed. 'Do not use Update_FileInfoStruct_FilesChanged() as then the required pointer array 'handling in the sub that changes file data makes the code difficult to read. ' 'NOTE: the UpdateFileCollect system is connected with the SG system. 'If one or more files have been changed and thus Update_FileInfoStruct_File[(s)]Changed() 'is called then the changed file will be updated in the SGFile, too. Public Sub UpdateFileCollect_Reset() 'on error resume next UpdateFileCollectStructVar.FileInfoStructPointerNumber = 0 'reset ReDim UpdateFileCollectStructVar.FileInfoStructPointerArray(1 To 1) As Integer End Sub Public Sub UpdateFileCollect_ReceiveFile(ByVal FileInfoStructPointer As Integer) 'on error resume next Dim FileLoop As Integer 'verify For FileLoop = 1 To UpdateFileCollectStructVar.FileInfoStructPointerNumber If UpdateFileCollectStructVar.FileInfoStructPointerArray(FileLoop) = FileInfoStructPointer Then Exit Sub 'file has already been added End If Next FileLoop 'begin If Not (UpdateFileCollectStructVar.FileInfoStructPointerNumber = 32766) Then 'verify UpdateFileCollectStructVar.FileInfoStructPointerNumber = UpdateFileCollectStructVar.FileInfoStructPointerNumber + 1 If ((UpdateFileCollectStructVar.FileInfoStructPointerNumber - 1) Mod 64) = 0 Then 'increase in larger steps to save CPU time ReDim Preserve UpdateFileCollectStructVar.FileInfoStructPointerArray(1 To UpdateFileCollectStructVar.FileInfoStructPointerNumber + 63) As Integer End If UpdateFileCollectStructVar.FileInfoStructPointerArray(UpdateFileCollectStructVar.FileInfoStructPointerNumber) = FileInfoStructPointer Else MsgBox "internal error in UpdateFileCollect_ReceiveFile(): overflow !", vbOKOnly + vbExclamation End If Exit Sub End Sub Public Sub UpdateFileCollect_AllocateFiles() 'on error resume next Call Update_FileInfoStruct_FilesChanged(UpdateFileCollectStructVar.FileInfoStructPointerNumber, UpdateFileCollectStructVar.FileInfoStructPointerArray()) End Sub Private Sub Update_ResetUsedFlag() 'on error resume next ' 'NOTE: the system can call Update_ResetUsedFlag and then 'determine if since this call any file has been changed through 'checking the return value of Update_WasUsed. 'If at least one file has been changed then the new file names 'must be recreated. ' UpdateStructVar.UpdateUsedFlag = False 'reset End Sub Private Function Update_WasUsed() As Boolean 'on error resume next Update_WasUsed = UpdateStructVar.UpdateUsedFlag End Function Public Sub Update_FileInfoStruct_FileChanged(ByVal FileInfoStructPointer As Integer) 'on error resume next Dim FileInfoStructPointerNumber As Integer Dim FileInfoStructPointerArray() As Integer 'preset FileInfoStructPointerNumber = 1 ReDim FileInfoStructPointerArray(1 To FileInfoStructPointerNumber) As Integer FileInfoStructPointerArray(1) = FileInfoStructPointer 'begin UpdateStructVar.UpdateUsedFlag = True Call GUI1_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI2_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI3_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI4_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI5_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI6_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI7_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI8_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI9_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI10_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI11_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI12_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.QP_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) End If If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then Call TAGfrm.TAG_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) End If Call GUIXItemList_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) ' Call SGfrm.SG_SaveOne(FileInfoStructPointer, 0, SG_ALL) Call SGfrm.SG_PaletteIndex_Receive(GUICStructVar.GUIPaletteNumberCurrent) ' End Sub Public Sub Update_FileInfoStruct_FilesChanged(ByVal FileInfoStructPointerNumber As Integer, ByRef FileInfoStructPointerArray() As Integer) 'on error resume next Dim FileInfoStructPointerLoop As Integer 'begin UpdateStructVar.UpdateUsedFlag = True Call GUI1_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI2_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI3_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI4_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI5_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI6_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI7_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI8_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI9_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI10_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI11_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) Call GUI12_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.QP_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) End If If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then Call TAGfrm.TAG_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) End If Call GUIXItemList_Update(UPDATE_FILESCHANGED, "", FileInfoStructPointerNumber, FileInfoStructPointerArray()) ' For FileInfoStructPointerLoop = 1 To FileInfoStructPointerNumber Call SGfrm.SG_SaveOne(FileInfoStructPointerArray(FileInfoStructPointerLoop), 0, SG_ALL) Next FileInfoStructPointerLoop Call SGfrm.SG_PaletteIndex_Receive(GUICStructVar.GUIPaletteNumberCurrent) ' End Sub Private Sub Update_FileInfoStruct_NewFiles_Created() 'on error resume next Call GUI1_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI2_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI3_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI4_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI5_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI6_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI7_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI8_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI9_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI10_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI11_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) Call GUI12_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.QP_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) End If If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then Call TAGfrm.TAG_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) End If Call GUIXItemList_Update(UPDATE_NEWFILES_CREATED, "", 0, NULLARRAYINT()) End Sub '***END OF FILEINFOSTRUCT UPDATE*** Public Sub Update_Reload() 'on error resume next 'call when so much was changed that everything's too late (e.g. if FileInfoStructArray() data was sorted) UpdateStructVar.UpdateUsedFlag = True Call GUI1_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI2_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI3_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI4_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI5_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI6_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI7_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI8_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI9_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI10_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI11_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) Call GUI12_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.QP_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) End If If (SystemForms_IsSystemFormLoaded(TAGfrm)) Then Call TAGfrm.TAG_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) End If Call GUIXItemList_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) ' Call SGfrm.SG_Show Call SGfrm.SG_SaveAll(SG_ALL) 'when e.g. sorted Call SGfrm.SG_PaletteIndex_Receive(GUICStructVar.GUIPaletteNumberCurrent) Call SGfrm.SG_Hide ' End Sub Public Sub Update_CD_Changed() 'to be called by CDfrm 'on error resume next ' 'NOTE: QPList only displays files of valid directories. 'When an other cd rom was inserted these directories maybe changed. ' If (SystemForms_IsSystemFormLoaded(QPfrm)) Then Call QPfrm.QP_Update(UPDATE_DORELOAD, "", 0, NULLARRAYINT()) End If End Sub '********************************END OF UPDATE SYSTEM********************************** '************************************GUIXLISTVIEW************************************** 'NOTE: the following subs are used to process GUIXListViews click events '(equal handling for all lists). Private Sub GUIXListView_ProcessClick(ByVal Button As Integer, ByVal X As Single, ByVal Y As Single, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error Resume Next Dim ListViewMouseXPosTotal As Long 'real mouse position on report view Dim ListViewOriginXPos As Long Dim ListViewColumnXPos As Long Dim Temp As Long ' 'NOTE: every GUIXListView can be searched, and the currently 'pointed item can be changed (see Menu[20-24]). ' 'begin Select Case Button Case vbRightButton Select Case GetShift Case 0 If GUIXListView Is GUI10ListView Then Call ProgramUpdatePopUpMenu(37, "GUI10ListView", GUI10ListView) Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 30, "GUI10ListView", GUI10ListView) 'Menu37 ElseIf GUIXListView Is TAGListView Then ' 'NOTE: the pop up menu tghat allows the user to exclude a file from AutoChange is opened. 'We do NOT open the original GUIXListView pop up menu and so we'll never use TAGListrView_EditEx(). ' 'NOTE: the excluding a file from AutoChange is not programmed yet, 'se NO pop up menu is opened. ' 'Call ProgramUpdatePopUpMenu(32, "TAGfrm.TAGListView", TAGListView) 'Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 26, "GUI10ListView", GUI10ListView) 'Menu32 Else If Not (GUIXListView.ListIndex = True) Then 'verify Call GUIXListView.GetOrigin(ListViewOriginXPos, 0) ListViewMouseXPosTotal = (X / Screen.TwipsPerPixelX) + ListViewOriginXPos For Temp = CONST_SONGNAME To CONST_WRITER - 1 'previously -2 but now -1 as there's the track at end If (ListViewMouseXPosTotal >= ListViewColumnXPos) And (ListViewMouseXPosTotal < (ListViewColumnXPos + (GUIXListView.ColumnWidth(Temp) / Screen.TwipsPerPixelX))) Then Select Case Temp Case CONST_SONGNAME If Not (GUIXListView.ListIndex = True) Then Call CopyPaste_StoreString(GUIXListView.List(GUIXListView.ListIndex, 1), GUIXListView.ListIndex, 1) Call ProgramUpdatePopUpMenu(20, GUIXListView.Name, GUIXListView) 'Find Next Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 15, GetSourceDescriptionFromSourceObject(GUIXListView), GUIXListView) 'Menu20 Case CONST_ARTISTNAME If Not (GUIXListView.ListIndex = True) Then Call CopyPaste_StoreString(GUIXListView.List(GUIXListView.ListIndex, 2), GUIXListView.ListIndex, 2) Call ProgramUpdatePopUpMenu(21, GUIXListView.Name, GUIXListView) Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 16, GetSourceDescriptionFromSourceObject(GUIXListView), GUIXListView) 'Menu21 Case CONST_ALBUMNAME If Not (GUIXListView.ListIndex = True) Then Call CopyPaste_StoreString(GUIXListView.List(GUIXListView.ListIndex, 3), GUIXListView.ListIndex, 3) Call ProgramUpdatePopUpMenu(22, GUIXListView.Name, GUIXListView) Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 17, GetSourceDescriptionFromSourceObject(GUIXListView), GUIXListView) 'Menu22 Case CONST_YEARNAME If Not (GUIXListView.ListIndex = True) Then Call CopyPaste_StoreString(GUIXListView.List(GUIXListView.ListIndex, 4), GUIXListView.ListIndex, 4) Call ProgramUpdatePopUpMenu(23, GUIXListView.Name, GUIXListView) Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 18, GetSourceDescriptionFromSourceObject(GUIXListView), GUIXListView) 'Menu23 Case CONST_COMMENT If Not (GUIXListView.ListIndex = True) Then Call CopyPaste_StoreString(GUIXListView.List(GUIXListView.ListIndex, 5), GUIXListView.ListIndex, 5) Call ProgramUpdatePopUpMenu(24, GUIXListView.Name, GUIXListView) Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 19, GetSourceDescriptionFromSourceObject(GUIXListView), GUIXListView) 'Menu24 Case 6 'CONST_GENRE = 7, value of CONST_TRASH (= 6) cannot be changed any more 'If Not (GUIXListView.ListIndex = True) Then Call CopyPaste_StoreString(GUIXListView.List(GUIXListView.ListIndex, 6), GUIXListView.ListIndex, 6) 'no! (senseless) Call ProgramUpdatePopUpMenu(35, GUIXListView.Name, GUIXListView) Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 28, GetSourceDescriptionFromSourceObject(GUIXListView), GUIXListView) 'Menu35 Case CONST_COMPOSER - 2 To CONST_WRITER - 2 If Not (GUIXListView.ListIndex = True) Then Call CopyPaste_StoreString(GUIXListView.List(GUIXListView.ListIndex, Temp), GUIXListView.ListIndex, Temp) Call ProgramUpdatePopUpMenu(50, GUIXListView.Name, GUIXListView, CStr(Temp + 2)) Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 35, GetSourceDescriptionFromSourceObject(GUIXListView), GUIXListView, CStr(Temp + 2)) 'Menu50; TAG item to edit is in Tag Case CONST_WRITER - 1 'there's the track If Not (GUIXListView.ListIndex = True) Then Call CopyPaste_StoreString(GUIXListView.List(GUIXListView.ListIndex, Temp), GUIXListView.ListIndex, Temp) Call ProgramUpdatePopUpMenu(50, GUIXListView.Name, GUIXListView, CONST_TRASH) Call ProgramOpenPopUpMenu(ProgramGetMousePosX, ProgramGetMousePosY, 35, GetSourceDescriptionFromSourceObject(GUIXListView), GUIXListView, CONST_TRASH) 'Menu50; TAG item to edit is in Tag End Select GoTo Jump: End If ListViewColumnXPos = ListViewColumnXPos + (GUIXListView.ColumnWidth(Temp) / Screen.TwipsPerPixelX) Next Temp Jump: End If End If Case vbCtrlMask 'excludes vbShiftMask If Not (GUIXListView.ListIndex = True) Then 'verify If VerifyDriveEx(GETRETURNSTRINGFROMBYTESTRING( _ FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileName()), _ GETRETURNSTRINGFROMBYTESTRING( _ FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileSerialNumber())) = True Then Call ActionPlayMenu_Update Call ActionPlayMenu_Open("", GUIXListView, _ GETRETURNSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileName())) End If End If End Select Case vbLeftButton If GUIXListView Is GUI9ListView Then Call Msg_Add("call GUI9ListView_SelectionChanged") 'will update LWCSelectionInfoLabel, selection changes AFTER click-event End If End Select Exit Sub End Sub '***GUIXLISTVIEW SEARCH*** 'NOTE: every item type can be searched seperatly Private Sub GUIXListView_SearchNext(ByRef GUIXListView As GFReportViewcls, ByRef GUIXListViewSearchStructVar As GUIXListViewSearchStruct) 'on error Resume Next 'searches text box from current selection Dim ListLoop As Integer Dim ResetLoop As Integer 'begin For ListLoop = (GUIXListView.ListIndex + 2) To GUIXListView.ListCount If Not (InStr(1, GUIXListView.List(ListLoop - 1, GUIXListViewSearchStructVar.ListViewSubItemIndex), GUIXListViewSearchStructVar.SearchString, vbTextCompare) = 0) Then For ResetLoop = 1 To GUIXListView.ListCount GUIXListView.Selected(ResetLoop - 1) = False 'reset Next ResetLoop GUIXListView.ListIndex = ListLoop - 1 Exit Sub 'important End If Next ListLoop Call GUIXListView_Search(GUIXListView, GUIXListViewSearchStructVar) 'search from beginning; display error message if string was not found Exit Sub End Sub Private Function GUIXListView_BeginSearch(ByRef GUIXListView As GFReportViewcls, ByRef GUIXListViewSearchStructVar As GUIXListViewSearchStruct) As Boolean 'on error Resume Next 'call when SearchString is "" Dim Tempstr$ ' 'NOTE: this function will set the SearchString member of the passed 'GUIXListViewSearchStructVar. If this function returns False (user canceled), 'the search must not be begun. ' 'NOTE: once the user entered a search string the 'Find next' menu 'is enabled and will not be disabled any more as the user cannot 'reset the search string to nothing. ' Tempstr$ = Left$(Pmod.GFInputBox("Please enter search string:", "Search", GUIXListViewSearchStructVar.SearchString), 512) If Not (Tempstr$ = "") Then 'verify GUIXListViewSearchStructVar.SearchString = Tempstr$ GUIXListView_BeginSearch = True Else GUIXListView_BeginSearch = False End If 'NOTE: UpdatePopUpMenu() updates the search pop up menus. ' If Not (GUIXListViewSearchStructVar.SearchString = "") Then ' MENUfrm.M16(15).Enabled = True 'Find next ' Else ' MENUfrm.M16(15).Enabled = False 'Find next ' End If End Function Private Sub GUIXListView_Search(ByRef GUIXListView As GFReportViewcls, ByRef GUIXListViewSearchStructVar As GUIXListViewSearchStruct) 'on error Resume Next 'searches text box from beginning Dim ListLoop As Integer Dim ResetLoop As Integer 'begin For ListLoop = 1 To GUIXListView.ListCount If Not (InStr(1, GUIXListView.List(ListLoop - 1, GUIXListViewSearchStructVar.ListViewSubItemIndex), GUIXListViewSearchStructVar.SearchString, vbTextCompare) = 0) Then For ResetLoop = 1 To GUIXListView.ListCount GUIXListView.Selected(ResetLoop - 1) = False 'reset Next ResetLoop GUIXListView.ListIndex = ListLoop - 1 Exit Sub 'important End If Next ListLoop MsgBox LANG_Translate(41, "String '") + GUIXListViewSearchStructVar.SearchString + LANG_Translate(42, "' not found !"), vbOKOnly + vbInformation Exit Sub End Sub '***END OF GUIXLISTVIEW SEARCH*** Private Sub GUIXListView_ProcessDblClick(ByVal Button As Integer, ByVal X As Single, ByVal Y As Single, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error Resume Next Select Case Button Case vbLeftButton If Not (GUIXListView.ListIndex = True) Then 'verify If VerifyDriveEx(GETRETURNSTRINGFROMBYTESTRING( _ FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileName()), _ GETRETURNSTRINGFROMBYTESTRING( _ FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileSerialNumber())) = True Then Call ActionPlay_PlayMP3File(GETRETURNSTRINGFROMBYTESTRING( _ FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileName())) End If End If End Select End Sub Private Sub GUIXListView_GetItemNameAndValue(ByVal ItemType As Integer, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer, ByVal ListIndex As Integer, ByRef ItemName As String, ByRef ItemValue As String) 'on error resume next Select Case ItemType Case CONST_SONGNAME ItemName = GetTAGItemTypeDescription(CONST_SONGNAME) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileSongName(), ItemValue) Case CONST_ARTISTNAME ItemName = GetTAGItemTypeDescription(CONST_ARTISTNAME) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileArtistName(), ItemValue) Case CONST_ALBUMNAME ItemName = GetTAGItemTypeDescription(CONST_ARTISTNAME) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileAlbumName(), ItemValue) Case CONST_YEARNAME ItemName = GetTAGItemTypeDescription(CONST_YEAR) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileYearName(), ItemValue) Case CONST_COMMENT ItemName = GetTAGItemTypeDescription(CONST_COMMENT) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileComment(), ItemValue) Case CONST_TRASH ItemName = GetTAGItemTypeDescription(CONST_TRASH) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileTrash(), ItemValue) Case CONST_COMPOSER ItemName = GetTAGItemTypeDescription(CONST_COMPOSER) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGComposer(), ItemValue) Case CONST_ORIGINALARTIST ItemName = GetTAGItemTypeDescription(CONST_ORIGINALARTIST) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGOriginalArtist(), ItemValue) Case CONST_PUBLISHER ItemName = GetTAGItemTypeDescription(CONST_PUBLISHER) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGPublisher(), ItemValue) Case CONST_COPYRIGHT ItemName = GetTAGItemTypeDescription(CONST_COPYRIGHT) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGCopyright(), ItemValue) Case CONST_CONDUCTOR ItemName = GetTAGItemTypeDescription(CONST_CONDUCTOR) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGConductor(), ItemValue) Case CONST_URL ItemName = GetTAGItemTypeDescription(CONST_URL) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGURL(), ItemValue) Case CONST_ENCODEDBY ItemName = GetTAGItemTypeDescription(CONST_ENCODEDBY) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGEncodedBy(), ItemValue) Case CONST_WRITER ItemName = GetTAGItemTypeDescription(CONST_WRITER) Call GETSTRINGFROMBYTESTRING(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGWriter(), ItemValue) Case Else ItemName = "unknown item" ItemValue = "" End Select End Sub Private Sub GUIXListView_ChangeItemValue(ByVal ItemType As Integer, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer, ByVal ListIndex As Integer, ByVal ItemValueNew As String) 'on error resume next Select Case ItemType Case CONST_SONGNAME Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileSongName(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileSongName(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_ARTISTNAME Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileArtistName(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileArtistName(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_ALBUMNAME Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileAlbumName(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileAlbumName(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_YEARNAME Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileYearName(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileYearName(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_COMMENT Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileComment(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileComment(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_TRASH Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileTrash(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).FileTrash(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_COMPOSER Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGComposer(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGComposer(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_ORIGINALARTIST Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGOriginalArtist(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGOriginalArtist(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_PUBLISHER Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGPublisher(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGPublisher(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_COPYRIGHT Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGCopyright(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGCopyright(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_CONDUCTOR Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGConductor(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGConductor(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_URL Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGURL(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGURL(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_ENCODEDBY Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGEncodedBy(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGEncodedBy(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) Case CONST_WRITER Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGWriter(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListIndex)).TAGWriter(), ItemValueNew) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListIndex)) End Select End Sub Private Sub GUIXListView_Edit(ByVal ItemType As Integer, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error resume next Dim ItemTypeDescription As String Dim ItemValue As String Dim InputCancelFlag As Boolean Dim CreateNewFilesFlag As Boolean Dim ListLoop As Integer Dim TempBoolean As Boolean Dim TempByte As Byte 'verify 'begin If GUIXListView.SelectionCount > 0 Then 'verify Call GUIXListView_GetItemNameAndValue(ItemType, GUIXListView, GUIXListViewPointerArray(), GUIXListView.ListIndex + 1, ItemTypeDescription, ItemValue) ReDo: ItemValue = Pmod.GFInputBox("Edit " + ItemTypeDescription, "Quick TAG Edit", ItemValue, False, InputCancelFlag) If InputCancelFlag = True Then GoTo Jump: Select Case ItemType Case CONST_YEARNAME If Len(ItemValue) > 4 Then If MsgBox("The " + ItemTypeDescription + "'s length cannot exceed 4 chars, continue ?", vbYesNo + vbQuestion) = vbNo Then GoTo ReDo: Else ItemValue = Left$(ItemValue, 4) End If End If Case Else If Len(ItemValue) > FILEINFOSTRUCT_TAGSTRINGLENGTH Then If MsgBox("The " + ItemTypeDescription + "'s length cannot exceed " + LTrim$(Str$(FILEINFOSTRUCT_TAGSTRINGLENGTH)) + " chars, continue ?", vbYesNo + vbQuestion) = vbNo Then GoTo ReDo: Else ItemValue = Left$(ItemValue, FILEINFOSTRUCT_TAGSTRINGLENGTH) End If End If End Select Call GUI_Wait For ListLoop = 1 To GUIXListView.ListCount If GUIXListView.Selected(ListLoop - 1) = True Then Select Case ItemType Case CONST_SONGNAME Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileSongName(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileSongName(), ItemValue) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListLoop)) If (InStr(1, FileSystemStructVar.FileFormatString, "%song%", vbTextCompare)) Then CreateNewFilesFlag = True End If Case CONST_ARTISTNAME Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileArtistName(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileArtistName(), ItemValue) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListLoop)) If (InStr(1, FileSystemStructVar.FileFormatString, "%artist%", vbTextCompare)) Then CreateNewFilesFlag = True End If Case CONST_ALBUMNAME Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileAlbumName(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileAlbumName(), ItemValue) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListLoop)) If (InStr(1, FileSystemStructVar.FileFormatString, "%album%", vbTextCompare)) Then CreateNewFilesFlag = True End If Case CONST_YEARNAME Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileYearName(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileYearName(), ItemValue) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListLoop)) If (InStr(1, FileSystemStructVar.FileFormatString, "%year%", vbTextCompare)) Then CreateNewFilesFlag = True End If Case CONST_COMMENT Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileComment(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileComment(), ItemValue) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListLoop)) If (InStr(1, FileSystemStructVar.FileFormatString, "%comment%", vbTextCompare)) Then CreateNewFilesFlag = True End If Case CONST_TRASH Call BYTESTRINGLEFT(FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileTrash(), 0) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileTrash(), ItemValue) Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(ListLoop)) If (InStr(1, FileSystemStructVar.FileFormatString, "%track%", vbTextCompare)) Then CreateNewFilesFlag = True End If Case Else Call GUIXListView_ChangeItemValue(ItemType, GUIXListView, GUIXListViewPointerArray(), ListLoop, ItemValue) End Select End If Next ListLoop Jump: Call GUI_Continue 'If CreateNewFilesFlag = True Then ' Call NewFiles_Create(False) 'just recreate file names 'no, recreated when leaving step (5, 6, 9) 'End If Else MsgBox "Please select one or more list items to edit !", vbOKOnly + vbExclamation End If End Sub Private Sub GUIXListView_EditGenre(ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error resume next Dim ItemTypeDescription As String Dim TempBoolean As Boolean Dim TempByte As Byte ' 'NOTE: this sub changes the genre of the 'ListIndex-item'. 'begin ItemTypeDescription = "genre" TempByte = TGfrm.TG_RequestGenre(FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileGenre, TempBoolean) If TempBoolean = False Then FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileGenre = TempByte FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileInfoEx = FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileInfoEx Or FILEINFOEX_FILEGENRECHANGED Call Update_FileInfoStruct_FileChanged(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)) If (InStr(1, FileSystemStructVar.FileFormatString, "%genre%", vbTextCompare)) Then Call NewFiles_Create(False) 'just recreate file names End If End If End Sub Private Sub GUIXListView_EditGenres(ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error resume next Dim ItemTypeDescription As String Dim TempBoolean As Boolean Dim TempByte As Byte Dim ListLoop As Integer ' 'NOTE: this sub changes the genre of all selected items. ' 'begin ItemTypeDescription = "genre" TempByte = TGfrm.TG_RequestGenre(FileInfoStructArray(GUIXListViewPointerArray(GUIXListView.ListIndex + 1)).FileGenre, TempBoolean) If TempBoolean = False Then Call UpdateFileCollect_Reset 'reset Call GUI_Wait For ListLoop = 1 To GUIXListView.ListCount If GUIXListView.Selected(ListLoop - 1) = True Then FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileGenre = TempByte FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileInfoEx = FileInfoStructArray(GUIXListViewPointerArray(ListLoop)).FileInfoEx Or FILEINFOEX_FILEGENRECHANGED Call UpdateFileCollect_ReceiveFile(GUIXListViewPointerArray(ListLoop)) End If Next ListLoop Call GUI_Continue Call UpdateFileCollect_AllocateFiles If (InStr(1, FileSystemStructVar.FileFormatString, "%genre%", vbTextCompare)) Then Call NewFiles_Create(False) 'just recreate file names End If End If End Sub Private Sub GUIXListView_EditEx(ByVal ItemType As Integer, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error resume next Dim MouseGuideControlStructIndex As Integer 'begin If Not (GUIXListView.ListIndex = True) Then 'verify ' Select Case ItemType ' Case CONST_SONGNAME ' MouseGuideControlStructIndex = GetSEControlStructIndex("TAGfrm.TAGSongNameText") ' Case CONST_ARTISTNAME ' MouseGuideControlStructIndex = GetSEControlStructIndex("TAGfrm.TAGArtistNameText") ' Case CONST_ALBUMNAME ' MouseGuideControlStructIndex = GetSEControlStructIndex("TAGfrm.TAGAlbumNameText") ' Case CONST_YEARNAME ' MouseGuideControlStructIndex = GetSEControlStructIndex("TAGfrm.TAGYearNameText") ' Case CONST_COMMENT ' MouseGuideControlStructIndex = GetSEControlStructIndex("TAGfrm.TAGCommentText") ' End Select ' 'NOTE: beta testers (to be exact: one beta tester (to be exact: the one and only beta tester)) 'said that the mouse animation is annoying as it slows down the changing process of many 'files, so we disabled the mouse animation (but it could be done, no matter, just enable the 'commented-out code and disable the line below). ' MouseGuideControlStructIndex = 0 'no animation ' Call Pmod.TAG_Edit(GUIXListViewPointerArray(GUIXListView.ListIndex + 1), ItemType, MouseGuideControlStructIndex) 'NOTE: important (ItemType): CONST_SONGNAME must be 1, CONST_ARTISTNAME must be 2 etc. Else MsgBox "Please select a list item to edit !", vbOKOnly + vbExclamation End If End Sub Private Sub GUIXListView_Capitalize(ByVal ItemType As Integer, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error resume next Dim ItemName As String Dim ItemValue As String Dim ListLoop As Integer Dim TempByteString(1 To FILEINFOSTRUCT_TAGSTRINGLENGTH) As Byte 'begin Call GUI_Wait For ListLoop = 1 To GUIXListView.ListCount If GUIXListView.Selected(ListLoop - 1) = True Then Call GUIXListView_GetItemNameAndValue(ItemType, GUIXListView, GUIXListViewPointerArray(), ListLoop, ItemName, ItemValue) Call BYTESTRINGCLEAR(TempByteString()) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, TempByteString(), ItemValue) Call GUI4_FormatByte_Capitalization(TempByteString()) Call GUIXListView_ChangeItemValue(ItemType, GUIXListView, GUIXListViewPointerArray(), ListLoop, GETRETURNSTRINGFROMBYTESTRING(TempByteString())) End If Next ListLoop Call GUI_Continue End Sub Private Sub GUIXListView_Cut(ByVal ItemType As Integer, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error resume next 'cuts AND replaces Dim ItemName As String Dim ItemValue As String Dim ListLoop As Integer Dim TempByteString(1 To FILEINFOSTRUCT_TAGSTRINGLENGTH) As Byte 'begin Call GUI_Wait For ListLoop = 1 To GUIXListView.ListCount If GUIXListView.Selected(ListLoop - 1) = True Then Call GUIXListView_GetItemNameAndValue(ItemType, GUIXListView, GUIXListViewPointerArray(), ListLoop, ItemName, ItemValue) Call BYTESTRINGCLEAR(TempByteString()) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, TempByteString(), ItemValue) Call GUI4_FormatByte_Cut(TempByteString(), ItemType, CutStructNumber, CutStructArray(), True) Call GUI4_FormatByte_NumberSpaceCheck(TempByteString()) Call GUI4_FormatByte_Cut(TempByteString(), ItemType, CutStructNumber, CutStructArray(), True) Call GUIXListView_ChangeItemValue(ItemType, GUIXListView, GUIXListViewPointerArray(), ListLoop, GETRETURNSTRINGFROMBYTESTRING(TempByteString())) End If Next ListLoop Call GUI_Continue End Sub Private Sub GUIXListView_Replace(ByVal ItemType As Integer, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error resume next 'cuts AND replaces Dim ItemName As String Dim ItemValue As String Dim ListLoop As Integer Dim TempByteString(1 To FILEINFOSTRUCT_TAGSTRINGLENGTH) As Byte Dim TempBool As Boolean Dim Tempstr$ 'preset Dim ReplaceInputByteString(1 To FILEINFOSTRUCT_TAGSTRINGLENGTH) As Byte Dim ReplaceInputByteStringLength As Long Dim ReplaceOutputByteString(1 To FILEINFOSTRUCT_TAGSTRINGLENGTH) As Byte Dim ReplaceOutputByteStringLength As Long Tempstr$ = Pmod.GFInputBox("Please enter input string (what to replace):", "Replace within TAG item", "", False, TempBool) If (TempBool = True) Then Exit Sub End If Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, ReplaceInputByteString, Tempstr$) ReplaceInputByteStringLength = Len(Tempstr$) Tempstr$ = Pmod.GFInputBox("Please enter output string (what overwrites the input string within TAG item):", "Replace within TAG item", "", False, TempBool) If (TempBool = True) Then Exit Sub End If Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, ReplaceOutputByteString, Tempstr$) ReplaceOutputByteStringLength = Len(Tempstr$) 'begin Call GUI_Wait For ListLoop = 1 To GUIXListView.ListCount If GUIXListView.Selected(ListLoop - 1) = True Then Call GUIXListView_GetItemNameAndValue(ItemType, GUIXListView, GUIXListViewPointerArray(), ListLoop, ItemName, ItemValue) Call BYTESTRINGCLEAR(TempByteString()) 'reset (important) Call GETFIXEDBYTESTRINGFROMSTRING(FILEINFOSTRUCT_TAGSTRINGLENGTH, TempByteString(), ItemValue) ' Dim InStrPos As Long InStrPos = 0 'preset Do 'search for ALL appearances of rplace input string InStrPos = InStrByte(InStrPos + 1, TempByteString(), ReplaceInputByteString(), vbBinaryCompare) If (InStrPos > 0) Then Call BYTESTRINGCUT(TempByteString(), InStrPos, ReplaceInputByteStringLength) Call BYTESTRINGINSERTByte(TempByteString(), InStrPos, ReplaceOutputByteString(), False) Call GUIXListView_ChangeItemValue(ItemType, GUIXListView, GUIXListViewPointerArray(), ListLoop, GETRETURNSTRINGFROMBYTESTRING(TempByteString())) InStrPos = InStrPos + ReplaceOutputByteStringLength - 1 'or e.g. '"-hey-"---"-=> - "--->" ..." Else Exit Do End If Loop ' End If Next ListLoop Call GUI_Continue End Sub Private Sub GUIXListView_ProcessHeaderClick(ByVal Button As Integer, ByVal X As Single, ByVal Y As Single, ByVal ListViewHeaderIndex As Integer, ByRef GUIXListView As Object, ByRef GUIXListViewPointerArray() As Integer) 'on error Resume Next 'verify Select Case ListViewHeaderIndex Case CONST_COMPOSER - 2 To CONST_WRITER - 2 MsgBox "Sorry, you can only sort by any ID3v1 TAG item (song, artist, album, year, comment or track) !", vbOKOnly + vbInformation Exit Sub End Select 'begin Call GUI_Wait Call SystemManualMessage_Show("Sorting, please wait...") Select Case ListViewHeaderIndex Case 1 'If Not (GUIXListViewStructVar.SortItemTypeOld = CONST_SONGNAME) Then 'if coming from step 10 or having changed e.g. song name in step 9 we could not sort by song name again :( Call FileInfoStruct_Sort(FileInfoStructNumber, FileInfoStructArray(), CONST_SONGNAME) GUIXListViewStructVar.SortItemTypeOld = CONST_SONGNAME Call GUIXListViewStructToReg 'save changes 'End If Case 2 'If Not (GUIXListViewStructVar.SortItemTypeOld = CONST_ARTISTNAME) Then Call FileInfoStruct_Sort(FileInfoStructNumber, FileInfoStructArray(), CONST_ARTISTNAME) GUIXListViewStructVar.SortItemTypeOld = CONST_ARTISTNAME Call GUIXListViewStructToReg 'save changes 'End If Case 3 'If Not (GUIXListViewStructVar.SortItemTypeOld = CONST_ALBUMNAME) Then Call FileInfoStruct_Sort(FileInfoStructNumber, FileInfoStructArray(), CONST_ALBUMNAME) GUIXListViewStructVar.SortItemTypeOld = CONST_ALBUMNAME Call GUIXListViewStructToReg 'save changes 'End If Case 4 'If Not (GUIXListViewStructVar.SortItemTypeOld = CONST_YEARNAME) Then Call FileInfoStruct_Sort(FileInfoStructNumber, FileInfoStructArray(), CONST_YEARNAME) GUIXListViewStructVar.SortItemTypeOld = CONST_YEARNAME Call GUIXListViewStructToReg 'save changes 'End If Case 5 'If Not (GUIXListViewStructVar.SortItemTypeOld = CONST_COMMENT) Then Call FileInfoStruct_Sort(FileInfoStructNumber, FileInfoStructArray(), CONST_COMMENT) GUIXListViewStructVar.SortItemTypeOld = CONST_COMMENT Call GUIXListViewStructToReg 'save changes 'End If Case 6 If Not (GUIXListViewStructVar.SortItemTypeOld = CONST_GENRE) Then Call FileInfoStruct_Sort(FileInfoStructNumber, FileInfoStructArray(), CONST_GENRE) GUIXListViewStructVar.SortItemTypeOld = CONST_GENRE Call GUIXListViewStructToReg 'save changes End If Case 15 If Not (GUIXListViewStructVar.SortItemTypeOld = CONST_TRASH) Then Call FileInfoStruct_Sort(FileInfoStructNumber, FileInfoStructArray(), CONST_TRASH) GUIXListViewStructVar.SortItemTypeOld = CONST_TRASH Call GUIXListViewStructToReg 'save changes End If End Select Call SystemManualMessage_Hide Call GUI_Continue Exit Sub End Sub Private Sub GUIXListViewStructToReg() 'on error Resume Next 'reset Call Rmod.RegDeleteSubKey(RegMainKey, RegRootKey + "GUIXListViewStruct\") Call Rmod.RegCreateSubKey(RegMainKey, RegRootKey + "GUIXListViewStruct\") 'begin Call Rmod.RegSetKeyValue(RegMainKey, RegRootKey + "GUIXListViewStruct\", "sort item type old", CVar(GUIXListViewStructVar.SortItemTypeOld), REG_SZ) End Sub Private Sub GUIXListViewStructFromReg() 'on error Resume Next Dim Temp As Long 'begin Rmod.RegGetKeyValueErrorFlag = False 'reset Temp = Val(Rmod.RegGetKeyValue(RegMainKey, RegRootKey + "GUIXListViewStruct\", "sort item type old")) If Rmod.RegGetKeyValueErrorFlag = False Then 'verify Select Case Temp 'verify Case CONST_SONGNAME To CONST_COMMENT GUIXListViewStructVar.SortItemTypeOld = Temp Case Else GUIXListViewStructVar.SortItemTypeOld = CONST_SONGNAME End Select Else GUIXListViewStructVar.SortItemTypeOld = CONST_SONGNAME End If End Sub '********************************END OF GUIXLISTVIEW*********************************** '**********************************GUIXPROGRESSLABEL*********************************** 'NOTE: The GUIXProgressLabel is a label that displays messages when a 'larger process is running the user must interrupt to continue with any other 'action. The GUICProcessLabel has no fixed position but can be automatically 'positioned over or below an other control (i.e. GUIXProgressBarPicture). 'The label has to be reset and positioned through GUIPalette_BeforeChange(). 'Only the functions on lowest level (containing loop) should set the progress 'label text. Private Sub GUIXProgressLabel_Move(ByRef NeightbourControl As Object, ByVal TopOrBottomFlag As Boolean) 'on error Resume Next Select Case TopOrBottomFlag Case True GUIXProgressLabel.Top = NeightbourControl.Top - GUIXProgressLabel.Height - 10 * Screen.TwipsPerPixelY