pub_me.bas

vb不酒店管理系统

Attribute VB_Name = "pub_me"
Option Explicit

'***********************************************************************
'* 功    能 : 给两列Combobox控件赋值
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.01
'* 修改日期 : 1999.03.04
'* 参数说明:  tp_com     : 控件的名称
'*            tp_table   : 所使用的表名
'*            tp_fdname0 : 代码字段的字段名
'*            tp_fdname1 : 名称字段的字段名
'***********************************************************************
Public Sub PUB_GetCMDB(tp_data As Database, tp_com As Control, tp_table As String, tp_fdname0 As String, tp_fdname1 As String)

    Dim i As Integer
    Dim tp_rec As Recordset
    Dim tp_recordcount As Integer

    tp_com.Clear
    
    Set tp_rec = tp_data.OpenRecordset("select " & tp_fdname0 & "," & tp_fdname1 & " from " & tp_table & " order by " & tp_fdname0, 4, 0, 2)
    If Not tp_rec.BOF Then
        tp_rec.MoveLast
        tp_recordcount = tp_rec.RecordCount
        
        tp_rec.MoveFirst

        For i = 0 To tp_recordcount - 1
            tp_com.AddItem
            tp_com.List(i, 0) = tp_rec.Fields(tp_fdname0)
            tp_com.List(i, 1) = tp_rec.Fields(tp_fdname1)
            tp_rec.MoveNext
        Next i
    End If
    tp_rec.Close

End Sub

'***********************************************************************
'* 功    能 : 根据代码生成名称
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.06
'* 修改日期 : 1999.03.06
'* 参数说明:  tp_dm : 代码字段控件名
'*            tp_mc : 名称字段控件名
'***********************************************************************

Public Function PUB_GetCMName(tp_dm As Control, tp_cm As Control) As Boolean

    Dim i As Integer
    Dim tp_rt As Boolean

    tp_rt = False

    For i = 0 To tp_cm.ListCount - 1
        If Trim(tp_cm.List(i, 0)) = Trim(tp_dm.Text) Then
            tp_cm.Text = Trim(tp_cm.List(i, 1))
            tp_rt = True
            Exit For
        End If
    Next i

    PUB_GetCMName = tp_rt
    
End Function

'************************************************************************************
'* 功    能 : 根据名称查找代码; 若该名称和代码为一组时, 则退出, 否则,按照名称查找代码
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.06
'* 修改日期 : 1999.03.06
'* 参数说明:  tp_dm : 代码字段控件名
'*            tp_mc : 名称字段控件名
'************************************************************************************
Public Function PUB_GetTXCode(tp_dm As Control, tp_cm As Control) As Boolean

    Dim i As Integer
    Dim tp_rt As Boolean
    Dim tp_find As Boolean

    tp_rt = False
    tp_find = False

    For i = 0 To tp_cm.ListCount - 1
        If Trim(tp_cm.List(i, 1)) = Trim(tp_cm.Text) Then
            tp_dm.Text = Trim(tp_cm.List(i, 0))
            tp_rt = True
            Exit For
        End If
    Next i
    
    PUB_GetTXCode = tp_rt

End Function

'**************************************************************************************************
'*  功    能 : 在字典表中, 代码字段失去焦点时的处理
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.08
'*  修改日期 : 1999.03.08
'**************************************************************************************************
Public Sub PUB_DMLostFocus(temp_dm As Control, temp_mc As Control, temp_frmmsg As Control, temp_msg As String)
    Dim temp_rt As Boolean
    
    temp_frmmsg.Visible = False
    temp_frmmsg.Caption = ""
    
    If Trim(temp_dm.Text) = "" Or Trim(temp_dm.Text) = "*" Then
        temp_mc.Text = "*"
    Else
        temp_rt = PUB_GetCMName(temp_dm, temp_mc)
        If temp_rt Then
        Else
            temp_frmmsg.Visible = True
            temp_frmmsg.Caption = temp_msg
            temp_dm.SetFocus
        End If
    End If
End Sub


'**************************************************************************************************
'*  功    能 : 在字典表中, 名称字段失去焦点时的处理
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.08
'*  修改日期 : 1999.03.08
'**************************************************************************************************
Public Function PUB_MCLostFocus(temp_dm As Control, temp_mc As Control, temp_frmmsg As Control, temp_msg As String) As Boolean
    
    temp_frmmsg.Visible = False
    temp_frmmsg.Caption = ""
    
    PUB_MCLostFocus = True
    
    If Trim(temp_mc.Text) = "" Then 'Or Trim(temp_mc.Text) = "*" Then
        temp_dm.Text = "*"
    Else
        PUB_MCLostFocus = PUB_GetTXCode(temp_dm, temp_mc)
        If Not PUB_MCLostFocus Then
            If Trim(temp_mc.Text) = "*" Then
                temp_dm.Text = "*"
            Else
                temp_frmmsg.Visible = True
                temp_frmmsg.Caption = temp_msg
                temp_dm.SetFocus
            End If
        End If
    End If

End Function

'**************************************************************************************************
'*  功    能 : 日期型字段校验
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.15
'*  修改日期 : 1999.03.15
'**************************************************************************************************
Public Function PUB_RQJY(temp_rq As Control, temp_msg As Control) As Boolean
    
    PUB_RQJY = True
    If Trim(temp_rq.Text) = "____-__-__" Then
    Else
        If Len(Trim(temp_rq)) = 10 Then
            If IsDate(Trim(temp_rq)) Then
            Else
                PUB_RQJY = False
            End If
        Else
            PUB_RQJY = False
        End If
    End If
    If Not PUB_RQJY Then
        temp_msg.Visible = True
        temp_msg.Caption = "不适当的日期型"
        temp_rq.SetFocus
    End If
End Function

'**************************************************************************************************
'*  功    能 : 数字型字段校验
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.15
'*  修改日期 : 1999.03.15
'**************************************************************************************************
Public Function PUB_SZJY(temp_sz As Control, temp_msg As Control) As Boolean
    
    temp_sz.Text = Trim(temp_sz.Text)
    PUB_SZJY = True
    If Trim(temp_sz) = "" Then
        temp_sz.Text = 0
    Else
        If IsNumeric(temp_sz.Text) Then
            If CDec(temp_sz.Text) >= 0 Then
            Else
                PUB_SZJY = False
            End If
        Else
            PUB_SZJY = False
        End If
    End If
    If Not PUB_SZJY Then
        temp_msg.Visible = True
        temp_msg.Caption = "不适当的数字"
        temp_sz.SetFocus
    End If
End Function

'************************************************************************************
'* 功    能 : 给单列的ComboBox控件赋值
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.10
'* 修改日期 : 1999.03.10
'* 参数说明 : tp_data   --  数据库名
'*            tp_table  --  表名
'*            tp_field  --  所选字段名
'*            tp_cm     --  COMBOX名
'************************************************************************************
Public Sub PUB_GetCMSG(tp_data As Database, tp_table As String, tp_field As String, tp_cm As Control)
    Dim i As Integer
    Dim temp_rec As Recordset
    
    tp_cm.Clear
    
    Set temp_rec = tp_data.OpenRecordset("SELECT " & Trim(tp_field) & " FROM " & Trim(tp_table) & " ORDER BY " & Trim(tp_field), 4, 0, 2)
    If Not temp_rec.BOF Then
        temp_rec.MoveLast
        temp_rec.MoveFirst
        
        Do While Not temp_rec.EOF
            tp_cm.AddItem Trim(temp_rec.Fields(Trim(tp_field)))
            temp_rec.MoveNext
        Loop
    End If
    temp_rec.Close
    
End Sub