Cobra-matic : Retro Bakelite Phonograph

[Mach]

Second half

Declare Sub CopyStructFromPtr Lib "kernel32" _
               Alias "RtlMoveMemory" _
               (struct As Any, _
               ByVal ptr As Long, ByVal cb As Long)
               
Declare Sub CopyPtrFromStruct Lib "kernel32" _
               Alias "RtlMoveMemory" _
               (ByVal ptr As Long, _
               struct As Any, _
               ByVal cb As Long)
               
Declare Function GlobalAlloc Lib "kernel32" _
               (ByVal wFlags As Long, _
               ByVal dwBytes As Long) As Long
               
Declare Function GlobalLock Lib "kernel32" _
               (ByVal hmem As Long) As Long
               
Declare Function GlobalFree Lib "kernel32" _
               (ByVal hmem As Long) As Long

Dim rc As Long

' variables for managing wave file
Public formatA As waveFormat
Dim hmmioOut As Long
Dim mmckinfoParentIn As MMCKINFO
Dim mmckinfoSubchunkIn As MMCKINFO
Dim bufferIn As Long
Dim hmem As Long
Public numSamples As Long
Public drawFrom As Long
Public drawTo As Long
Public fFileLoaded As Boolean

Type waveFormat
   wFormatTag As Integer
   nChannels As Integer
   nSamplesPerSec As Long
   nAvgBytesPerSec As Long
   nBlockAlign As Integer
   wBitsPerSample As Integer
   cbSize As Integer
End Type

Type mmioinfo
   dwFlags As Long
   fccIOProc As Long
   pIOProc As Long
   wErrorRet As Long
   htask As Long
   cchBuffer As Long
   pchBuffer As String
   pchNext As String
   pchEndRead As String
   pchEndWrite As String
   lBufOffset As Long
   lDiskOffset As Long
   adwInfo(4) As Long
   dwReserved1 As Long
   dwReserved2 As Long
   hmmio As Long
End Type

Type MMCKINFO
    ckid As Long
    ckSize As Long
    fccType As Long
    dwDataOffset As Long
    dwFlags As Long
End Type

Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersionl As Integer ' e.g. = &h0000 = 0
    dwStrucVersionh As Integer ' e.g. = &h0042 = .42
    dwFileVersionMSl As Integer ' e.g. = &h0003 = 3
    dwFileVersionMSh As Integer ' e.g. = &h0075 = .75
    dwFileVersionLSl As Integer ' e.g. = &h0000 = 0
    dwFileVersionLSh As Integer ' e.g. = &h0031 = .31
    dwProductVersionMSl As Integer ' e.g. = &h0003 = 3
    dwProductVersionMSh As Integer ' e.g. = &h0010 = .1
    dwProductVersionLSl As Integer ' e.g. = &h0000 = 0
    dwProductVersionLSh As Integer ' e.g. = &h0031 = .31
    dwFileFlagsMask As Long ' = &h3F For version "0.42"
    dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
    dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
    dwFileType As Long ' e.g. VFT_DRIVER
    dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
    dwFileDateMS As Long ' e.g. 0
    dwFileDateLS As Long ' e.g. 0
    End Type

Function GetMixerControl(ByVal hmixer As Long, _
                        ByVal componentType As Long, _
                        ByVal ctrlType As Long, _
                        ByRef mxc As MIXERCONTROL) As Boolean
                        
' This function attempts to obtain a mixer control. Returns True if successful.
   Dim mxlc As MIXERLINECONTROLS
   Dim mxl As MIXERLINE
   Dim hmem As Long
   Dim rc As Long
       
   mxl.cbStruct = Len(mxl)
   mxl.dwComponentType = componentType
   ' Obtain a line corresponding to the component type
   rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
   If (MMSYSERR_NOERROR = rc) Then
       mxlc.cbStruct = Len(mxlc)
       mxlc.dwLineID = mxl.dwLineID
       mxlc.dwControl = ctrlType
       mxlc.cControls = 1
       mxlc.cbmxctrl = Len(mxc)
       ' Allocate a buffer for the control
       hmem = GlobalAlloc(&H40, Len(mxc))
       mxlc.pamxctrl = GlobalLock(hmem)
       mxc.cbStruct = Len(mxc)
       ' Get the control
       rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
       If (MMSYSERR_NOERROR = rc) Then
           GetMixerControl = True
           ' Copy the control into the destination structure
           CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
       Else
           GetMixerControl = False
       End If
       GlobalFree (hmem)
       Exit Function
   End If
   GetMixerControl = False
End Function

