' ******************************************************
' データベース用
' ******************************************************
Global Cn As Object
Global Rs As Object
Global SqlQuery As String

' ******************************************************
' キーボードコントロール用
' ******************************************************
Public Declare Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long _
)
Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_TAB = &H9 '[TAB]

' ******************************************************
' フォーム上のクリア対象のコントロールをクリアする
' ******************************************************
Public Function lbClear(curForm As Form)

    Dim nCnt, i As Integer
    
    nCnt = curForm.Count
    
    For i = 0 To nCnt - 1
    
        If TypeName(curForm(i)) = "TextBox" Then
            curForm(i).Text = ""
        End If
        If TypeName(curForm(i)) = "Label" Then
            If curForm(i).Tag <> "title" Then
                curForm(i).Caption = ""
            End If
        End If
        If TypeName(curForm(i)) = "CheckBox" Then
            curForm(i).Value = 0
        End If
    
    Next

End Function

' ******************************************************
' フォーム上の同一グループを入力可能または不可にする
' ******************************************************
Public Function lbDisableObjects( _
    curForm As Form, _
    strGroup As String, _
    bFlg As Boolean _
)

    Dim nCnt, i As Integer
    
    nCnt = curForm.Count
    
    For i = 0 To nCnt - 1
    
        If curForm(i).Tag = strGroup Then
            curForm(i).Enabled = Not bFlg
        End If
    
    Next

End Function

' ******************************************************
' 文字列の種類をチェック
' ******************************************************
Public Function lbCheckString( _
    strTarget As String, _
    strGroup As String _
) As Boolean

    Dim i As Integer
    Dim char As String
    
    For i = 1 To Len(strTarget)
        char = Mid(strTarget, i, 1)
        If InStr(strGroup, char) = 0 Then
            lbCheckString = False
            Exit Function
        End If
    Next

    lbCheckString = True

End Function

' ******************************************************
' テキストボックス内の文字列を選択する
' ******************************************************
Public Function lbSelectText(txtTarget As TextBox)

    txtTarget.SelStart = 0
    txtTarget.SelLength = Len(txtTarget.Text)

End Function

' ******************************************************
' MaxLength値より、Textboxを前ゼロ編集する
' ******************************************************
Public Function lbEditZeroText(txtTarget As TextBox)

    If txtTarget.MaxLength > 0 Then
        txtTarget.Text = Format(txtTarget.Text, String(txtTarget.MaxLength, "0"))
    End If

End Function

' ******************************************************
' MaxLength値より、Textboxの入力バイト数オーバをチェック
' ******************************************************
Public Function lbCheckTextMax(txtTarget As TextBox) As Boolean

    If txtTarget.MaxLength > 0 Then
        If LenB(StrConv(txtTarget.Text, vbFromUnicode)) > txtTarget.MaxLength Then
            lbCheckTextMax = False
            Exit Function
        End If
    End If
            
    lbCheckTextMax = True

End Function

' ******************************************************
' 日付チェック
' ******************************************************
Public Function lbDateCheck(strData As String) As Long

    Dim strWork As String
    
    ' 文字数チェック(8文字必須)
    strWork = Replace(strData, "/", "")
    If Len(strWork) <> 8 Then
        lbDateCheck = 1
        Exit Function
    End If

    Dim strYYYY, strMM, strDD As String

    strYYYY = Left(strWork, 4)
    strMM = Mid(strWork, 5, 2)
    strDD = Right(strWork, 2)

    ' 月のチェック
    If Val(strMM) > 12 Or Val(strMM) < 1 Then
        lbDateCheck = 2
        Exit Function
    End If

    Dim bError As Boolean

    bError = False

    ' 日のチェック
    Select Case Val(strMM)
        Case 4
            If Val(strDD) > 30 Or Val(strDD) < 1 Then
                bError = True
            End If
        Case 6
            If Val(strDD) > 30 Or Val(strDD) < 1 Then
                bError = True
            End If
        Case 9
            If Val(strDD) > 30 Or Val(strDD) < 1 Then
                bError = True
            End If
        Case 11
            If Val(strDD) > 30 Or Val(strDD) < 1 Then
                bError = True
            End If
            
        Case 2
            If (Val(strYYYY) Mod 4) = 0 Then
                If Val(strDD) > 29 Or Val(strDD) < 1 Then
                    bError = True
                End If
            Else
                If Val(strDD) > 28 Or Val(strDD) < 1 Then
                    bError = True
                End If
            End If
            
        Case Else
            If Val(strDD) > 31 Or Val(strDD) < 1 Then
                bError = True
            End If
            
    End Select
    
    If bError Then
        lbDateCheck = 3
        Exit Function
    End If
    
    lbDateCheck = 0

End Function

' ******************************************************
' 文字列をシングルクォーテーションで挟む
' ******************************************************
Public Function Ss(strData As String) As String

    Ss = "'" & strData & "'"

End Function