Attribute VB_Name = "公共內(nèi)容"
Public db As Connection
Public number As String '主從關(guān)系值
Public trimstring As String  '錄入一個(gè)符查詢
Public Checkflag As String   '檢測(cè)各個(gè)FORM
Public checkform As String
Public destvalue As String
Public findflag As String
Public pubfindtb As Recordset
Public sqlcc1 As String
Public sqlcc2 As String
Public opvalue As String
Public namevalue As String
Public passvalue As String
Public exitflag As String
Public mzhiwu As String '職務(wù)
Public rs As DAO.Recordset
Public DataBaseName As String
Public PCheck As String
Public Pdelete As Boolean

Public PreportType As String

Public ChFindflag As String
Public ChAddflag As String
Public PcheckStk As String
Public SqlConn As String
Public SqlConn1 As String



'-----------------------
Global Const MSG1 = "數(shù)據(jù)已經(jīng)存在,不能重復(fù)"
Global Const MSG2 = "提示信息"
Global Const HELP1 = " A:增加,D:刪除 S:查找,C:修改,F2:取消 B:明細(xì) F4:保存 "

Sub main()
        If App.PrevInstance Then
           MsgBox "程式已經(jīng)啟動(dòng)，不能再開(kāi)！！！", vbCritical
           Exit Sub
           
        Else
        frmSplash.Show
        End If

End Sub


'--------------------------------
 '  這個(gè)過(guò)程主要用來(lái)查詢明細(xì)編碼
'--------------------------------
Public Sub ptnofind(tb1 As Recordset, str As String, number As String)

    '如果數(shù)據(jù)庫(kù)為空時(shí)退出
    If tb1.RecordCount = 0 Then Exit Sub

    '錄入資料
    Dim aa As Variant, strvalue As String, stresult As String
    aa = tb1.Bookmark
    strvalue = InputBox$("請(qǐng)輸入要查詢的" & str & "資料:", MSG2)
    If strvalue = "" Then Exit Sub
    strvalue = Mid(strvalue, 1, 25)
    stresult = number & " like " & "'" & strvalue & "*" & "'"

    '開(kāi)始查找
    tb1.MoveFirst
    tb1.Find stresult

    '開(kāi)始查找
    If tb1.EOF Then
        MsgBox "沒(méi)有此" & str & "的基本資料!!!", vbCritical + vbOKOnly, MSG2
        tb1.Bookmark = aa
    End If
End Sub


'-------------------------------------
'   這個(gè)過(guò)程在報(bào)表打印時(shí)進(jìn)行初始化
'-------------------------------------
Public Sub printini(DAO As DDActiveReports.DataControl, name As DDActiveReports.ActiveReport)
    With DAO
      .ConnectionString = SqlConn
      .Source = sqlcc2
     .Refresh
    End With
    
    With name
      .TOCEnabled = False
      .Toolbar.Tools(2).Caption = "打印..."
      .Toolbar.Tools(12).Caption = "前一頁(yè)..."
      .Toolbar.Tools(13).Caption = "下一頁(yè)..."
      .PrintWidth = 11200
    End With
    
End Sub

'--------------------------------------
'   這個(gè)過(guò)程將在選擇得到焦點(diǎn)時(shí)產(chǎn)生全選
'-------------------------------------
Public Sub gotfocus(txtfields As TextBox)
    txtfields.SelStart = 0
    txtfields.SelLength = Len(txtfields.Text)
End Sub

'--------------------------------------
'   這個(gè)過(guò)程將在初始化資料
'-------------------------------------
Public Sub Preport(ReportTypeA As String, ChkFLAG As String)
  PreportType = ReportTypeA
  PCheck = ChkFLAG
  frmprint.Show 1
End Sub

'------------------------------------------------------------
'   這個(gè)過(guò)程轉(zhuǎn)換錄入時(shí)大小寫(xiě)，并按鍵時(shí)使其它按按鈕得到焦點(diǎn)
'------------------------------------------------------------
Public Sub EnterDown(KeyAscii As Integer, stextbox As Object, cmd As CommandButton, Index As Integer, max As Integer)
     If KeyAscii >= Asc("a") And KeyAscii <= Asc("z") Then KeyAscii = KeyAscii + Asc("A") - Asc("a")
     If KeyAscii = 13 Then
        If Index <> max Then
           Index = Index + 1
           stextbox(Index).SetFocus
        Else
           cmd.SetFocus
        End If
     End If
End Sub