Function SetVolumeControl(ByVal hmixer As Long, mxc As MIXERCONTROL, ByVal volume As Long) As Boolean
  Dim mxcd As MIXERCONTROLDETAILS
   Dim vol As MIXERCONTROLDETAILS_UNSIGNED
   mxcd.cbStruct = Len(mxcd)
   mxcd.dwControlID = mxc.dwControlID
   mxcd.cChannels = 1
   mxcd.item = 0
   mxcd.cbDetails = Len(vol)
   hmem = GlobalAlloc(&H40, Len(vol))
   mxcd.paDetails = GlobalLock(hmem)
   vol.dwValue = volume
   ' Copy the data into the control value buffer
   CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
   rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
   GlobalFree (hmem)
   If (MMSYSERR_NOERROR = rc) Then
       SetVolumeControl = True
   Else
       SetVolumeControl = False
   End If
End Function

Function SetPANControl(ByVal hmixer As Long, mxc As MIXERCONTROL, ByVal volL As Long, ByVal volR As Long) As Boolean
'This function sets the value for a volume control. Returns True if successful
   Dim mxcd As MIXERCONTROLDETAILS
   Dim vol(1) As MIXERCONTROLDETAILS_UNSIGNED
   mxcd.item = mxc.cMultipleItems
   mxcd.dwControlID = mxc.dwControlID
   mxcd.cbStruct = Len(mxcd)
   mxcd.cbDetails = Len(vol(1))
   ' Allocate a buffer for the control value buffer
   mxcd.cChannels = 2
   hmem = GlobalAlloc(&H40, Len(vol(1)))
   mxcd.paDetails = GlobalLock(hmem)
   vol(1).dwValue = volR
   vol(0).dwValue = volL
   ' Copy the data into the control value buffer
   CopyPtrFromStruct mxcd.paDetails, vol(1).dwValue, Len(vol(0)) * mxcd.cChannels
   CopyPtrFromStruct mxcd.paDetails, vol(0).dwValue, Len(vol(1)) * mxcd.cChannels
   ' Set the control value
   rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
   GlobalFree (hmem)
   If (MMSYSERR_NOERROR = rc) Then
       SetPANControl = True
   Else
       SetPANControl = False
   End If
   
End Function
Function GetVolumeControlValue(ByVal hmixer As Long, mxc As MIXERCONTROL) As Long
'This function Gets the value for a volume control. Returns True if successful
    Dim mxcd As MIXERCONTROLDETAILS
    Dim vol As MIXERCONTROLDETAILS_UNSIGNED
    mxcd.cbStruct = Len(mxcd)
    mxcd.dwControlID = mxc.dwControlID
    mxcd.cChannels = 1
    mxcd.item = 0
    mxcd.cbDetails = Len(vol)
    mxcd.paDetails = 0
    hmem = GlobalAlloc(&H40, Len(vol))
    mxcd.paDetails = GlobalLock(hmem)
    rc = mixerGetControlDetails(hmixer, mxcd, MIXER_GETCONTROLDETAILSF_VALUE)
    CopyStructFromPtr vol, mxcd.paDetails, Len(vol)
    GlobalFree (hmem)
    If (MMSYSERR_NOERROR = rc) Then
       GetVolumeControlValue = vol.dwValue
    Else
        GetVolumeControlValue = -1
    End If
End Function

Function GetMuteControl(ByVal hmixer As Long, mxc As MIXERCONTROL) As Boolean
   Dim mxcd As MIXERCONTROLDETAILS
   Dim vol As MIXERCONTROLDETAILS_UNSIGNED
   mxcd.cbStruct = Len(mxcd)
   mxcd.dwControlID = mxc.dwControlID
   mxcd.cChannels = 1
   mxcd.item = 0
   mxcd.cbDetails = Len(vol)
   hmem = GlobalAlloc(&H40, Len(vol))
   mxcd.paDetails = GlobalLock(hmem)
   rc = mixerGetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
   CopyStructFromPtr vol, mxcd.paDetails, Len(vol)
   GlobalFree (hmem)
   If (MMSYSERR_NOERROR = rc) Then
       GetMuteControl = vol.dwValue
   Else
       GetMuteControl = False
   End If
End Function

Function SetMuteControl(ByVal hmixer As Long, mxc As MIXERCONTROL, mute As Boolean) As Boolean
   Dim mxcd As MIXERCONTROLDETAILS
   Dim vol As MIXERCONTROLDETAILS_UNSIGNED
   mxcd.cbStruct = Len(mxcd)
   mxcd.dwControlID = mxc.dwControlID
   mxcd.cChannels = 1
   mxcd.item = 0
   mxcd.cbDetails = Len(vol)
   hmem = GlobalAlloc(&H40, Len(vol))
   mxcd.paDetails = GlobalLock(hmem)
   vol.dwValue = volume
   CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
   rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
   GlobalFree (hmem)
   If (MMSYSERR_NOERROR = rc) Then
       SetMuteControl = True
   Else
       SetMuteControl = False
   End If
