Attribute VB_Name = "mod_Science"
Option Explicit

Public CurrentID As Long
Public CurrentMID As Long
Public Movieloaded As Boolean
Public SaverMode As Boolean
Public SaverWait As Boolean
Public AddEditMode As Boolean
Public AddEditFile As String
Public AddEditDir As String
Public lngCurSection As Long
Public Const SND_PURGE = &H40
Public Const SND_NODEFAULT = &H2
Public Declare Function PlaySoundNow Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

Public Function DATABASE_LoadConvert(inString As String) As String
    Dim lngLoop As Long
    Dim outString As String
    
    outString = ""
    For lngLoop = 1 To Len(inString)
        Select Case Asc(Mid(inString, lngLoop, 1))
                Case 10, 13, 44
                    outString = outString & " "
                Case Else
                    outString = outString & Mid(inString, lngLoop, 1)
        End Select
    Next
    DATABASE_LoadConvert = outString
End Function

Public Sub DATABASE_LoadDir(subPath As String, lstList As ListBox)
    Dim lngLoop As Long
    
    lstList.Clear
    On Error GoTo Database_loaddirerror
    frmMain.File1.Pattern = "*.txt"
    frmMain.File1.Path = strProgramdir & "\database\" & subPath & "\"
    frmMain.File1.Refresh
    
    AddEditDir = subPath
    
    For lngLoop = 0 To frmMain.File1.ListCount - 1
        lstList.AddItem subPath & "\" & frmMain.File1.List(lngLoop) & Chr(9) & DATABASE_LoadReadFile(frmMain.File1.Path & "\" & frmMain.File1.List(lngLoop))
        lstList.ItemData(lstList.NewIndex) = lngLoop
    Next
Database_loaddirerror:
    On Error GoTo 0
End Sub