'---------------------------------------------------
'   這個(gè)過(guò)程對(duì)各種不同的單據(jù)進(jìn)行查詢單號(hào)
'---------------------------------------------------
Public Sub Numberfind(tb1 As Recordset, str As String, number As String)
    If tb1.RecordCount = 0 Then Exit Sub
    Dim aa As Variant, strvalue As String, stresult
    aa = tb1.Bookmark
    strvalue = InputBox$("請(qǐng)輸入要查詢的" & str & "單號(hào):", MSG2)
    If strvalue = "" Then Exit Sub
    strvalue = Mid(strvalue, 1, 11)
    stresult = number & " like " & "'" & strvalue & "*" & "'"

    '查找相關(guān)的值
    tb1.MoveFirst
    tb1.Find stresult

    '開(kāi)始查找
    If tb1.EOF Then
        MsgBox "沒(méi)有此" & str & "的基本資料!!!", vbCritical + vbOKOnly, MSG2
        tb1.Bookmark = aa
    End If
End Sub

'-----------------------------------------
'  設(shè)置文本框的焦點(diǎn)(上，下光標(biāo)移動(dòng))
'-----------------------------------------
Sub focusSet(ByRef KeyCode As Integer, objArr As Object, Index As Integer) ', maxIndex As Integer, minIndex As Integer)
    Select Case KeyCode
    Case vbKeyUp
        If Index > objArr.LBound Then
            objArr(Index - 1).SetFocus
            KeyCode = 0
        End If
    Case vbKeyDown
        If Index < objArr.UBound Then
            objArr(Index + 1).SetFocus
            KeyCode = 0
        End If
    End Select
End Sub


'------------------------------------------------------------
'這個(gè)子過(guò)程用它的 Err 碼顯示錯(cuò)誤信息，并且
'如果是數(shù)據(jù)訪問(wèn)類(lèi)型錯(cuò)誤，就提示顯示 Errors 集合
'------------------------------------------------------------
Sub ShowError()
    Dim sTmp As String
    Screen.MousePointer = vbDefault

    sTmp = "發(fā)生了下面的錯(cuò)誤：" & vbCrLf & vbCrLf
    '添加錯(cuò)誤字符串
    sTmp = sTmp & err.Description & vbCrLf
    '添加錯(cuò)誤號(hào)
    sTmp = sTmp & err
  
    Beep
    '檢查看錯(cuò)誤是否源于數(shù)據(jù)庫(kù) errors 集合
    If DBEngine.Errors.Count > 0 Then
        If DBEngine.Errors(0).number = err Then
        '添加錯(cuò)誤提示顯示 errors 集合
        sTmp = sTmp & vbCrLf & vbCrLf
        '鳴笛并顯示錯(cuò)誤
        If MsgBox(sTmp, vbYesNo + vbQuestion) = vbYes Then
             Exit Sub
        End If
        Else
        MsgBox sTmp
        End If
    Else
        MsgBox sTmp
    End If
End Sub

'-----------------------------------
' 限制只允許輸入數(shù)字，小數(shù)點(diǎn)
'-----------------------------------
Public Sub ChkNum(ChkFLAG As String, KeyAscii As Integer, obj As Object, Index As Integer)
  If ChkFLAG = "True" Then
     If KeyAscii = 8 Then
           ElseIf KeyAscii = 46 Then
           If InStr(1, obj(Index).Text, ".") <> 0 Then
                 KeyAscii = 0
                 Beep
           End If
     ElseIf KeyAscii < 48 Or KeyAscii > 57 Then
                KeyAscii = 0
                Beep
     End If
  End If
End Sub

'-------------------------------------------
' 查找資料
'--------------------------------------------
Public Sub GenBrowse(mtrimstring As String, mcheckform As String, mcheckflag As String)
   checkform = mcheckform
   trimstring = mtrimstring
   Checkflag = mcheckflag
   frmgenbrowse.Show 1
End Sub
'---------------------------------------------
'   顯示操作員
'----------------------------------------------
Public Sub opdisplay(txtuserid As String, lblop As Label)
    Dim emptb As Recordset
    Set emptb = New Recordset
    emptb.Open "select op,name from op where op=" & "'" & txtuserid & "'", db, adOpenStatic, adLockOptimistic
    If emptb.RecordCount <> 0 Then
         lblop.Caption = emptb!name
    Else
         lblop.Caption = ""
    End If
End Sub

'---------------------------------------------
'   顯示客戶名稱
'----------------------------------------------
Public Sub clientdisplay(tabledef As String, num As String, lblvendor As Label)
    Dim clienttb As New Recordset
    Set clienttb = New Recordset
    clienttb.Open "select * from " & tabledef & " where clino=" & "'" & num & "'", db, adOpenStatic, adLockOptimistic
    If clienttb.RecordCount <> 0 Then
         If IsNull(clienttb!s_name) = False Then
            lblvendor.Caption = clienttb!s_name
          Else
            lblvendor.Caption = ""
         End If
    Else
        lblvendor.Caption = ""
    End If
End Sub