End Function


Function unSetMuteControl(ByVal hmixer As Long, mxc As MIXERCONTROL, ByVal unmute As Long) As Boolean
   Dim mxcd As MIXERCONTROLDETAILS
   Dim vol As MIXERCONTROLDETAILS_UNSIGNED
   mxcd.cbStruct = Len(mxcd)
   mxcd.dwControlID = mxc.dwControlID
   mxcd.cChannels = 1
   mxcd.item = 0
   mxcd.cbDetails = Len(vol)
   hmem = GlobalAlloc(&H40, Len(vol))
   mxcd.paDetails = GlobalLock(hmem)
   vol.dwValue = unmute
   CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
   rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
   GlobalFree (hmem)
   If (MMSYSERR_NOERROR = rc) Then
       unSetMuteControl = True
   Else
       unSetMuteControl = False
   End If
End Function

[Mach]

Here's the module that minimizes the form to the task tray. Not sure where I picked up this code from. If it's yours, let me know and I'll give you credit.

Option Explicit

Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lpBuffer As Any, nVerSize As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Long
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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef r_Destination As Any, ByRef r_Source As Any, ByVal v_Length As Long)

'A GUID is a 128-bit value consisting of one group of 8 hexadecimal digits, followed
'by three groups of 4 hexadecimal digits each, followed by one group of 12 hexadecimal
'digits. (Example: 6B29FC40-CA47-1067-B31D-00DD010662DA)
Private Type GUID
 Data1 As Long 'Specifies the first 8 hexadecimal digits of the GUID.
 Data2 As Integer 'Specifies the first group of 4 hexadecimal digits.
 Data3 As Integer 'Specifies the second group of 4 hexadecimal digits.
 Data4(7) As Byte 'First 2 bytes: 3rd group of digits. Next 6 bytes: last 12 digits.
End Type

