modbase.bas

通用书店管理系统

End Sub


'--------------------------------------------------------------------------------
'功能：    修改MDI窗体的按钮图标和按钮标题

'参数说明：
'          frm          MDI窗体名
'          intIndex     按钮的索引
'          strButtonCap 按钮的标题
'          intPicture   按钮的图片
'          strKey       按钮的KEY值
'--------------------------------------------------------------------------------

Public Sub ChangeToolBar(ByVal frm As frmMain, intIndex As Integer, strButtonCap As String, intPicture As Integer, strKey As String)
    frm.tbToolBar.Buttons(intIndex).Caption = strButtonCap
    frm.tbToolBar.Buttons(intIndex).ToolTipText = strButtonCap
    frm.tbToolBar.Buttons(intIndex).Key = strKey
    frm.tbToolBar.Buttons(intIndex).Image = intPicture
End Sub



'设置某一文本框为选定状态
Public Sub setselect(Txt As TextBox)
    Txt.SetFocus
    Txt.SelStart = 0
    Txt.SelLength = Len(Txt.Text)
End Sub

'琐定与解琐文本框，txttobelocked 为文本框数组
Public Sub locktxt(blnlock As Boolean, Txttobelocked As Object)
    Dim txttmp As TextBox
    For Each txttmp In Txttobelocked
        txttmp.Enabled = Not blnlock
    Next
    Set txttmp = Nothing
End Sub

Public Sub autoreturn(Key As Integer)
    If Key = 13 Then
        Key = 0
        SendKeys ("{tab}")
    End If
End Sub


'--------------------------------------------------------------------------------
'功能：      判断一个变量是否为空
'参数说明：
'            一个Variant类型的变量
'返回值：
'            如果入口参数的值为Nothing,Null或者"",则返回True；否则为False
'作者：Activeer
'--------------------------------------------------------------------------------
Public Function IsVacancy(var As Variant) As Boolean
    
    On Error GoTo DoError
    If TypeName(var) = "Nothing" Then
       IsVacancy = True
    ElseIf IsNull(var) Then
       IsVacancy = True
    ElseIf IsEmpty(var) Then
       IsVacancy = True
    ElseIf Trim(var) = "" Then
       IsVacancy = True
    End If
    Exit Function
DoError:
    MsgBox "判断是否为空错误：" & err.Description, vbOKOnly + vbInformation
End Function




