Dialog.frm.VisualBasicSourceCode.c

VERSION 5.00
Begin VB.Form Dialog 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TittyMemory Settings"
   ClientHeight    =   1635
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6030
   Icon            =   "Dialog.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1635
   ScaleWidth      =   6030
   ShowInTaskbar   =   0   'False
   Begin VB.ComboBox Combo3 
      Height          =   315
      Left            =   2280
      TabIndex        =   4
      Top             =   1080
      Width           =   2175
   End
   Begin VB.ComboBox Combo2 
      Height          =   315
      Left            =   2280
      TabIndex        =   3
      Top             =   600
      Width           =   2175
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      Left            =   2280
      TabIndex        =   2
      Top             =   120
      Width           =   2175
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4680
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "OK"
      Height          =   375
      Left            =   4680
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "select Gamefield"
      Height          =   195
      Left            =   360
      TabIndex        =   7
      Top             =   1080
      Width           =   1170
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "select Deck"
      Height          =   195
      Left            =   360
      TabIndex        =   6
      Top             =   600
      Width           =   855
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "select Card-Set"
      Height          =   195
      Left            =   360
      TabIndex        =   5
      Top             =   120
      Width           =   1080
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "Dialog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub Form_Load()
    Dim cards() As String
    Dim decks() As String
    Dim i As Long
    Combo1.text = Form1.cardName
    Combo2.text = Form1.deckName
    cards = getCardNames()
    If (cards(0) <> "::~~##") Then
        For i = 0 To UBound(cards) - 1
            Combo1.AddItem cards(i)
        Next i
    End If
    decks = getDeckNames()
    If (decks(0) <> "::~~##") Then
        For i = 0 To UBound(decks) - 1
            Combo2.AddItem decks(i)
        Next i
    End If
    Combo3.AddItem "4 x 4"
    Combo3.AddItem "5 x 4"
    Combo3.AddItem "6 x 4"
    Combo3.AddItem "6 x 5"
    Combo3.AddItem "6 x 6"
    Combo3.text = Form1.squareMaxX & " x " & Form1.squareMaxY
End Sub

Function getDeckNames() As String()
    On Error GoTo Hell
    Dim res() As String
    Dim path As String
    Dim fileFound As String
    Dim i As Long
    ReDim res(1)
    res(0) = "::~~##"
    path = App.path & "\pics\" & "deck*.*"
    fileFound = Dir(path)
    Do
        If (fileFound <> "") Then
            i = i + 1
            ReDim Preserve res(i)
            res(i - 1) = getFileName(fileFound)
        Else
            Exit Do
        End If
        DoEvents
        fileFound = Dir
    Loop
    getDeckNames = res
    Exit Function
Hell:
    MsgBox "Error finding Deck-Types" & vbNewLine & _
            "Please read the 'ReadMe.txt' file.", _
            vbCritical, "TittyMemory"
End Function

Function getCardNames() As String()
    On Error GoTo Hell
    Dim res() As String
    Dim path As String
    Dim fileFound As String
    Dim lastFound As String
    Dim i As Long
    Dim k As Long
    Dim saveFlag As Boolean
    ReDim res(1)
    lastFound = "::~~##"
    res(0) = lastFound
    path = App.path & "\pics\" & "card*.*"
    fileFound = Dir(path)
    Do
        If (fileFound <> "") Then
            If (InStr(fileFound, lastFound) = 0) Then
                saveFlag = False
                For k = 0 To UBound(res) - 1
                    If (InStr(fileFound, res(k)) > 0) Then
                        saveFlag = True
                    End If
                Next k
                If Not (saveFlag) Then
                    i = i + 1
                    ReDim Preserve res(i)
                    lastFound = getFileName(fileFound)
                    lastFound = Left$(lastFound, Len(lastFound) - 2)
                    res(i - 1) = lastFound
                End If
            End If
        Else
            Exit Do
        End If
        DoEvents
        fileFound = Dir
    Loop
    getCardNames = res
    Exit Function
Hell:
    MsgBox "Error finding Card-Types." & vbNewLine & _
            "Please read the 'ReadMe.txt' file.", _
            vbCritical, "TittyMemory"
End Function


Function getFileName(path As String) As String
    Dim res As String
    Dim slashPos As Long
    slashPos = InStrRev(path, "\")
    res = Right$(path, Len(path) - slashPos)
    getFileName = Left$(res, Len(res) - 4)
End Function

Private Sub OKButton_Click()
    Form1.cardName = Combo1.text
    Form1.deckName = Combo2.text
    Form1.squareMaxX = Left$(Combo3.text, 1)
    Form1.squareMaxY = Right$(Combo3.text, 1)
    Unload Me
End Sub

Private Sub CancelButton_Click()
    Unload Me
End Sub

---