super_mod1.bas

小型超市进销存系统

Attribute VB_Name = "super_md1"
Public Dblink As New wjz_Dblink
Private ExeCmd As New ADODB.Command
Public uName As String
Public uPower As Integer
Rem 王继州
Public wjz_Backid As String
Public wjz_Orderid As String


Rem 杨峙凌
Public YZLAddgoods As Boolean
Public Ostate As Boolean '定义查看定单资料窗体的属性
Public Pstate As Boolean '定义查看供应商资料窗体的属性
Rem 张超
Public strB As String
Rem 郭井泉
Public GJQ_strsql As String
Public gjq_Response As String
Public gjq_IntOldrow As String
Rem 王继州
Public Function newid(ByVal Strname As String, ByVal Strcolumn As String) As String
Dim Pras(2) As New ADODB.Parameter
Set ExeCmd = Nothing
With ExeCmd
    .ActiveConnection = Dblink.cn
    .CommandType = adCmdStoredProc
    .CommandText = "proid"
End With

'帮定第一个
With Pras(0)
    .Type = adBSTR
    .Size = Len(Strname)
    .Direction = adParamInput
    .Value = Strname
End With
ExeCmd.Parameters.Append Pras(0)
'帮定第二个
With Pras(1)
    .Type = adBSTR
    .Size = Len(Strcolumn)
    .Direction = adParamInput
    .Value = Strcolumn
End With
ExeCmd.Parameters.Append Pras(1)
'帮定第三个,是需要返回的值
With Pras(2)
    .Type = adVarChar
    .Size = 20
    .Direction = adParamOutput
End With
ExeCmd.Parameters.Append Pras(2)


ExeCmd.Execute
newid = Pras(2)
End Function

Public Sub Bgdadd(ParamArray cpr())
Dim i As Variant, Pars As ADODB.Parameter
Dim j As Integer, K As Integer
For Each i In cpr
     j = j + 1
Next i
'MsgBox j

Set ExeCmd = Nothing
With ExeCmd
    .ActiveConnection = Dblink.cn
    .CommandType = adCmdStoredProc
    .CommandText = "wjz_bgdadd"
End With
'帮定参数
For K = 0 To j - 2
Set Pars = ExeCmd.CreateParameter(, adBSTR, adParamInput, Len(cpr(K)), cpr(K))
 ExeCmd.Parameters.Append Pars
Next K
 
Set Pars = ExeCmd.CreateParameter(, adInteger, adParamInput, , cpr(4))
ExeCmd.Parameters.Append Pars
ExeCmd.Execute

End Sub
Public Sub bgtadd(ParamArray cpr())
Dim i As Integer, Pars As ADODB.Parameter
Set ExeCmd = Nothing

With ExeCmd
    .ActiveConnection = Dblink.cn
    .CommandType = adCmdStoredProc
    .CommandText = "wjz_bgtadd"
End With
For i = 0 To 2
Set Pars = ExeCmd.CreateParameter(, adBSTR, adParamInput, Len(cpr(i)), cpr(i))
ExeCmd.Parameters.Append Pars
Next i
ExeCmd.Execute
End Sub

Public Sub PageSet(ByVal a As Integer, ByVal PageS As Integer, ByVal sumpage As Integer, Contrl As Object, rs As ADODB.Recordset)
If a > sumpage Or a < 1 Then Exit Sub
rs.PageSize = PageS
rs.AbsolutePage = a
Contrl.MSFshow.Clear
For i = 0 To PageS
    For j = 0 To rs.Fields.Count - 1
    If Not IsNull(rs.Fields(j)) Then Contrl.MSFshow.TextMatrix(i + 1, j + 1) = rs.Fields(j)
              
    Next j
    rs.MoveNext
    If rs.EOF Then
    MsgBox "已经到了记录的结尾！"
    Exit Sub
    End If
Next i
rs.MovePrevious
End Sub
Public Sub SaveSize(ByVal Wobj As Object)
Dim i As Control
Dim str As String
Wobj.Tag = Wobj.Top & "," & Wobj.Left & "," & Wobj.Width & "," & Wobj.Height & "," & Wobj.FontSize
For Each i In Wobj
 i.Tag = i.Top & "," & i.Left & "," & i.Width & "," & i.Height & "," & i.FontSize
Next
End Sub
Public Sub ChangSize(ByVal Wobj As Object)
Dim i As Control, K As Single
Dim arr() As String
Dim stra As String
stra = Wobj.Tag
arr = Split(stra, ",")
K = (Wobj.Width / Val(arr(2)) + Wobj.Height / Val(arr(3))) / 2
Wobj.Tag = Wobj.Top & "," & Wobj.Left & "," & Wobj.Width & "," & Wobj.Height & "," & Wobj.FontSize

