sf.frm

停车

      ForeColor       =   &H000040C0&
      Height          =   315
      Left            =   1920
      TabIndex        =   10
      Top             =   5790
      Width           =   3300
   End
   Begin VB.Image Image1 
      Height          =   5025
      Left            =   6930
      Stretch         =   -1  'True
      Top             =   30
      Width           =   6750
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   8460
      TabIndex        =   6
      Top             =   6990
      Width           =   3000
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "入场时间："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   7230
      TabIndex        =   4
      Top             =   6990
      Width           =   1275
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "车牌颜色："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Index           =   0
      Left            =   7230
      TabIndex        =   3
      Top             =   6258
      Width           =   1275
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "车牌号码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   7230
      TabIndex        =   2
      Top             =   5892
      Width           =   1275
   End
End
Attribute VB_Name = "DJ1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const OPD_NONE = 0
Private Const OPD_CAPTURE = 1
Private Const OPD_CAPTURE_EX = 2
Private Const OPD_SNAP = 3
Private Const OPD_SNAP_EX = 4
Private Const OPD_PLAY_BACK = 5
Public g_nOperation As Integer
Dim linkrs As New ADODB.Recordset
Dim RS As New ADODB.Recordset
Private Sub BrightnessText_Change()

End Sub

Private Sub CGCard_Move(ByVal lLeft As Long, ByVal lTop As Long)
    
    CGCard.SetOutputWindow lLeft, lTop, CGCard.Width, CGCard.Height
    
End Sub

Private Sub CGCard_SnapExChange(ByVal nNumber As Integer)
    
    CGCard.Transform nNumber

    If CGCard.VideoScan = FIELD Then
        CGCard.Interchange VERT_DOUBLE
        CGCard.Draw
    Else
       CGCard.Draw
    End If
    
    CGCard.TextOut 10, 10, "[e-mail]", True
       
End Sub


Private Sub Clear_Click()

    If g_nOperation = OPD_NONE Then
        CGCard.Clear
    End If
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then Combo2.SetFocus
End Sub

Private Sub Combo2_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Command1_Click
End Sub

Private Sub Command1_Click()
    Dim Chunk() As Byte
    Dim lngLengh As Long
    Dim intChunks As Integer
    Dim intFragment As Integer
    Dim i As Integer
    Const ChunkSize = 1000
    Const lngDataFile = 1
    If Label8.Caption = "" Then
        MsgBox "登记失败" & Chr(13) & "没有卡号 ", 0 + vbCritical, "系统提示。。。。"
        Exit Sub
    End If
    linkrs.Open "select * from rc where idh='" & Trim(Label8.Caption) & "'", Cn, 1, 3
    If Not linkrs.EOF Then
        MsgBox "登记失败" & Chr(13) & "卡号: " & Label8.Caption & "  已在使用中。。。。", 0 + vbCritical, "系统提示。。。。"
        linkrs.Close
        Exit Sub
    End If
    linkrs.AddNew
    Open App.Path & "\pic\dj.jpg" For Binary Access Read As lngDataFile
    lngLengh = LOF(lngDataFile)      '文件大小
    intChunks = lngLengh \ ChunkSize
    intFragment = lngLengh Mod ChunkSize
    ReDim Chunk(intFragment)
    Get lngDataFile, , Chunk()
    linkrs!tp.AppendChunk Chunk()
    ReDim Chunk(ChunkSize)
    For i = 1 To intChunks
        Get lngDataFile, , Chunk()
        linkrs!tp.AppendChunk Chunk()
    Next i
    Close lngDataFile
    linkrs("IDh") = Trim(Label8.Caption)
    linkrs("cph") = Trim(Text1.Text)
    linkrs("cps") = Trim(Combo1.Text)
    linkrs("clly") = Trim(Combo2.Text)
    linkrs("rcsj") = Trim(Label4.Caption)
    linkrs.Update
    linkrs.Close
    MsgBox "登记成功", 0 + vbExclamation, "系统提示"
    Text1.Text = "G"
    Text1.SetFocus
    Text1.SelStart = Len(Text1.Text)
End Sub


Private Sub Command2_Click()
  If Command2.Caption = "开　闸" Then
       MSComm2.DTREnable = True
       Command2.Caption = "关　闸"
   Else
       Command2.Caption = "开　闸"
       MSComm2.DTREnable = False
       MSComm2.RTSEnable = True
       Timer1.Enabled = True
   End If
End Sub

Private Sub Command3_Click()

End Sub