'Contains information that the system needs to process taskbar status area messages
Private Type NOTIFYICONDATA
 'The size of this structure, in bytes.
 cbSize As Long
 
 'A handle to the window that receives notification messages associated with an icon
 'in the taskbar status area. The Shell uses hWnd together with uID to identify which
 'icon to operate on when Shell_NotifyIcon is invoked. If guidItem is specified, hWnd
 'is not required.
 hwnd As Long
 
 'The application-defined identifier of the taskbar icon. The Shell uses either hWnd
 'plus uID or guidItem to identify which icon to operate on when Shell_NotifyIcon is
 'invoked. You can have multiple icons associated with a single hWnd by assigning each
 'a different uID. If guidItem is specified, uID is ignored.
 uID As Long
 
 'Flags that either indicate which of the other members contain valid data or
 'provide additional information to the ToolTip as to how it should display.
 'If you set the NIF_INFO flag, the standard ToolTip is replaced by a balloon ToolTip.
 'NIF_MESSAGE  The uCallbackMessage member is valid.
 'NIF_ICON     The hIcon member is valid.
 'NIF_TIP      The szTip member is valid.
 'NIF_STATE    The dwState and dwStateMask members are valid. (Windows 2000 and later)
 'NIF_INFO     The szInfo, uTimeout, szInfoTitle, and dwInfoFlags members are valid. (Windows 2000 and later)
 'NIF_GUID     Reserved. (Windows XP and later)
 'NIF_REALTIME If the ToolTip cannot be displayed immediately, discard it. (Windows Vista and later)
 'NIF_SHOWTIP  Use the standard ToolTip (Windows Vista and later)
 uFlags As Long
 
 'An application-defined message identifier. The system uses this identifier to send
 'notifications to the window identified in hWnd. These notifications are sent when
 'a mouse event occurs in the bounding rectangle of the icon, or when the icon is
 'selected or activated with the keyboard.
 '
 'When the uVersion member is either 0 or NOTIFYICON_VERSION, the wParam parameter of
 'the message contains the identifier of the taskbar icon in which the event occurred.
 'This identifier can be 32-bits in length. The lParam parameter holds the mouse or
 'keyboard message associated with the event. For example, when the pointer moves over
 'a taskbar icon, lParam is set to WM_MOUSEMOVE.
 '
 'When the uVersion member is NOTIFYICON_VERSION_4, applications continue to receive
 'notification events in the form of application-defined messages through the
 'uCallbackMessage member, but the interpretation of the lParam and wParam parameters
 'of that message is changed as follows:
 '
 'LOWORD(lParam) contains notification events, such as NIN_BALLOONSHOW, NIN_POPUPOPEN,
 'or WM_CONTEXTMENU.
 '
 'HIWORD(lParam) contains the icon ID. Icon IDs are restricted to a length of 16 bits.
 '
 'GET_X_LPARAM(wParam) returns the X anchor coordinate for notification events
 'NIN_POPUPOPEN, NIN_SELECT, NIN_KEYSELECT, and all mouse messages between WM_MOUSEFIRST
 'and WM_MOUSELAST. If any of those messages are generated by the keyboard, wParam is
 'set to the upper-left corner of the target icon. For all other messages, wParam is
 'undefined.
 '
 'GET_Y_LPARAM(wParam) returns the Y anchor coordinate for notification events and
 'messages as defined for the X anchor.
 uCallbackMessage As Long
 
 'A handle to the icon to be added, modified, or deleted. To avoid icon distortion,
 'be aware that notification area icons have different levels of support under
 'different versions of Microsoft Windows. Windows 95, Windows 98, and Microsoft
 'Windows NT 4.0 support icons of up to 4 bits per pixel (BPP). Windows Millennium
 'Edition (Windows Me) and Windows 2000 support icons of a color depth up to the
 'current display mode. Windows XP supports icons of up to 32 BPP.
 '
 'If only a 16x16 pixel icon is provided, it is scaled to a larger size in a system
 'set to a high dots per inch (dpi). This can lead to an unattractive result. It is
 'recommended that you provide both a 16x16 pixel icon and a larger icon in your
 'resource file. Use LoadIconMetric to ensure that the correct icon is loaded and
 'scaled appropriately.
 hIcon As Long
 
 'A null-terminated string that specifies the text for a standard ToolTip.
 'It can have a maximum of 64 characters, including the terminating null character.
 'For Windows 2000 (Shell32.dll version 5.0) and later, szTip can have a maximum of
 '128 characters, including the terminating null character.
 szTip As String * 128
 
 'The state of the icon. There are two flags that can be set independently: NIS_HIDDEN and NIS_SHAREDICON
 'Windows 2000 (Shell32.dll version 5.0) and later.
 dwState As Long
 
 'A value that specifies which bits of the dwState member are retrieved or modified.
 'The possible values are the same as those for dwState. For example, setting this
 'member to NIS_HIDDEN causes only the item's hidden state to be retrieved while the
 'icon sharing bit is ignored regardless of its value.
 'Windows 2000 (Shell32.dll version 5.0) and later.
 dwStateMask As Long
 
 'A null-terminated string that specifies the text for a balloon ToolTip. It can have
 'a maximum of 256 characters, including the terminating null character. To remove
 'the ToolTip, set the NIF_INFO flag in uFlags and set szInfo to an empty string.
 'Windows 2000 (Shell32.dll version 5.0) and later.
 szInfo As String * 256
 
 'uTimeout
 'This member is deprecated as of Windows Vista.
 'Notification display times are now based on system settings.
 '
 'Union with uVersion. The timeout value, in milliseconds, for a balloon ToolTip.
 'The system enforces minimum and maximum timeout values. Values specified in uTimeout
 'that are too large are set to the maximum value. Values that are too small default
 'to the minimum value. The system minimum and maximum timeout values are currently
 'set at 10 seconds and 30 seconds, respectively.
 '
 'uVersion
 'Windows 2000 (Shell32.dll version 5.0) and later. Union with uTimeout. Specifies
 'whether the Shell notify icon interface should use Windows 95 or Windows 2000
 'behavior. For more information on the differences in these two behaviors, see
 'Shell_NotifyIcon. This member is only employed when using Shell_NotifyIcon to send
 'a NIM_SETVERSION message.
 '
 '0 = Use the Windows 95 behavior. Use this value for applications designed for Windows versions prior to Windows 2000.
 'NOTIFYICON_VERSION = Use the Windows 2000 behavior. Use this value for applications designed for Windows 2000 and later.
 'NOTIFYICON_VERSION_4 = Use the Windows Vista behavior. Use this value for applications designed for Windows Vista and later.
 uTimeoutAndVersion As Long
 
 'A null-terminated string that specifies a title for a balloon ToolTip. This title
 'appears in a bold type above the text. It can have a maximum of 64 characters.
 'Windows 2000 (Shell32.dll version 5.0) and later.
 szInfoTitle As String * 64
 
 'Flags that can be set to add an icon to a balloon ToolTip. It is placed to the left
 'of the title. If the szInfoTitle member is zero-length, the icon is not shown.
 'Windows 2000 (Shell32.dll version 5.0) and later.
 dwInfoFlags As Long
 
 'Windows 7 and later: A registered GUID that identifies the icon. This value
 'overrides uID and is the recommended method of identifying the icon.
 'Windows XP through Windows Vista: Reserved.
 'Windows XP (Shell32.dll version 6.0) and later.
 guidItem As GUID
 
 'The handle of a customized balloon icon provided by the application that should be
 'used independently of the tray icon. If this member is non-NULL and the NIIF_USER
 'flag is set in the dwInfoFlags member, this icon is used as the balloon icon. If
 'this member is NULL, the legacy behavior is carried out.
 'Windows Vista (Shell32.dll version 6.0.6) and later.
 'hBalloonIcon As Long
 
