Re: Cobra-matic : Retro Bakelite Phonograph
Second half
Code:
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
Re: Cobra-matic : Retro Bakelite Phonograph
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.
Code:
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
'--------------------------------------------------------------------------------
Re: Cobra-matic : Retro Bakelite Phonograph
Second half of the form minimizing code
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
Re: Cobra-matic : Retro Bakelite Phonograph
Wow :eek: Mach, that is one hell of a beautiful mod 10/10 have a rep from me :banana:.
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 :).
Re: Cobra-matic : Retro Bakelite Phonograph
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.
Re: Cobra-matic : Retro Bakelite Phonograph
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 :D
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 :D
Thanks
Re: Cobra-matic : Retro Bakelite Phonograph
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
Re: Cobra-matic : Retro Bakelite Phonograph
Thanks Mach :D
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 :D
Thanks again anyway :)
Re: Cobra-matic : Retro Bakelite Phonograph
Re: Cobra-matic : Retro Bakelite Phonograph
Quote:
Originally Posted by
DonT-FeaR
looking good!
:think:
?
