Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing frmMain.frm (20.76 KB)
VERSION 5.00
Object = "{001000AF-1DEF-0010-10B6-DC5BA692C858}#1.0#0"; "ahscript.dll"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "x10 JAVA Setup"
ClientHeight = 4830
ClientLeft = 45
ClientTop = 435
ClientWidth = 4935
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMain.frx":0000
MaxButton = 0 'False
ScaleHeight = 4830
ScaleWidth = 4935
StartUpPosition = 2 'CenterScreen
Begin MSComDlg.CommonDialog BrowseDialog
Left = 0
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
DialogTitle = "Browse for Program"
Filter = "Program Files (*.exe;*.com)|*.exe;*.com"
End
Begin VB.CommandButton cmdBrowse
Caption = "..."
Height = 255
Index = 4
Left = 4200
Style = 1 'Graphical
TabIndex = 19
ToolTipText = "Browse..."
Top = 3600
Width = 375
End
Begin VB.TextBox txtPath
Height = 315
Index = 4
Left = 1320
TabIndex = 18
Tag = "WEB Hotkey"
Top = 3600
Width = 2775
End
Begin VB.CommandButton cmdBrowse
Caption = "..."
Height = 255
Index = 3
Left = 4200
Style = 1 'Graphical
TabIndex = 16
ToolTipText = "Browse..."
Top = 3240
Width = 375
End
Begin VB.TextBox txtPath
Height = 315
Index = 3
Left = 1320
TabIndex = 15
Tag = "MUSIC Hotkey"
Top = 3240
Width = 2775
End
Begin VB.CommandButton cmdBrowse
Caption = "..."
Height = 255
Index = 2
Left = 4200
Style = 1 'Graphical
TabIndex = 13
ToolTipText = "Browse..."
Top = 2880
Width = 375
End
Begin VB.TextBox txtPath
Height = 315
Index = 2
Left = 1320
TabIndex = 12
Tag = "PHOTO Hotkey"
Top = 2880
Width = 2775
End
Begin VB.Frame frameHotkeys
Caption = "Hotkeys"
Height = 2295
Left = 120
TabIndex = 4
Top = 1800
Width = 4695
Begin VB.CommandButton cmdBrowse
Caption = "..."
Height = 255
Index = 1
Left = 4080
Style = 1 'Graphical
TabIndex = 10
ToolTipText = "Browse..."
Top = 720
Width = 375
End
Begin VB.TextBox txtPath
Height = 315
Index = 1
Left = 1200
TabIndex = 9
Tag = "DVD Hotkey"
Top = 720
Width = 2775
End
Begin VB.CommandButton cmdBrowse
Caption = "..."
Height = 255
Index = 0
Left = 4080
Style = 1 'Graphical
TabIndex = 7
ToolTipText = "Browse..."
Top = 360
Width = 375
End
Begin VB.TextBox txtPath
Height = 315
Index = 0
Left = 1200
TabIndex = 6
Tag = "DVR Hotkey"
Top = 360
Width = 2775
End
Begin VB.Label lblWEB
Alignment = 1 'Right Justify
Caption = "W&EB:"
Height = 255
Left = 240
TabIndex = 17
Top = 1840
Width = 735
End
Begin VB.Label lblMUSIC
Alignment = 1 'Right Justify
Caption = "M&USIC:"
Height = 255
Left = 240
TabIndex = 14
Top = 1480
Width = 735
End
Begin VB.Label lblPHOTO
Alignment = 1 'Right Justify
Caption = "&PHOTO:"
Height = 255
Left = 240
TabIndex = 11
Top = 1120
Width = 735
End
Begin VB.Label lblDVD
Alignment = 1 'Right Justify
Caption = "D&VD/VCD:"
Height = 255
Left = 240
TabIndex = 8
Top = 760
Width = 735
End
Begin VB.Label lblDVR
Alignment = 1 'Right Justify
Caption = "&DVR:"
Height = 255
Left = 240
TabIndex = 5
Top = 400
Width = 735
End
End
Begin VB.CommandButton cmdCancel
Caption = "&Close"
Height = 375
Left = 3480
TabIndex = 21
Top = 4320
Width = 1335
End
Begin VB.CommandButton cmkOK
Caption = "&OK"
Default = -1 'True
Height = 375
Left = 2040
TabIndex = 20
Top = 4320
Width = 1335
End
Begin VB.Frame frameGeneral
Caption = "General"
Height = 1575
Left = 120
TabIndex = 0
Top = 120
Width = 4695
Begin VB.CheckBox chkStartup
Caption = "&Run on Startup"
Height = 255
Left = 240
TabIndex = 3
Top = 1080
Value = 1 'Checked
Width = 4215
End
Begin VB.CheckBox chkWMP
Caption = "Enable Windows &Media Player Support"
Height = 255
Left = 240
TabIndex = 2
Top = 720
Width = 4215
End
Begin VB.CheckBox chkWinamp
Caption = "Enable &Winamp Support"
Height = 255
Left = 240
TabIndex = 1
Top = 360
Width = 4215
End
End
Begin ActiveHomeScriptLibCtl.ActiveHome objX10
Height = 375
Left = 0
OleObjectBlob = "frmMain.frx":0442
TabIndex = 22
Top = 0
Visible = 0 'False
Width = 1215
End
Begin VB.Menu SystrayMenu
Caption = "Systray Menu"
Visible = 0 'False
Begin VB.Menu OpenMenu
Caption = "&Show"
End
Begin VB.Menu Blank1
Caption = "-"
End
Begin VB.Menu CloseMenu
Caption = "&Close"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const PRESET_BRIGHT = 5, PRESET_DIM = 5
Private Const RegAppRoot = "Software\x10java\"
Private bVolumeInitialized As Boolean
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Public SysTray As New SystrayIcon
Private Sub CloseMenu_Click()
Unload Me
End Sub
Private Sub cmdBrowse_Click(Index As Integer)
On Error GoTo CancelErr
BrowseDialog.FileName = txtPath(Index).Text
BrowseDialog.ShowOpen
With txtPath(Index)
.Text = BrowseDialog.FileName
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
CancelErr:
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmkOK_Click()
Dim i As Integer
SaveRegDWORD HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support", CLng(chkWinamp.Value)
SaveRegDWORD HKEY_LOCAL_MACHINE, RegAppRoot, "WMP Support", CLng(chkWMP.Value)
For i = txtPath.LBound To txtPath.UBound
SaveRegString HKEY_LOCAL_MACHINE, RegAppRoot, txtPath(i).Tag, txtPath(i).Text
Next i
If chkStartup.Value = 1 Then
SaveRegString HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", "x10java", """" + LCase(App.Path + IIf(Right(App.Path, 1) <> "\", "\", "")) + "x10java.exe"" -startup"
Else
DeleteValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", "x10java"
End If
WindowState = vbMinimized
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim lRegData As Long
Dim sRegData As String
Dim bRegErr As Boolean
Dim i As Integer
lRegData = GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support", bRegErr)
If (lRegData <> 0 And lRegData <> 1) Or bRegErr Then lRegData = 1
chkWinamp.Value = lRegData
lRegData = GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "WMP Support", bRegErr)
If (lRegData <> 0 And lRegData <> 1) Or bRegErr Then lRegData = 1
chkWMP.Value = lRegData
For i = txtPath.LBound To txtPath.UBound
CButton cmdBrowse(i)
sRegData = GetRegString(HKEY_LOCAL_MACHINE, RegAppRoot, txtPath(i).Tag, bRegErr)
If bRegErr Then sRegData = ""
txtPath(i).Text = sRegData
Next i
bVolumeInitialized = InitGetVolume()
SysTray.PopUpMessage = "x10java v" & App.Major & "." & App.Minor & _
IIf(App.Revision = 0, "", "." & App.Revision)
SysTray.Initialize hWnd, Icon, SysTray.PopUpMessage
SysTray.ShowIcon
If LCase(Command) = "-startup" Then WindowState = vbMinimized
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msgCallBackMessage As Long
msgCallBackMessage = X / Screen.TwipsPerPixelX
Select Case msgCallBackMessage
Case WM_MOUSEMOVE
SysTray.TipText = SysTray.PopUpMessage
Case WM_LBUTTONDBLCLK
If OpenMenu.Enabled = False Then Exit Sub
AlwaysOnTop Me, True
Visible = True
AlwaysOnTop Me, False
OpenMenu.Caption = "&Hide"
Case WM_RBUTTONDOWN
If OpenMenu.Enabled = False Then Exit Sub
If Visible = False Then OpenMenu.Caption = "&Show"
If Visible = True Then OpenMenu.Caption = "&Hide"
PopupMenu SystrayMenu, , , , OpenMenu
End Select
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Or UnloadMode = 3 Then
WindowState = vbMinimized
Cancel = True
End If
End Sub
Private Sub Form_Resize()
If WindowState = vbMinimized Then
Visible = False
WindowState = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
SysTray.HideIcon
End Sub
Private Sub objX10_RecvAction(ByVal bszAction As Variant, ByVal bszParm1 As Variant, _
ByVal bszParm2 As Variant, ByVal bszParm3 As Variant, ByVal bszParm4 As Variant, _
ByVal bszParm5 As Variant, ByVal bszReserved As Variant)
On Error Resume Next
Dim VolValue As Long
If bszParm1 <> vbNullString And bszParm2 <> vbNullString Then
' Determine if a radio frequency command has been received based on bszAction
If bszAction = "recvrf" Then
'*****************************
' Check for dim or bright values
' set appropriate values: Be careful. The Parameters are case sensitive.
If bszParm2 = "Bright" Then
bszParm3 = PRESET_BRIGHT
ElseIf bszParm2 = "Dim" Then
bszParm3 = PRESET_DIM
End If
'*****************************
' Perform an action based on the info from the RecvAction event
' The CM15A will not automatically do anything after the RecvAction has been fired.
' The programmer has the flexibility to tell the CM15A what to do, however, based on the
' on the information from the various parameters. For example, suppose the
' CM15A received info that the motion sensor @B5 has been triggered. The motion
' sensor is located in the room with your safe. Program code to automatically place a call
' to your local police station and your cell phone. You could send a power line code to
' activate your automatic dialer or to turn on your loud noise siren to scare the intruder away.
' Or possibly activate your X10 camera to record the intrusion on tape to use as evidence in
' a criminal trial. The following code just tells the CM15A to send a power
' line code to the address indicated by the device that generated the code: bzParm1 is the
' address requesting action for an on, off, dim, bright command. bszParm2 contains the info
' for which type of command it's requesting (on, off, dim, bright), and bszParm3 is additional data or data
' for brightness or dim levels.
' **********************************************************************************
objX10.SendAction "sendplc", bszParm1 & " " & bszParm2 & " " & bszParm3
On Error GoTo 0
If CInt(bszParm3) >= 0 Then
Select Case bszParm2
Case "Play"
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support")) Then
If WAPlaybackStatus = 0 Then
WATrackPlay
ElseIf WAPlaybackStatus = 1 Then
WATrackPause
ElseIf WAPlaybackStatus = 2 Then
WATrackPlay
ElseIf WAPlaybackStatus = 3 Then
WATrackPlay
End If
End If
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "WMP Support")) Then WMPPlayPause
Case "Pause"
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support")) Then WATrackPause
Case "Forward"
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support")) Then WATrackFForward
Case "Rewind"
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support")) Then WATrackFRewind
Case "Stop"
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support")) Then WATrackStop
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "WMP Support")) Then WMPStop
Case "F" ' Fast forward
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support")) Then WATrackNext
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "WMP Support")) Then WMPNext
Case "E" ' Fast rewind
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Winamp Support")) Then WATrackPrev
If CBool(GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "WMP Support")) Then WMPPrev
Case "VolumeDown" ' Really volume up
VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535) + 5
If VolValue > 100 Then VolValue = 100
SetVolumeControl SetVolHmixer, SetVolCtrl, VolValue * 65535 / 100
Case "VolumeUp" ' Really volume down
VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535) - 5
If VolValue < 0 Then VolValue = 0
SetVolumeControl SetVolHmixer, SetVolCtrl, VolValue * 65535 / 100
Case "A" ' Mute
If GetVolumeValue(SetVolHmixer, SetMuteCtrl) Then
SetVolumeControl SetVolHmixer, SetMuteCtrl, 0
VolValue = Int((GetVolumeValue(SetVolHmixer, SetVolCtrl) * 100) / 65535)
If VolValue < 0 Then VolValue = 0
If VolValue > 100 Then VolValue = 100
Else
SetVolumeControl SetVolHmixer, SetMuteCtrl, 1
End If
Case "Up" ' page up
SendKeys "{PGUP}"
Case "Down" ' page down
SendKeys "{PGDN}"
Case "Left" ' back
SendKeys "{BACKSPACE}"
Case "Right" ' forward
SendKeys "+{BACKSPACE}"
Case "TV" ' DVR
On Error Resume Next
If txtPath(0).Text <> "" Then _
Shell txtPath(0).Text, vbNormalFocus
Case "DVD" ' DVD
On Error Resume Next
If txtPath(1).Text <> "" Then _
Shell txtPath(1).Text, vbNormalFocus
Case "Web" ' PHOTO
On Error Resume Next
If txtPath(2).Text <> "" Then _
Shell txtPath(2).Text, vbNormalFocus
Case "Book" ' MUSIC
On Error Resume Next
If txtPath(3).Text <> "" Then _
Shell txtPath(3).Text, vbNormalFocus
Case "Hand" ' WEB
On Error Resume Next
If txtPath(4).Text <> "" Then _
Shell txtPath(4).Text, vbNormalFocus
End Select
End If
End If
End If
'Debug.Print bszAction, bszParm1, bszParm2, bszParm3, bszParm4, bszParm5, bszReserved
End Sub
Private Sub OpenMenu_Click()
If Not Visible Then AlwaysOnTop Me, True
Visible = Not Visible
AlwaysOnTop Me, False
End Sub
Private Sub txtPath_Change(Index As Integer)
txtPath(Index).ToolTipText = txtPath(Index).Text
End Sub