End Type

Private Const NOTIFYICONDATA_V1_SIZE As Long = 88  'pre-5.0 structure size
Private Const NOTIFYICONDATA_V2_SIZE As Long = 488 'pre-6.0 structure size
Private Const NOTIFYICONDATA_V3_SIZE As Long = 504 '6.0+ structure size

'--------------------------------------------------------------------------------
'NOTIFICATION ICON FLAGS (NIF) (used in uFlags)
'--------------------------------------------------------------------------------
Private Const NIF_MESSAGE As Long = &H1 'The uCallbackMessage member is valid.
Private Const NIF_ICON As Long = &H2 'The hIcon member is valid.
Private Const NIF_TIP As Long = &H4 'The szTip member is valid.

'The dwState and dwStateMask members are valid.
'Windows 2000 and later (Shell32.dll version 5.0)
Private Const NIF_STATE As Long = &H8

'Use a balloon ToolTip instead of a standard ToolTip.
'The szInfo, uTimeout, szInfoTitle, and dwInfoFlags members are valid.
'Windows 2000 and later (Shell32.dll version 5.0)
Private Const NIF_INFO As Long = &H10

'Reserved.
'Windows XP and later (Shell32.dll version 6.0)
Private Const NIF_GUID As Long = &H20

'If the ToolTip cannot be displayed immediately, discard it. Use this flag for
'ToolTips that represent real-time information which would be meaningless or
'misleading if displayed at a later time. For example, a message that states
'"Your telephone is ringing." NIF_REALTIME modifies and must be combined with
'the NIF_INFO flag.
'Windows Vista and later (Shell32.dll version 6.0.6)
Private Const NIF_REALTIME As Long = &H40

'Use the standard ToolTip. Normally, when uVersion is set to NOTIFYICON_VERSION_4,
'the standard ToolTip is replaced by the application-drawn pop-up user interface (UI).
'If the application wants to show the standard tooltip in that case, regardless of
'whether the on-hover UI is showing, it can specify NIF_SHOWTIP to indicate the
'standard tooltip should still be shown. Note that the NIF_SHOWTIP flag is effective
'until the next call to Shell_NotifyIcon.
'Windows Vista and later (Shell32.dll version 6.0.6)
Private Const NIF_SHOWTIP As Long = &H80
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'NOTIFICATION ICON STATES (NIS) (used in dwState and dwStateMask)
'--------------------------------------------------------------------------------
Private Const NIS_HIDDEN As Long = &H1 'The icon is hidden.
Private Const NIS_SHAREDICON As Long = &H2 'The icon is shared.
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'NOTIFICATION ICON INFO FLAGS (NIIF) (used in dwInfoFlags)
'--------------------------------------------------------------------------------
Private Const NIIF_NONE As Long = &H0 'No icon.
Private Const NIIF_INFO As Long = &H1 'An information icon.
Private Const NIIF_WARNING As Long = &H2 'A warning icon.
Private Const NIIF_ERROR As Long = &H3 'An error icon.

'Use the icon identified in hIcon as the notification balloon's title icon.
'Windows XP Service Pack 2 (SP2) and later.
Private Const NIIF_USER As Long = &H4

'Do not play the associated sound. Applies only to balloon ToolTips.
'Windows XP (Shell32.dll version 6.0) and later.
Private Const NIIF_NOSOUND As Long = &H10

'The large version of the icon should be used as the balloon icon. This corresponds
'to the icon with dimensions SM_CXICON x SM_CYICON. If this flag is not set, the
'icon with dimensions XM_CXSMICON x SM_CYSMICON is used.
'
'This flag can be used with all stock icons.
'
'Applications that use older customized icons (NIIF_USER with hIcon) must provide
'a new SM_CXICON x SM_CYICON version in the tray icon (hIcon). These icons are
'scaled down when they are displayed in the System Tray or System Control Area (SCA).
'
'New customized icons (NIIF_USER with hBalloonIcon) must supply an SM_CXICON x
'SM_CYICON version in the supplied icon (hBalloonIcon).
'
'Windows Vista (Shell32.dll version 6.0.6) and later.
Private Const NIIF_LARGE_ICON As Long = &H10