For Each i In Wobj
stra = i.Tag
arr = Split(stra, ",")
i.Top = Val(arr(0)) * K
i.Left = Val(arr(1)) * K
i.Width = Val(arr(2)) * K
If Not TypeOf i Is ComboBox Then
i.Height = Val(arr(3)) * K
i.FontSize = Val(arr(4)) * K
End If
i.Tag = i.Top & "," & i.Left & "," & i.Width & "," & i.Height & "," & i.FontSize
Next
End Sub
Rem 杨峙凌
Public Sub YZLRefMSHFlexGrid(frmname As Object, sql As String) '刷新网格
    frmname.MSHFlexGrid1.ColWidth(0) = 300
    
    Set frmname.MSHFlexGrid1.DataSource = Dblink.executeSQL(sql)
End Sub

Public Function YZLKpress(KA As Integer) As Double '声明函数，让文本框中输入的'''变成'‘'
    If KA = 39 Then KA = -24146
    YZLKpress = KA
End Function

Rem 张超
Public Sub Page(ByVal boE As String)
 Dim i As Integer
 Dim intRow As Integer
 Dim intCol As Integer
    frmZCddMore.MHF.Clear
        frmZCddMore.MHF.Cols = Dblink.rs.Fields.Count + 1
        For i = 1 To Dblink.rs.Fields.Count
         frmZCddMore.MHF.TextMatrix(0, i) = Dblink.rs.Fields(i - 1).name
        Next i
        For intRow = 1 To Dblink.rs.PageSize
              For intCol = 1 To Dblink.rs.Fields.Count
                frmZCddMore.MHF.TextMatrix(intRow, intCol) = Dblink.rs.Fields(intCol - 1).Value
              Next intCol
            Dblink.rs.MoveNext
            If boE = "b" Then
             If Dblink.rs.BOF = True Then Exit Sub
            Else
             If Dblink.rs.EOF = True Then Exit Sub
            End If
        Next intRow
 End Sub
Public Sub Cmd(KeyAscii As Integer)
   If ((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8 Or KeyAscii = 46 Or KeyAscii = 13) Then
      If KeyAscii = 13 Then
        SendKeys "{TAB}"
      Else
       Exit Sub
      End If
   Else
     KeyAscii = 0
   End If
End Sub
Public Sub Cmd1(KeyAscii As Integer)
 If KeyAscii = 39 Then KeyAscii = -24146
 If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub

'验证身份证(郭井泉)
Public Function IsErrorCode(strText As String) As String
  '验证数据是否有错
  
    Dim stryear As String, strmonth As String, strday As String
    Dim intsex As Integer

    If Len(strText) <> 15 And Len(strText) <> 18 Then
        MsgBox "您输入的身份证位数不对！请检查。"
        Exit Function
    End If
            
    If Len(strText) = 15 Then
        strmonth = Mid(strText, 9, 2)
        strday = Mid(strText, 11, 2)
        stryear = Mid(strText, 7, 2)
        If Val(stryear) > 9 Then
            stryear = "19" & stryear
        Else
            stryear = "20" & stryear
        End If
        intsex = Mid(strText, 15, 1)
        
    ElseIf Len(strText) = 18 Then
        strmonth = Mid(strText, 11, 2)
        strday = Mid(strText, 13, 2)
        stryear = Mid(strText, 7, 4)
        intsex = Mid(strText, 17, 1)
    End If
    
    If Val(strmonth) > 12 Then
        MsgBox "您输入的身份证月份不对！请检查。"
        Exit Function     '确认有错，退出
    End If
        
    Select Case strmonth
        Case "02"
            If (stryear Mod 100 = 0 And stryear Mod 400 = 0) Then
                 If Val(strday) > 30 Then
                    Exit Function
                 End If
            End If
            If Val(stryear) Mod 100 <> 0 Or Val(stryear) Mod 400 = 0 Then
                 If Val(strday) > 29 Then
                    Exit Function
                  MsgBox "您输入的身份证日期不对！请检查。"
                Exit Function
                End If
            End If
        Case "01", "03", "05", "07", "08", "10", "12"
            If Val(strday) > 31 Then
                MsgBox "您输入的身份证日期不对！请检查。"
                Exit Function
            End If
        
        Case "04", "06", "09", "11"
    
            If Val(strday) > 30 Then
                MsgBox "您输入的身份证日期不对！请检查。"
                Exit Function
            End If
    End Select
 
 IsErrorCode = stryear & "-" & strmonth & "-" & strday
End Function