module1.bas

驾驶员考试系统界面不错在98下运行C/S模式

Attribute VB_Name = "Module1"
Public Declare Function GetTickCount Lib "kernel32" () As Long
Declare Function pci7502check Lib "pci7502.dll" (ByVal dwVendorID%, ByVal dwDeviceID%, ByVal fUseInt As Boolean, ByVal cardNO%) As Long

Declare Function pci7502di Lib "pci7502.dll" (ByVal hplx As Long, ByVal addr As Boolean, ByVal ch%) As Integer

Declare Sub pci7502do Lib "pci7502.dll" (ByVal hplx As Long, ByVal addr As Boolean, ByVal ch%, ByVal data%)

Declare Function pci7502close Lib "pci7502.dll" (ByVal hplx As Long) As Integer

Public hplx As Long
Public 快慢调节 As Integer
'Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public frmKsload As Boolean
Public frmKsadd As Boolean
Public Kgmc As String     '登陆的考官名称
Public Kgqx As String
Public i, j, k As Integer
Public txtStr(12) As String
Public Const nCarLine = 19  '考车行走的线段数目
Public Ico文件名(0 To 5) As String
Public varSendCode As Variant
Public Frmmainload As Boolean
Public zhcxTJ As String   '  综合查询条件
Public zhcxSql As String
Public dwmc As String      '单位名称
'--------------------------------
Public Sstr1, Sstr2, Sstr3, Sstr4, Sstr5 As String
Public llll As Integer
Public ltime, kttime As Integer
 Public tttt0, tttt1, tttt2, tttt3, tttt4, tttt5 As Integer
 Public zttime, zttimes As Integer '中停时间


Function tc_db(gd1 As Control, x As Integer)
    With gd1
        .Rows = 1
        Do Until Res.EOF ' .EOF '循环直到库记录的结尾
            .Rows = .Rows + 1
            .Row = .Rows - 1
            .Col = 0
            .Text = .Row '以上为直接添加序
            .CellAlignment = flexAlignCenterCenter
                 For j = 1 To x
                .Col = j
                .CellAlignment = flexAlignCenterCenter
                .Text = IIf(IsNull(Res.Fields(j - 1)), "", Res.Fields(j - 1))
            Next j
            Res.MoveNext
        Loop
        .Refresh '刷新
    End With
End Function
'----------------------------------------
Public Sub TimeDelay(TT As Long)
  Dim t As Long
  t = GetTickCount()
  Do
    DoEvents
    If GetTickCount - t < 0 Then t = GetTickCount
  Loop Until GetTickCount - t >= TT
End Sub





'十进制转二进制
Public Function DectoBin(x As Integer) As String
Dim y(1 To 8) As String
Dim i As Integer
     For i = 1 To 8
         y(i) = "0"
     Next i
     
     i = 1
     While (x \ 2)
        y(i) = CInt(x Mod 2)
        x = x \ 2
        i = i + 1
     Wend
        y(i) = x
Dim s As String
     For i = 8 To 1 Step -1
        s = s & y(i)
     Next i
     DectoBin = s
End Function
'二进制转十进制
Public Function BintoDec(s As String) As Integer
Dim total, i As Integer
         total = 0
         For i = 8 To 1 Step -1
            total = total + Mid(s, i, 1) * (2 ^ (8 - i))
         Next i
        BintoDec = total
End Function

Public Sub RFcar(FileName As String)
    Dim nFileHandle, DataLine As String
    On Error GoTo ReadFileErr
    nFileHandle = FreeFile
    Open FileName For Input As #nFileHandle
        For i = 0 To 12
            Line Input #nFileHandle, DataLine
            txtStr(i) = Val(DataLine)
        Next i
    Close #nFileHandle
    Exit Sub
ReadFileErr:
    MsgBox Err.Description
End Sub
Public Sub WFcar(FileName As String)
    Dim nFileHandle, DataLine As String
    On Error GoTo WriteFileErr
    nFileHandle = FreeFile
    Open FileName For Output As #nFileHandle
        For i = 0 To 12
            Print #nFileHandle, txtStr(i)
        Next i
    Close #nFileHandle
    Exit Sub
WriteFileErr:
    MsgBox Err.Description
End Sub

Public Sub gj(nline As Integer)
    '划轨迹线
Select Case nline
    Case 0
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 720: frmks.gjline.Y1 = 4560
    Case 1
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2280: frmks.gjline.Y1 = 4560
    Case 2
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 3120: frmks.gjline.Y1 = 3720
    Case 3
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 3120: frmks.gjline.Y1 = 3240
    Case 4
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 3120: frmks.gjline.Y1 = 1560
    Case 5
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2880: frmks.gjline.Y1 = 3000
    Case 6
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2640: frmks.gjline.Y1 = 1560
    Case 7
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2520: frmks.gjline.Y1 = 3000
    Case 8
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2280: frmks.gjline.Y1 = 1560
    Case 9
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 3240: frmks.gjline.Y1 = 3000
    Case 10
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 3240: frmks.gjline.Y1 = 3600
    Case 11
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 3600: frmks.gjline.Y1 = 4080
    Case 12
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 4800: frmks.gjline.Y1 = 4560
    Case 13
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2880: frmks.gjline.Y1 = 4560
    Case 14
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2280: frmks.gjline.Y1 = 3720
    Case 15
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2280: frmks.gjline.Y1 = 3000
    Case 16
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2160: frmks.gjline.Y1 = 1560
    Case 17
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2040: frmks.gjline.Y1 = 3240
    Case 18
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 2040: frmks.gjline.Y1 = 3720
    Case 19
    frmks.gjline.Visible = False
    frmks.gjline.X1 = 1800: frmks.gjline.Y1 = 4200
     
End Select
frmks.gjline.X2 = frmks.ImageCar.Left + 0.5 * frmks.ImageCar.Width
frmks.gjline.Y2 = frmks.ImageCar.Top + 0.5 * frmks.ImageCar.Height
frmks.gjline.Visible = True

End Sub