Public Sub DATABASE_LoadItem(curIndex As Long)
    Dim fileNaam As String
    Dim fileTemp As String
    Dim dirNaam As String
    Dim tempString As String
    Dim lSize As String
    Dim Variable
    Dim strSound As String
    
    tempString = frmMain.lstShow.List(curIndex)
    
    dirNaam = Left(tempString, InStr(tempString, "\") - 1)
    
    fileNaam = Mid(tempString, InStr(tempString, "\") + 1)
    
    fileTemp = Left(fileNaam, InStr(fileNaam, ".") - 1)
    AddEditFile = fileTemp
    
    frmMain.txtBox(1).Text = DATABASE_LoadReadFile(strProgramdir & "\database\" & dirNaam & "\" & fileNaam)
    
    On Error Resume Next
    frmMain.File1.Pattern = "*.txt"
    frmMain.File1.Pattern = fileTemp & ".*g;" & _
                            fileTemp & "-*.*g;" & _
                            fileTemp & ".*f;" & _
                            fileTemp & "-*.*f;" & _
                            fileTemp & ".*i;" & _
                            fileTemp & "-*.*i;" & _
                            fileTemp & ".*p;" & _
                            fileTemp & "-*.*p"
    If frmMain.File1.Pattern = "*.txt" Then frmMain.File1.Pattern = "*.lcars-terminal.net"
    
    frmMain.File1.Path = strProgramdir & "\database\" & dirNaam
    frmMain.File1.Refresh
    
    frmMain.File3.Pattern = "&.txt"
    frmMain.File3.Pattern = fileTemp & ".wav;" & _
                            fileTemp & "-*.wav"
    If frmMain.File3.Pattern = "*.txt" Then frmMain.File3.Pattern = "*.lcars-terminal.net"
    frmMain.File3.Path = strProgramdir & "\database\" & dirNaam
    frmMain.File3.Refresh
    
    
    'Variable = 0
    'strSound = GetShortName(strProgramdir & "\database\" & dirNaam & "\" & fileTemp & ".wav")
    'Variable = FileLen(strSound)
    'If (Variable > 0) Then
    '    If SaverMode = True Then
    '        Variable = mciExecute("play " & strSound & " wait")
    '    Else
    '        Variable = mciExecute("play " & strSound)
    '    End If
    'End If
    CurrentID = -1
    DATABASE_nextprev (1)
    CurrentMID = -1
    DATABASE_musicnextprev (1)
End Sub

Public Function DATABASE_LoadReadFile(infile As String) As String
    Dim outString As String
    Dim tempString As String
    Dim filenumber
    
    outString = ""
    
    filenumber = FreeFile
    
    Open infile For Input As #filenumber
    Do While Not EOF(filenumber)
        Line Input #filenumber, tempString
        outString = outString & tempString & vbCrLf
    Loop
    Close #filenumber
    
    DATABASE_LoadReadFile = outString
End Function

Public Sub DATABASE_musicnextprev(optel As Long)
    Dim tmpFilename As String
    Dim tmpFileExt As String
    Dim tmpMultiple As String
    Dim Variable As Long
    Dim strSound As String
    
    If (frmMain.File3.ListCount > 1) Then
        tmpMultiple = "# "
    Else
        tmpMultiple = ""
    End If


    If optel > 0 Then
        If CurrentMID + 1 < frmMain.File3.ListCount Then
            CurrentMID = CurrentMID + 1
        Else
            CurrentMID = 0
        End If
    ElseIf optel < 0 Then
        If CurrentMID - 1 >= 0 Then
            CurrentMID = CurrentMID - 1
        Else
            CurrentMID = frmMain.File3.ListCount - 1
        End If
    End If
    tmpFilename = frmMain.File3.List(CurrentMID)
    If tmpFilename = "" Then
        tmpFilename = "lcars-terminal.net"
    End If
        
    Variable = 0
    strSound = GetShortName(frmMain.File3.Path & "\" & tmpFilename)
    On Error Resume Next
    Variable = FileLen(strSound)
    On Error GoTo 0
    If (Variable > 0) Then
        frmMain.lblBox(2).Caption = tmpMultiple & tmpFilename
        If SaverMode = True Then
            Variable = mciExecute("play " & strSound & " wait")
        Else
            Variable = mciExecute("play " & strSound)
        End If
    Else
        frmMain.lblBox(2).Caption = ""
    End If
End Sub

Public Sub DATABASE_nextprev(optel As Long)
    Dim tmpFilename As String
    Dim tmpFileExt As String
    Dim tmpMultiple As String
    
    If (frmMain.File1.ListCount > 1) Then
        tmpMultiple = "# "
    Else
        tmpMultiple = ""
    End If


    If optel > 0 Then
        If CurrentID + 1 < frmMain.File1.ListCount Then
            CurrentID = CurrentID + 1
        Else
            CurrentID = 0
        End If
    Else
        If CurrentID - 1 >= 0 Then
            CurrentID = CurrentID - 1
        Else
            CurrentID = frmMain.File1.ListCount - 1
        End If
    End If
    tmpFilename = frmMain.File1.List(CurrentID)
    tmpFileExt = Mid(tmpFilename, InStrRev(tmpFilename, ".") + 1)
    If tmpFilename = "" Then
        tmpFilename = "lcars-terminal.net"
        tmpFileExt = "Piet_van_Stralen"
    End If
        
    If Movieloaded = True Then
        Movieloaded = False
        frmMain.MMControl1.Command = "STOP"
        frmMain.MMControl1.Command = "CLOSE"
    End If
    Select Case UCase(tmpFileExt)
        Case "JPG", "BMP", "GIF"
            frmMain.imgPic(picID).Picture = LoadPicture(frmMain.File1.Path & "\" & tmpFilename)
            frmMain.lblBox(1).Caption = tmpMultiple & tmpFilename
            frmMain.picMovie.Visible = False
            frmMain.imgPic(picID).Visible = False
            frmMain.imgPicture.Left = picLeft
            frmMain.imgPicture.Top = picTop
            frmMain.imgPicture.Picture = frmMain.imgPic(picID).Picture
            frmMain.imgPicture.Width = frmMain.imgPic(picID).Width
            frmMain.imgPicture.Height = frmMain.imgPic(picID).Height
            If frmMain.imgPic(picID).Width > picWidth Then
                frmMain.imgPicture.Width = picWidth
                frmMain.imgPicture.Height = Int((picWidth * frmMain.imgPic(picID).Height) / frmMain.imgPic(picID).Width)
            End If
            If frmMain.imgPicture.Height > picHeight Then
                frmMain.imgPicture.Height = picHeight
                frmMain.imgPicture.Width = Int((picHeight * frmMain.imgPicture.Width) / frmMain.imgPicture.Height)
            End If
            frmMain.imgPicture.Visible = True
        Case "MPG", "MPEG", "AVI"
            frmMain.lblBox(1).Caption = tmpMultiple & tmpFilename
            frmMain.imgPic(picID).Visible = False
            frmMain.imgPicture.Visible = False
            frmMain.picMovie.Visible = True
            frmMain.MMControl1.hWndDisplay = frmMain.picMovie.hWnd
            frmMain.MMControl1.FileName = frmMain.File1.Path & "\" & tmpFilename
            frmMain.MMControl1.Command = "Open"
            frmMain.MMControl1.Command = "Play"
            Movieloaded = True
        Case Else
            frmMain.lblBox(1).Caption = ""
            frmMain.imgPic(picID).Picture = LoadPicture(strProgramdir & strThemedir & picFile)
            frmMain.picMovie.Visible = False
            frmMain.imgPic(picID).Visible = False
            frmMain.imgPic(picID).Visible = False
            frmMain.imgPicture.Left = picLeft
            frmMain.imgPicture.Top = picTop
            frmMain.imgPicture.Picture = frmMain.imgPic(picID).Picture
            frmMain.imgPicture.Width = frmMain.imgPic(picID).Width
            frmMain.imgPicture.Height = frmMain.imgPic(picID).Height
            If frmMain.imgPic(picID).Width > picWidth Then
                frmMain.imgPicture.Width = picWidth
                frmMain.imgPicture.Height = Int((picWidth * frmMain.imgPic(picID).Height) / frmMain.imgPic(picID).Width)
            End If
            If frmMain.imgPicture.Height > picHeight Then
                frmMain.imgPicture.Height = picHeight
                frmMain.imgPicture.Width = Int((picHeight * frmMain.imgPicture.Width) / frmMain.imgPicture.Height)
            End If
            frmMain.imgPicture.Visible = True
        End Select
End Sub

Public Sub DATABASE_Search()
    'Gaat data zoeken.
    Dim lngLoop As Long
    Dim recLoop As Long
    Dim curFound As Long
    Dim tempString As String
    Dim maxZoek As Long
    Dim curZoek As Long
    Dim strSecure As String
    Dim rc As String
    Dim Variable As Long

    If frmMain.txtSearch.Text = "" Then
        PlaySound myNone, False
        Exit Sub
    Else
        PlaySound mySearch, False
    End If
    
    frmMain.lstBox(1).Clear
    frmMain.lstShow.Clear
    curFound = 0
    curZoek = 0
    
    frmMain.picMeter1.Width = 1
    
    frmMain.lstBox(1).Visible = False
    For lngLoop = 1 To myDatabase
        DATABASE_LoadDir myDatabases(lngLoop), frmMain.lstBox(0)
        DATABASE_SearchZoeken curFound, curZoek, frmMain.lstBox(0)
    Next
    frmMain.picMeter1.Width = 202
    frmMain.lstBox(1).Visible = True
    rc = PlaySoundNow(vbNullString, 0, SND_PURGE Or SND_NODEFAULT)
    Variable = mciExecute("close all")
    
    If frmMain.lstBox(1).ListCount = 0 Then
        PlaySound myNone, False
    Else
        PlaySound myFound, False
    End If
End Sub

Public Sub DATABASE_SearchCurrent()
    'Gaat data zoeken.
    Dim lngLoop As Long
    Dim recLoop As Long
    Dim curFound As Long
    Dim tempString As String
    Dim maxZoek As Long
    Dim curZoek As Long
    Dim strSecure As String
    Dim rc As String
    Dim Variable As Long

    If frmMain.txtSearch.Text = "" Or lngCurSection = -1 Then
        PlaySound myNone, False
        Exit Sub
    Else
        PlaySound mySearch, False
    End If
    
    frmMain.lstBox(1).Clear
    frmMain.lstShow.Clear
    curFound = 0
    curZoek = 0
    
    frmMain.picMeter1.Width = 1
    
    frmMain.lstBox(1).Visible = False
    DATABASE_LoadDir Mid(myActions(lngCurSection), 5), frmMain.lstBox(0)
    DATABASE_SearchZoeken curFound, curZoek, frmMain.lstBox(0)
    frmMain.picMeter1.Width = 202
    frmMain.lstBox(1).Visible = True
    rc = PlaySoundNow(vbNullString, 0, SND_PURGE Or SND_NODEFAULT)
    Variable = mciExecute("close all")
    
    If frmMain.lstBox(1).ListCount = 0 Then
        PlaySound myNone, False
    Else
        PlaySound myFound, False
    End If
End Sub
Public Sub DATABASE_Searchmeter(curcount As Long)
    Dim maxcount As Long
    
    maxcount = curcount
    While (maxcount > 202)
        maxcount = maxcount - 202
        If (maxcount < 1) Then maxcount = 1
    Wend
    
    frmMain.picMeter1.Width = maxcount
    DoEvents
End Sub

Public Sub DATABASE_SearchZoeken(curFound As Long, curZoek As Long, lstBox As ListBox)
    Dim realFound As Long
    Dim lngLoop As Long
    Dim tempString As String
    Dim ZoekString(1 To 10) As String
    Dim maxZoek As Long
    
    maxZoek = 0
    tempString = frmMain.txtSearch.Text
    Do While InStr(tempString, " ") And maxZoek < 10
        maxZoek = maxZoek + 1
        ZoekString(maxZoek) = LCase(Left(tempString, InStr(tempString, " ") - 1))
        tempString = Mid(tempString, InStr(tempString, " ") + 1)
    Loop
    maxZoek = maxZoek + 1
    ZoekString(maxZoek) = LCase(tempString)
    
    For lngLoop = 0 To lstBox.ListCount - 1
        tempString = LCase(DATABASE_LoadConvert(Mid(lstBox.List(lngLoop), InStr(lstBox.List(lngLoop), Chr(9)) + 1)))
        realFound = 0
        If maxZoek >= 1 And InStr(tempString, ZoekString(1)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 2 And InStr(tempString, ZoekString(2)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 3 And InStr(tempString, ZoekString(3)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 4 And InStr(tempString, ZoekString(4)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 5 And InStr(tempString, ZoekString(5)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 6 And InStr(tempString, ZoekString(6)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 7 And InStr(tempString, ZoekString(7)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 8 And InStr(tempString, ZoekString(8)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 9 And InStr(tempString, ZoekString(9)) Then
            realFound = realFound + 1
        End If
        If maxZoek >= 10 And InStr(tempString, ZoekString(10)) Then
            realFound = realFound + 1
        End If
        If realFound = maxZoek Then
            frmMain.lstShow.AddItem Left(lstBox.List(lngLoop), InStr(lstBox.List(lngLoop), Chr(9)) - 1)
            frmMain.lstBox(1).AddItem DATABASE_LoadConvert(Mid(lstBox.List(lngLoop), InStr(lstBox.List(lngLoop), Chr(9)) + 1))
            frmMain.lstBox(1).ItemData(frmMain.lstBox(1).NewIndex) = curFound
            curFound = curFound + 1
        End If
        curZoek = curZoek + 1
        DATABASE_Searchmeter curZoek
    Next
End Sub

Public Sub DATABASE_ShowCat(dbDir As String)
    Dim lngLoop As Long

    frmMain.lstBox(0).Clear
    frmMain.lstBox(1).Clear
    frmMain.lstShow.Clear
    frmMain.lstBox(1).Visible = False
    DATABASE_LoadDir dbDir, frmMain.lstBox(0)
    For lngLoop = 0 To frmMain.lstBox(0).ListCount - 1
        frmMain.lstShow.AddItem Left(frmMain.lstBox(0).List(lngLoop), InStr(frmMain.lstBox(0).List(lngLoop), Chr(9)) - 1)
        frmMain.lstBox(1).AddItem DATABASE_LoadConvert(Mid(frmMain.lstBox(0).List(lngLoop), InStr(frmMain.lstBox(0).List(lngLoop), Chr(9)) + 1))
        frmMain.lstBox(1).ItemData(frmMain.lstBox(1).NewIndex) = lngLoop
    Next
    frmMain.lstBox(1).Visible = True
    If SaverMode = False Then
        If frmMain.lstBox(1).ListCount = 0 Then
            PlaySound myNone, False
            CurrentID = -1
            frmMain.txtBox(1).Text = ""
            DATABASE_nextprev (1)
        Else
            PlaySound myFound, False
            DATABASE_LoadItem frmMain.lstBox(1).ItemData(0)
        End If
    End If
End Sub