Private Const NIIF_RESPECT_QUIET_TIME As Long = &H80 'Windows 7 and later.
Private Const NIIF_ICON_MASK As Long = &HF 'Reserved. Windows XP (Shell32.dll version 6.0) and later.
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'NOTIFICATION ICON VERSIONS (used in uVersion)
'--------------------------------------------------------------------------------
Private Const NOTIFYICON_VERSION_0 As Long = &H0 'Use Windows 95 behavior
Private Const NOTIFYICON_VERSION As Long = &H3 'Use Windows 2000 behavior
Private Const NOTIFYICON_VERSION_3 As Long = NOTIFYICON_VERSION 'Alias of NOTIFYICON_VERSION
Private Const NOTIFYICON_VERSION_4 As Long = &H4 'Use Windows Vista behavior
'--------------------------------------------------------------------------------

[Mach]

Second half of the form minimizing code

'--------------------------------------------------------------------------------
'NOTIFICATION ICON MESSAGES (used as dwMessage in Shell_NotifyIcon)
'Shell_NotifyIcon(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Long
'--------------------------------------------------------------------------------
'Adds an icon to the status area. The hWnd and uID members of the NOTIFYICONDATA
'structure will be used to identify the icon in later calls to Shell_NotifyIcon.
Private Const NIM_ADD As Long = &H0

'Modifies an icon in the status area. Uses the hWnd and uID members of the
'NOTIFYICONDATA structure to identify the icon to be modified.
Private Const NIM_MODIFY As Long = &H1

'Deletes an icon from the status area. Uses the hWnd and uID members of the
'NOTIFYICONDATA structure to identify the icon to be deleted.
Private Const NIM_DELETE As Long = &H2

'Returns focus to the taskbar notification area. Taskbar icons should use this
'message when they have completed their user interface operation. For example, if
'the taskbar icon displays a shortcut menu, but the user presses ESC to cancel it,
'use NIM_SETFOCUS to return focus to the taskbar notification area.
'Shell32.dll version 5.0 and later only.
Private Const NIM_SETFOCUS As Long = &H3

'Instructs the taskbar to behave according to the version number specified in the
'uVersion member of the structure pointed to by lpdata. This message allows you to
'specify whether you want the version 5.0 behavior found on Microsoft Windows 2000
'systems, or the behavior found on earlier Shell versions. The default value for
'uVersion is 0, indicating that the original Windows 95 notify icon behavior should
'be used. Shell_NotifyIcon returns TRUE if the version was successfully changed,
'or FALSE if the requested version is not supported.
'Shell32.dll version 5.0 and later only.
Private Const NIM_SETVERSION As Long = &H4
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'WINDOW MESSAGES
'--------------------------------------------------------------------------------
Private Const WM_MOUSEFIRST As Long = &H200
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_LBUTTONDBLCLK As Long = &H203
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_RBUTTONDBLCLK As Long = &H206
Private Const WM_MBUTTONDOWN As Long = &H207
Private Const WM_MBUTTONUP As Long = &H208
Private Const WM_MBUTTONDBLCLK As Long = &H209
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WM_XBUTTONDOWN As Long = &H20B 'for windows 2000 and up
Private Const WM_XBUTTONUP As Long = &H20C 'for windows 2000 and up
Private Const WM_XBUTTONDBLCLK As Long = &H20D 'for windows 2000 and up
Private Const WM_MOUSELAST As Long = &H209 'for windows 2000 and up
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'WINDOW FIELD OFFSETS (used as nIndex in GetWindowLong)
'GetWindowLong(ByVal hwnd As Long, ByVal nIndex As Long) As Long
'--------------------------------------------------------------------------------
Private Const GWL_EXSTYLE As Long = (-20) 'Retrieves the extended window styles.
Private Const GWL_STYLE As Long = (-16) 'Retrieves the window styles.
Private Const GWL_WNDPROC As Long = (-4) 'Retrieves the address of the window procedure, or a handle representing the address of the window procedure. You must use the CallWindowProc function to call the window procedure.
Private Const GWL_HINSTANCE As Long = (-6) 'Retrieves a handle to the application instance.
Private Const GWL_HWNDPARENT As Long = (-8) 'Retrieves a handle to the parent window, if any.
Private Const GWL_ID As Long = (-12) 'Retrieves the identifier of the window.
Private Const GWL_USERDATA As Long = (-21) 'Retrieves the user data associated with the window. This data is intended for use by the application that created the window. Its value is initially zero.
'for Dialog Box hwnd's only
Private Const DWL_DLGPROC As Long = 4 'Retrieves the address of the dialog box procedure, or a handle representing the address of the dialog box procedure. You must use the CallWindowProc function to call the dialog box procedure.
Private Const DWL_MSGRESULT As Long = 0 'Retrieves the return value of a message processed in the dialog box procedure.
Private Const DWL_USER As Long = 8 'Retrieves extra information private to the application, such as handles or pointers.
'--------------------------------------------------------------------------------