Private Sub MSComm1_OnComm()
   Dim RS As New ADODB.Recordset
   Dim Rrs As New ADODB.Recordset
   Dim Buffer As Variant '存储数据的缓冲区
   Dim CardNumber As Long '卡号
   Select Case MSComm1.CommEvent '串口事件
      Case comEvReceive '接收到数据
          Buffer = MSComm1.Input '清理接收缓冲区，此时，接收的字节数已经为0
          CardNumber = CDec(Buffer(4)) * 2 ^ 16 + (Buffer(5) * 2 ^ 8) + Buffer(6) '单个字节数据左移
          Label8.Caption = CardNumber
          Label4.Caption = format(Date, "yyyy年mm月dd日") & format(Time, "hh时nn分")
          RS.CursorLocation = adUseClient
          RS.Open "select cph,cps,ye ,xm from idyh where kh='" & Label8.Caption & "'", Cn, 1, 3
          If RS.EOF Then
             MsgBox "ID卡没有注册过，不合法", 0 + vbCritical, "系统提示"
             RS.Close
             Exit Sub
          End If
          Text1.Text = RS("cph")
          Combo1.Text = RS("cps")
          Rrs.CursorLocation = adUseClient
          Rrs.Open "select sf from clly where ly='" & Trim(Combo2.Text) & "'", Cn, 1, 3
          Text1.Text = RS("cph")
          Text2.Text = Val(RS("ye"))
          Text3.Text = RS("xm")
          If Val(Text2.Text) < 0 Then
             MsgBox "ID卡没有卡时，不合法", 0 + vbCritical, "系统提示"
             Command1.Enabled = False
          Else
             Command1.Enabled = True
          End If
          RS.Close
   End Select
End Sub

Private Sub MSComm2_OnComm()
      If MSComm2.DSRHolding = True Then SaveBmp_Click
End Sub

Private Sub SaveBmp_Click()
   CGCard.SaveJPEG App.Path & "\pic\dj.jpg", 80
   Image1.Picture = LoadPicture(App.Path & "\pic\dj.jpg")
   Label4.Caption = format(Date, "yyyy年mm月dd日") & format(Time, "hh时nn分")
End Sub

Public Sub djSnapEx_Click()
   Dim status As CGSTATUS
   If djSnapEx.Caption = "启动采集" Then
       djSnapEx.Caption = "关闭采集"
   Else
       djSnapEx.Caption = "启动采集"
   End If
   If g_nOperation = OPD_NONE Then
        CGCard.Clear
        status = CGCard.OpenSnapEx
        If (Not CG_SUCCESS(status)) Then
            MsgBox CGCard.GetErrorString(status)
        Else
            status = CGCard.StartSnapEx(0, True, 2)
            If (Not CG_SUCCESS(status)) Then
                MsgBox CGCard.GetErrorString(status)
            Else
                g_nOperation = OPD_SNAP_EX
                CGCard.Clear
            End If
        End If
   Else
        status = CGCard.CloseSnapEx
        If (Not CG_SUCCESS(status)) Then
            MsgBox CGCard.GetErrorString(status)
        Else
            g_nOperation = OPD_NONE
        End If
   End If
    
End Sub
Private Sub Form_Load()
    On Error Resume Next
    Dj_Zt = True
    If Sf_Zt Then Unload SF1
    Me.Left = (MDIForm1.Width - Me.Width) / 2
    Me.Top = (MDIForm1.Height - Me.Height) / 2 - 1000
    Me.Show
    CGCard.VideoSource = Yj(1)
    g_nOperation = OPD_NONE
    CGCard.Begin 1
    CGCard.SetInputWindow 0, 0, 768, 576
    CGCard.SetOutputWindow 0, 0, CGCard.Width, CGCard.Height
    djSnapEx_Click
    Combo1.Clear
    Combo1.AddItem "兰色"
    Combo1.AddItem "黄色"
    Combo1.AddItem "白色"
    Combo1.AddItem "其他"
    Combo1.Text = "兰色"
    Image1.Picture = LoadPicture(App.Path & "\pic\a.jpg")
    RS.CursorLocation = adUseClient
    RS.Open "SELECT * FROM CLLY", Cn, 1, 3
    Combo2.Clear
    Do While Not RS.EOF
       Combo2.AddItem RS(0)
       RS.MoveNext
     Loop
     RS.Close
     Combo2.Text = Combo2.List(0)
     Text1.SetFocus
     Text1.SelStart = Len(Text1.Text)
     MSComm1.CommPort = Yj(3) '串口号，
     MSComm1.Settings = "9600,N,8,1" '串口的属性
     MSComm1.InputLen = 0 '接收缓冲区的大小
     MSComm1.InputMode = comInputModeBinary '二进制接受方式
     MSComm1.RThreshold = 7 '每7个字节响应消息
     MSComm1.PortOpen = True '打开通信串口
     
     MSComm2.CommPort = Yj(6) '串口号，
     MSComm2.Settings = "9600,N,8,1" '串口的属性
     MSComm2.InputLen = 0 '接收缓冲区的大小
     MSComm2.InputMode = comInputModeBinary '二进制接受方式
     MSComm2.RThreshold = 7 '每7个字节响应消息
     MSComm2.PortOpen = True '打开通信串口
     If Err.Number Then
       MsgBox "对不起，COM口正在使用，请关闭已打开的界面", 0 + vbExclamation, "系统提示"
       Unload Me
       Exit Sub
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Select Case g_nOperation
    Case OPD_CAPTURE_EX
        CGCard.CaptureEx False
    Case OPD_SNAP_EX
        CGCard.CloseSnapEx
    End Select
    MSComm1.PortOpen = False
    MSComm2.PortOpen = False
    CGCard.End
    
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then Combo1.SetFocus
  If KeyAscii > 96 Then KeyAscii = KeyAscii - 32
End Sub

Private Sub Timer1_Timer()
    MSComm2.RTSEnable = False
    Timer1.Enabled = False
End Sub