'--------------------------------------------------------------------------------
'功能：    根据“制品类型编码”得到相应的“制品类型名称”
'参数说明：
'          strProduceTypeNo   制品类型编码
'返回值：  (string)
'          如果能查询到则为制品类型名称；否则为" "
'--------------------------------------------------------------------------------
Public Function GetProduceType(ByVal strProduceTypeNo As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetProduceType
    GetProduceType = ""
    If Trim(strProduceTypeNo) = "" Then Exit Function
    strSQL = "select ChrProduceType from ProduceType where ChrProduceNo ='" & Trim(strProduceTypeNo) & "'"
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetProduceType = Trim(rst!ChrProduceType)
    Else
       MsgBox "制品类型表中不存在该制品类型编码，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetProduceType:
   MsgBox err.Description
End Function
'--------------------------------------------------------------------------------
'功能：    根据“制品类型名称”得到相应的“制品类型编码”
'参数说明：
'          strProduceType   制品类型名称
'返回值：  (string)
'          如果能查询到则为制品类型编码；否则为" "
'--------------------------------------------------------------------------------
Public Function GetProduceTypeNo(ByVal strProduceType As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetProduceType
    GetProduceTypeNo = ""
    If Trim(strProduceType) = "" Then
       Exit Function
    End If
    strSQL = "select ChrProduceNo from ProduceType where  ChrProduceType='" & Trim(strProduceType) & "'"
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetProduceTypeNo = Trim(rst!ChrProduceNo)
    Else
       MsgBox "制品类型表中不存在该制品类型名称，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetProduceType:
   MsgBox err.Description
End Function



'--------------------------------------------------------------------------------
'功能：    根据“图书类型编码”得到相应的“图书类型名称”
'参数说明：
'          strBookTypeNo   图书类型编码
'返回值：  (string)
'          如果能查询到则为图书类型名称；否则为" "
'--------------------------------------------------------------------------------
Public Function GetBookType(ByVal strBookTypeNo As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetBookType
    GetBookType = ""
    If Trim(strBookTypeNo) = "" Then Exit Function
    strSQL = "select ChrBookType from BookType where chrBookTypeNo ='" & Trim(strBookTypeNo) & "'"
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetBookType = Trim(rst!ChrBookType)
    Else
       MsgBox "图书类型表中不存在该图书类型编码，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetBookType:
   MsgBox err.Description
End Function
'--------------------------------------------------------------------------------
'功能：    根据“图书类型名称”得到相应的“图书类型编码”
'参数说明：
'          strBookType   图书类型名称
'返回值：  (string)
'          如果能查询到则为图书类型编码；否则为" "
'--------------------------------------------------------------------------------
Public Function GetBookTypeNo(ByVal strBookType As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetBookType
    GetBookTypeNo = ""
    If Trim(strBookType) = "" Then
       Exit Function
    End If
    strSQL = "select chrBookTypeNo from BookType where  ChrBookType='" & Trim(strBookType) & "'"
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetBookTypeNo = Trim(rst!chrBookTypeNo)
    Else
       MsgBox "图书类型表中不存在该图书类型名称，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetBookType:
   MsgBox err.Description
End Function




'--------------------------------------------------------------------------------
'功能：    根据“供应商、客户编码”得到相应的“供应商、客户名称”
'参数说明：
'          strClientNo   供应商、客户编码
'返回值：  (string)
'          如果能查询到则为供应商、客户名称；否则为" "
'--------------------------------------------------------------------------------
Public Function GetClient(ByVal strClientNo As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetClient
    GetClient = ""
    If Trim(strClientNo) = "" Then Exit Function
    strSQL = "select ChrClientName from ClientData where chrClientNo ='" & Trim(strClientNo) & "'"
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetClient = Trim(rst!ChrClientName)
    Else
       MsgBox "供应商、客户表中不存在该供应商、客户编码，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetClient:
   MsgBox err.Description
End Function
'--------------------------------------------------------------------------------
'功能：    根据“供应商、客户名称”得到相应的“供应商、客户编码”
'参数说明：
'          strClient   供应商、客户名称
'          intFlag     标志位：0   供应商；  1      客户
'返回值：  (string)
'          如果能查询到则为供应商、客户编码；否则为" "
'--------------------------------------------------------------------------------
Public Function GetClientNo(ByVal strClient As String, intFlag As Integer) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetClient
    GetClientNo = ""
    If Trim(strClient) = "" Then
       Exit Function
    End If
    strSQL = "select chrClientNo from ClientData where  ChrClientName='" & Trim(strClient) & "' and intFlag=" & intFlag
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetClientNo = Trim(rst!chrClientNo)
    Else
       MsgBox "供应商、客户表中不存在该供应商、客户名称，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetClient:
   MsgBox err.Description
End Function



'--------------------------------------------------------------------------------
'功能：    根据“出版社编码”得到相应的“出版社名称”
'参数说明：
'          chrCompanyNO   出版社编码
'返回值：  (string)
'          如果能查询到则为出版社名称；否则为" "
'--------------------------------------------------------------------------------
Public Function GetCompanyName(ByVal chrCompanyNo As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetCompanyName
    GetCompanyName = ""
    If Trim(chrCompanyNo) = "" Then Exit Function
    strSQL = "select ChrCompanyName from PublishingCompanyData where chrCompnayNo ='" & Trim(chrCompanyNo) & "'"
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetCompanyName = Trim(rst!ChrCompanyName)
    Else
       MsgBox "出版社表中不存在该出版社编码，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetCompanyName:
   MsgBox err.Description
End Function
'--------------------------------------------------------------------------------
'功能：    根据“出版社名称”得到相应的“出版社编码”
'参数说明：
'          strCompanyNo   出版社名称
'返回值：  (string)
'          如果能查询到则为出版社编码；否则为" "
'--------------------------------------------------------------------------------
Public Function GetCompanyNoNo(ByVal strCompanyNo As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetCompanyNo
    GetCompanyNoNo = ""
    If Trim(strCompanyNo) = "" Then
       Exit Function
    End If
    strSQL = "select chrCompanyNo from PublishingCompanyData where  ChrCompanyName='" & Trim(strCompanyNo) & "'"
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetCompanyNoNo = Trim(rst!chrCompnayNo)
    Else
       MsgBox "出版社表中不存在该出版社名称，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetCompanyNo:
   MsgBox err.Description
End Function



'--------------------------------------------------------------------------------
'功能：    根据“库区编码”得到相应的“库区名称”
'参数说明：
'          strStorageNo   库区编码
'返回值：  (string)
'          如果能查询到则为库区名称；否则为" "
'--------------------------------------------------------------------------------
Public Function GetStorageName(ByVal strStorageNo As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetStorageName
    GetStorageName = ""
    If Trim(strStorageNo) = "" Then Exit Function
    strSQL = "select ChrStorageName from StorageSection where ChrStorageNo ='" & Trim(strStorageNo) & "'"
    Set rst = cN.Execute(strSQL)
    If rst.Recordcount <> 0 Then
       GetStorageName = Trim(rst!ChrStorageName)
    Else
       MsgBox "库区表中不存在该库区编码，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetStorageName:
   MsgBox err.Description
End Function
'--------------------------------------------------------------------------------
'功能：    根据“库区名称”得到相应的“库区编码”
'参数说明：
'          strCompanyNo   库区名称
'返回值：  (string)
'          如果能查询到则为库区编码；否则为" "
'--------------------------------------------------------------------------------
Public Function GetStorageNo(ByVal strStorageName As String) As String
    Dim rst As New ADODB.Recordset
    On Error GoTo error_GetStorageNo
    GetStorageNo = ""
    If Trim(strStorageName) = "" Then Exit Function
    strSQL = "select ChrStorageNo from StorageSection where ChrStorageName='" & Trim(strStorageName) & "'"
    Set rst = cN.Execute(strSQL)
    If Not rst.EOF Then
       GetStorageNo = Trim(rst!ChrStorageNo)
    Else
       MsgBox "库区表中不存在该库区编码，确认输入是否有错", vbOKOnly, "错误"
    End If
    Exit Function
error_GetStorageNo:
   MsgBox err.Description
End Function


'--------------------------------------------------------------------------------
'功能：    根据“入库类型编码”得到相应的“入库类型名称”
'参数说明：
'          strInStorageNo   入库类型编码
'返回值：  (string)