Private nid As NOTIFYICONDATA
Private NOTIFYICONDATA_SIZE As Long
Private systray_old_window_procedure As Long

Private form_left_pos As Long
Private form_top_pos As Long
Private form_width As Long
Private form_height As Long
Private form_state As Integer
Private systray_form As Form



Public Function add_system_tray_icon(ByRef frm As Form) As Long
 Set systray_form = frm

 'set up system tray icon
 If NOTIFYICONDATA_SIZE = 0 Then
  If (IsShellVersion(6) = True) Then
   NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V3_SIZE '6.0 structure size
  ElseIf (IsShellVersion(5) = True) Then
   NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V2_SIZE 'pre-6.0 structure size
  Else
   NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V1_SIZE 'pre-5.0 structure size
  End If
 End If
 nid.cbSize = NOTIFYICONDATA_SIZE 'size of the NID type
 nid.hwnd = systray_form.hwnd 'Handle of the window to receive notification messages
 nid.uID = 0 'Application-defined identifier of the taskbar icon
 nid.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP 'Flags indicating which of the other structure members contain valid data
 nid.hIcon = systray_form.Icon 'Handle of the taskbar icon to add, modify, or delete
 nid.szTip = systray_form.Caption & vbNullChar 'tooltip text (If NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V1_SIZE then max size = 64 else max size = 128)
 nid.uCallbackMessage = 1024 'Custom message sent whenever the mouse acts on the systray icon

 'add the system tray icon
 add_system_tray_icon = Shell_NotifyIcon(NIM_ADD, nid)
 
 'subclass the form
 If (systray_form.hwnd <> 0) Then
  systray_old_window_procedure = SetWindowLong(systray_form.hwnd, GWL_WNDPROC, AddressOf systray_new_window_procedure)
 End If
End Function

Public Sub remove_system_tray_icon()
 'un-subclass
 If (systray_old_window_procedure <> 0) And (systray_form.hwnd <> 0) Then
  SetWindowLong systray_form.hwnd, GWL_WNDPROC, systray_old_window_procedure
  systray_old_window_procedure = 0
 End If
 
 'remove the system tray icon
 Call Shell_NotifyIcon(NIM_DELETE, nid)
End Sub

Public Sub set_system_tray_tooltip(text As String)
 nid.cbSize = Len(nid)
 nid.szTip = text & vbNullChar
 Call Shell_NotifyIcon(NIM_MODIFY, nid)
End Sub

Public Sub set_system_tray_icon(IconHandle As Long)
 nid.cbSize = Len(nid)
 nid.hIcon = IconHandle
 Call Shell_NotifyIcon(NIM_MODIFY, nid)
End Sub

