|
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmDataBase
BorderStyle = 3 'Fixed Dialog
Caption = "Search DATABASE"
ClientHeight = 2820
ClientLeft = 36
ClientTop = 264
ClientWidth = 4800
ControlBox = 0 'False
Icon = "frmDataBase.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2820
ScaleWidth = 4800
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.ComboBox Combo3
Height = 288
ItemData = "frmDataBase.frx":08CA
Left = 120
List = "frmDataBase.frx":08CC
TabIndex = 0
Text = "Combo3"
Top = 600
Width = 4572
End
Begin VB.CommandButton Command3
Cancel = -1 'True
Caption = "&Close"
Height = 252
Left = 3240
TabIndex = 5
Top = 2400
Width = 1332
End
Begin VB.CommandButton Command2
Caption = "&Play"
Height = 252
Left = 240
TabIndex = 4
Top = 2400
Width = 1452
End
Begin VB.ComboBox Combo2
Height = 288
Left = 120
TabIndex = 1
Text = "Combo2"
Top = 1200
Width = 4572
End
Begin MSComDlg.CommonDialog Dial
Left = 2160
Top = 840
_ExtentX = 677
_ExtentY = 677
_Version = 393216
End
Begin VB.CommandButton Command1
Caption = "&Add"
Height = 252
Left = 1920
TabIndex = 3
Top = 2400
Width = 1092
End
Begin VB.ComboBox Combo1
Height = 288
Left = 120
Style = 2 'Dropdown List
TabIndex = 2
Top = 1800
Width = 4572
End
Begin VB.Label Label6
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "How To Use?"
Height = 432
Left = 4200
TabIndex = 11
Top = 0
Width = 564
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "DATABASE"
BeginProperty Font
Name = "Times New Roman"
Size = 13.8
Charset = 177
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 312
Left = 1800
TabIndex = 9
Top = 0
Width = 1428
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "&Singer or Band:"
Height = 192
Left = 120
TabIndex = 8
Top = 360
Width = 1104
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Song's &Title:"
Height = 192
Left = 120
TabIndex = 7
Top = 960
Width = 888
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Song &Full Path:"
Height = 192
Left = 120
TabIndex = 6
Top = 1560
Width = 1068
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "DATABASE"
BeginProperty Font
Name = "Times New Roman"
Size = 16.2
Charset = 177
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 372
Left = 1680
TabIndex = 10
Top = 0
Width = 1704
End
End
Attribute VB_Name = "frmDataBase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private lastdelop As Boolean
Private lastdelopp As Boolean
Private Sub Combo1_Click()
On Error Resume Next
Combo2.ListIndex = Combo1.ListIndex
Combo3.ListIndex = Combo1.ListIndex
End Sub
Private Sub Combo2_Change()
'change made by me flag
Static ChangeFlag As Boolean
'if change is made by the user
If Not ChangeFlag Then
Dim cboText As String
Dim lencboText As Integer
Dim tmpLen As Integer
Dim tmp As Integer
'init variables
cboText = Combo2.Text
lencboText = Len(Combo2.Text)
'if the last operation has not been deletion
If Not lastdelopp Then
'check if user entry matches an item
For tmp = 0 To Combo2.ListCount - 1
If UCase(Left(Combo2.Text, Combo2.SelStart)) = UCase(Combo2.list(tmp)) Then
'the change that follows is made by me, so set flag
ChangeFlag = True
Combo2.Text = Combo2.list(tmp)
Combo2.SelStart = Len(Combo2.Text)
'reset flag
ChangeFlag = False
'reset deltion operation flag
lastdelopp = False
Exit Sub
End If
Next tmp
'if you omit this check, when you delete the text in
'the cbobox the first item will be automaticall
'displayed
'if not just cleared
If lencboText > 0 Then
'loop to check all items
For tmp = 0 To Combo2.ListCount - 1
'if fisrt letters of current item match the cbotext
'if you omit ucase the search will be case sensitive
If UCase(Left(Combo2.list(tmp), lencboText)) = UCase(cboText) Then
'save entered text length
tmpLen = lencboText
'set new text - the cbobox item
ChangeFlag = True
Combo2.Text = Combo2.list(tmp)
'select all letters after those the user entered
Combo2.SelStart = tmpLen
Combo2.SelLength = Len(Combo2.list(tmp)) - tmpLen
ChangeFlag = False
'exit the loop
Exit For
End If
Next tmp
End If 'lencboText > 0
End If 'Not lastdelopp
'reset flag
lastdelopp = False
End If 'Not ChangeFlag
On Error Resume Next
Combo1.ListIndex = Combo2.ListIndex
Combo3.ListIndex = Combo2.ListIndex
End Sub
Private Sub Combo2_Click()
On Error Resume Next
Combo1.ListIndex = Combo2.ListIndex
Combo3.ListIndex = Combo2.ListIndex
End Sub
Private Sub Combo2_KeyDown(KeyCode As Integer, Shift As Integer)
'if delete or backspace pressed - pull up flag
If (KeyCode = vbKeyDelete) Or (KeyCode = vbKeyBack) Then
lastdelopp = True
End If
End Sub
Private Sub Combo3_Click()
Combo1.ListIndex = Combo3.ListIndex
Combo2.ListIndex = Combo3.ListIndex
End Sub
Private Sub Command1_Click()
Dim TrueName
Dim SingerName
With Dial
.DialogTitle = "Add file to DATABASE"
.Filter = "All Sound Files|*.mp3;*.mu3;*.wav;*.mid;*.mp2;*.pls;*.mp1;*.voc;*.cda;*.it;*.s3m;*.stm;*.wma;*.vqf"
.ShowOpen
End With
If Dial.FileName <> "" Then
TrueName = InputBox("Enter Song Title:", "Add Song To DATABASE")
If TrueName = "" Then TrueName = "Unknown"
SingerName = InputBox("Enter the Band or the Singer name:", "Add Song To DATABASE")
If SingerName = "" Then SingerName = "Unknown"
Open (App.Path & "\FullPath.dtb") For Append As #1
Write #1, Dial.FileName
Close #1
Open (App.Path & "\SONG.dtb") For Append As #2
Write #2, TrueName
Close #2
Open (App.Path & "\BAND.dtb") For Append As #3
Write #3, SingerName
Close #3
End If
End Sub
Private Sub Command2_Click()
Call ShellExecute(hwnd, "Open", Combo1.Text, "", "", 1)
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
frmSearch.Show vbModal
End Sub
Private Sub Form_Activate()
FillDATABaseCombo
FillDATABaseCombo1
FillDATABaseCombo2
On Error Resume Next
Me.Picture = LoadPicture(App.Path & "\Skinz\DB.gif")
End Sub
Private Sub FillDATABaseCombo()
Dim mHandle
Dim tmp As String
Combo1.Clear
mHandle = FreeFile
Open (App.Path & "\FullPath.dtb") For Input As #mHandle
Do While Not EOF(mHandle)
Line Input #mHandle, tmp
If Len(Trim(tmp)) > 0 Then
Combo1.AddItem tmp
End If
Loop
Close #mHandle
If Combo1.ListCount > 0 Then
Combo1.ListIndex = 0
End If
End Sub
Private Sub FillDATABaseCombo1()
Dim mHandle
Dim tmp As String
Combo2.Clear
mHandle = FreeFile
Open (App.Path & "\SONG.dtb") For Input As #mHandle
Do While Not EOF(mHandle)
Line Input #mHandle, tmp
If Len(Trim(tmp)) > 0 Then
Combo2.AddItem tmp
End If
Loop
Close #mHandle
If Combo2.ListCount > 0 Then
Combo2.ListIndex = 0
End If
End Sub
Private Sub FillDATABaseCombo2()
Dim mHandle
Dim tmp As String
Combo3.Clear
mHandle = FreeFile
Open (App.Path & "\BAND.dtb") For Input As #mHandle
Do While Not EOF(mHandle)
Line Input #mHandle, tmp
If Len(Trim(tmp)) > 0 Then
Combo3.AddItem tmp
End If
Loop
Close #mHandle
If Combo3.ListCount > 0 Then
Combo3.ListIndex = 0
End If
End Sub
Private Sub combo3_Change()
'change made by me flag
Static ChangeFlag As Boolean
'if change is made by the user
If Not ChangeFlag Then
Dim cboText As String
Dim lencboText As Integer
Dim tmpLen As Integer
Dim tmp As Integer
'init variables
cboText = Combo3.Text
lencboText = Len(Combo3.Text)
'if the last operation has not been deletion
If Not lastdelopp Then
'check if user entry matches an item
For tmp = 0 To Combo3.ListCount - 1
If UCase(Left(Combo3.Text, Combo3.SelStart)) = UCase(Combo3.list(tmp)) Then
'the change that follows is made by me, so set flag
ChangeFlag = True
Combo3.Text = Combo3.list(tmp)
Combo3.SelStart = Len(Combo3.Text)
'reset flag
ChangeFlag = False
'reset deltion operation flag
lastdelopp = False
Exit Sub
End If
Next tmp
'if you omit this check, when you delete the text in
'the cbobox the first item will be automaticall
'displayed
'if not just cleared
If lencboText > 0 Then
'loop to check all items
For tmp = 0 To Combo3.ListCount - 1
'if fisrt letters of current item match the cbotext
'if you omit ucase the search will be case sensitive
If UCase(Left(Combo3.list(tmp), lencboText)) = UCase(cboText) Then
'save entered text length
tmpLen = lencboText
'set new text - the cbobox item
ChangeFlag = True
Combo3.Text = Combo3.list(tmp)
'select all letters after those the user entered
Combo3.SelStart = tmpLen
Combo3.SelLength = Len(Combo3.list(tmp)) - tmpLen
ChangeFlag = False
'exit the loop
Exit For
End If
Next tmp
End If 'lencboText > 0
End If 'Not lastdelopp
'reset flag
lastdelopp = False
End If 'Not ChangeFlag
On Error Resume Next
Combo1.ListIndex = Combo3.ListIndex
Combo2.ListIndex = Combo3.ListIndex
End Sub
Private Sub Label1_Click()
Combo1.SetFocus
End Sub
Private Sub Label2_Click()
Combo2.SetFocus
End Sub
Private Sub Label3_Click()
Combo3.SetFocus
End Sub
Private Sub Label6_Click()
MsgBox "How to use the Locate Using The DATABASE?" & vbCrLf & vbCrLf & "Searching for a song:" & vbCrLf & "By Title: Enter the song's title or the first letters of it, and the program will find the filename and the Singer or Band" & vbCrLf & "By Singer or Band: Enter the singers or band first letters, and the program will locate the Filename and the songs title" & vbCrLf & vbCrLf & "PLEASE NOTE: Before you enter the song's title or the Singer or Band, add ''" & vbCrLf & "The reason is because the DATABASE saves the details and auto add ''" & vbCrLf & vbCrLf & "Adding a file - Click on Add, locate the file, Enter the file's Title in the Input box and the Singer or Band in the other Input Box - To refresh close and restart the DATABASE window", vbInformation, "How To Use The DATABASE"
End Sub
Private Sub Label6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label6.ForeColor = RGB(0, 0, 255)
Label6.FontUnderline = True
End Sub
Private Sub Label6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label6.ForeColor = RGB(0, 0, 0)
Label6.FontUnderline = False
End Sub
|