Private Function systray_new_window_procedure(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 On Error Resume Next
 Select Case hwnd
  Case systray_form.hwnd
   Select Case uMsg
    Case nid.uCallbackMessage
     'uncomment the messages you use below and add your code
     Select Case lParam
      'Case WM_RBUTTONDBLCLK
      'Case WM_RBUTTONDOWN
      Case WM_RBUTTONUP
         'SetForegroundWindow (Me.hwnd)
         'Me.PopupMenu mnuMyMenu

      'Case WM_LBUTTONDBLCLK
      'Case WM_LBUTTONDOWN
      Case WM_LBUTTONUP
       If systray_form.WindowState = vbMinimized Then
        LoadFormPosition
       Else
        SaveFormPosition systray_form.Left, systray_form.Top, systray_form.Height, systray_form.Width, systray_form.WindowState
        systray_form.WindowState = vbMinimized
        systray_form.Hide
       End If
       
     End Select
     systray_new_window_procedure = 0
    Case Else
     systray_new_window_procedure = CallWindowProc(systray_old_window_procedure, hwnd, uMsg, wParam, lParam)
   End Select 'End Select Case uMsg
  Case Else
   systray_new_window_procedure = CallWindowProc(systray_old_window_procedure, hwnd, uMsg, wParam, lParam)
 End Select 'End Select Case hWnd
End Function

Public Sub SaveFormPosition(left1 As Long, top1 As Long, height1 As Long, width1 As Long, window_state1 As Integer)
 form_state = window_state1
 'only save the form's coordinates if it's not minimized
 If window_state1 <> vbMinimized Then
  form_left_pos = left1
  form_top_pos = top1
  form_height = height1
  form_width = width1
 End If
End Sub

Public Sub LoadFormPosition()
 If Not systray_form Is Nothing Then
  If form_state = vbMaximized Then
   systray_form.WindowState = vbMaximized
   systray_form.Show
  ElseIf form_state = vbMinimized Then
   systray_form.WindowState = vbMinimized
  Else
   systray_form.WindowState = vbNormal
   systray_form.Show
   systray_form.Left = form_left_pos
   systray_form.Top = form_top_pos
   systray_form.Height = form_height
   systray_form.Width = form_width
  End If
 End If
End Sub



Private Function IsShellVersion(ByVal version As Long) As Boolean
 'returns True if the Shell version (shell32.dll) is equal or later than 'version'
 Dim nBufferSize As Long
 Dim nUnused As Long
 Dim lpBuffer As Long
 Dim nVerMajor As Integer
 Dim bBuffer() As Byte
 Const sDLLFile As String = "shell32.dll"
 nBufferSize = GetFileVersionInfoSize(sDLLFile, nUnused)
 If nBufferSize > 0 Then
  ReDim bBuffer(nBufferSize - 1) As Byte
  Call GetFileVersionInfo(sDLLFile, 0&, nBufferSize, bBuffer(0))
  If VerQueryValue(bBuffer(0), "\", lpBuffer, nUnused) = 1 Then
   CopyMemory nVerMajor, ByVal lpBuffer + 10, 2
   IsShellVersion = nVerMajor >= version
  End If  'VerQueryValue
 End If  'nBufferSize
End Function

[Waynio]

Wow Mach, that is one hell of a beautiful mod 10/10 have a rep from me .

My mods are so plain & average boxes lol, hopefully thou some day I'll make a great looking one, so much to learn before that day comes thou .

[Mach]

Thanks Waynio. It just takes time and persistence. This mod took me over a year and half, mostly because I didn't know much to begin with. Over that time, I learned how to:

• solder
• remove & crimp molex pins
• wire circuits & glow wire
• etch copper
• work with styrene
• polish bakelite
• use waterslide labels
• airbrush
• laser cut metal
• window a CD
• apply TIM

Plan, ask questions, google, and be willing to break alot. It just takes time I'm sure you'll mod something that'll blow this out of the water.

[Yemerich]

Hail Mach!

I came into this log by a fortunate accident from another forum that I am member of. And after seeing the first pages, I felt the urge to become a menber in this comunity too

First I really need to congratulate for your work! Truly a master piece.

Second I wish to say that this wLog must be one of the most instructives (if not THE most instructive) I ever saw.

But something scaped my (limited) eletronics compreension. In the diagram below, the RL1 and RL2 are relays, correct? what are the specifications on them?

Another thing I fail do understand is how this circuit is wired to the DVD drive?

I am considering using this thing in my upcoming mod and I really apreciate any help

Thanks

[Mach]

Welcome to TBCS, Yemerich! Thanks, glad that you like the mod.

No the circuit didn't work. It stayed energized and held the relay open. Worked in simulation tho. 486Hawk did get a circuit working.

I wound up using a phidgets board 8/8/0 and a 0/0/4 to control lights, temperature readings, volume knob (usb knob actually), and drive. I'd use an arduino pro mini with relays if I was to do it over to save space.

Regarding how the circuit was supposed to be hooked, there's 2 buttons/switches that need to be triggered to simulate the tray opening. The first is the front button then followed by the tray open switch at the back of the drive on the controller board. The front button is triggered momentarily and the tray open is held open until close. Upon close, the tray open switch is closed and held. I wired it so the relay was setup with the switch Normally Closed (NC)

The whole thing was then tied into a microswitch on the drive lid that when open would trigger the open sequence above and upon close would trigger the close sequence.

To make this all work, wires were soldered to all the switches and tied into the phidgets boards for control.

I highly recommend Lite-on Sata drive that I linked above for this mod as its 10x easier to solder than the other drives that I encountered

[Yemerich]

Thanks Mach

But I still don't understand. I was lookin into 486Hawk and still didn't get it. I will try to figure that out in that forum

Thanks again anyway

[DonT-FeaR]

looking good!

[nevermind1534]

looking good!

?