frmqingjia.frm

VB写的通过串口与考勤机连接通讯的程序

         HeadLines       =   1
         RowHeight       =   16
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Caption         =   "查 询 结 果"
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
      Begin VB.Label Label10 
         AutoSize        =   -1  'True
         Caption         =   "时间类型:"
         Height          =   240
         Left            =   4560
         TabIndex        =   34
         Top             =   1200
         Width           =   1080
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "请 假 信 息 表"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   21.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   435
         Left            =   3120
         TabIndex        =   24
         Top             =   480
         Width           =   3150
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "请假时间：从"
         Height          =   240
         Left            =   240
         TabIndex        =   10
         Top             =   1800
         Width           =   1440
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "到"
         Height          =   240
         Left            =   4920
         TabIndex        =   9
         Top             =   1800
         Width           =   240
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "类  别 ："
         Height          =   240
         Left            =   6600
         TabIndex        =   8
         Top             =   2520
         Width           =   1080
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "姓 名 ："
         Height          =   240
         Left            =   600
         TabIndex        =   7
         Top             =   1140
         Width           =   960
      End
   End
End
Attribute VB_Name = "frmQingJia"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SName As String
Dim sCardID As String
Public Sub Ref()

Dim SName As String

With AdoFind
   .ConnectionString = RtnStr
   .RecordSource = "exec QingJia_proc"
   .Refresh
End With
End Sub
Public Sub SetNew()

txtBeiZhu.Text = ""
SName = ""
Set adoRs = adoCon.Execute("select Name from Worker")
With cobFindName
   .Clear
   cobName.Clear
   .AddItem ""
   cobName.AddItem ""
   Do While Not adoRs.EOF
      .AddItem adoRs!Name
      cobName.AddItem adoRs!Name
      adoRs.MoveNext
   Loop
   .ListIndex = 0
   cobName.ListIndex = 0
End With

With cobType
   .Clear
   .AddItem "半天"
   .AddItem "全天"
   .AddItem "多天"
   .ListIndex = 0
End With
With cobTType
   .Clear
   .AddItem "请假"
   .AddItem "正常"
   .AddItem "加班"
   .AddItem "外出办公"
   .AddItem "出差"
   .AddItem "节日加班"
   .ListIndex = 0
End With

With CobFindType
   .Clear
   .AddItem "请假"
   .AddItem "正常"
   .AddItem "加班"
   .AddItem "外出办公"
   .AddItem "出差"
   .AddItem "节日加班"
   .ListIndex = 0
End With
dtStart.Value = Format(Now, "yyyy-mm-dd")
dtEnd.Value = Format(Now, "yyyy-mm-dd")
Call Ref





End Sub


Private Sub chkName_Click()
If chkName.Value = 1 Then
   cobFindName.Enabled = True
Else
   cobFindName.Enabled = False
End If
End Sub

Private Sub chkStart_Click()
If chkStart.Value = 1 Then
   dtFindStart.Enabled = True
   dtFindEnd.Enabled = True
Else
   dtFindStart.Enabled = False
   dtFindEnd.Enabled = False
End If
End Sub

Private Sub chkType_Click()
If chkType.Value = 1 Then
   CobFindType.Enabled = True
Else
   CobFindType.Enabled = False
End If
End Sub

Private Sub cmdAdd_Click()
Dim SSTR As String
SSTR = Trim(cobTType.Text)
If cobName.Text = "" Then
   MsgBox "您没有选择姓名！", vbOKCancel + vbExclamation, "录入提示"
   Exit Sub
End If


Set adoRs = adoCon.Execute("exec QingName_proc '" & Trim(cobName.Text) & "' ")
If Not adoRs.EOF Then
   sCardID = adoRs!CardID
Else
   MsgBox "查无此人,请核实！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If

If cobTType.Text = "" Then
   MsgBox "请填写请假类型！", vbOKOnly, "录入提示"
   Exit Sub
End If

Select Case Trim(cobType.Text)
   Case "半天"
         dtEnd.Value = dtStart.Value
        If Trim(cobTType.Text) = "加班" Or Trim(cobTType.Text) = "节日加班" Or Trim(cobTType.Text) = "出差" Then
       Else
          SSTR = SSTR + Trim(cobType.Text)
       End If
    Case "全天"
        dtEnd.Value = dtStart.Value
      
   Case "多天"
      If dtStart.Value >= dtEnd.Value Then
         MsgBox "请假时间填写有误！", vbOKOnly + vbExclamation, " 录入提示"
         Exit Sub
      End If
      
End Select

Set adoRs = adoCon.Execute("select count(*) from QingJia where CardID='" & sCardID & "'and Startday='" & dtStart.Value & "'")
If adoRs(0) > 0 Then
   If MsgBox("此人的请假记录已经存在，" + Chr(13) + "是否要修改？", vbYesNo, "系统提示") = vbYes Then
      SSTab.Tab = 1
      AdoFind.RecordSource = "select * from QingJia where CardID='" & sCardID & "'and Startday='" & dtStart.Value & "'"
      AdoFind.Refresh
      Exit Sub
   Else
   Exit Sub
   End If
End If

adoCon.Execute ("insert into QingJia values('" & sCardID & "','" & Trim(cobName.Text) & "','" & dtStart.Value & "','" & dtEnd.Value & "','" & Trim(SSTR) & "','" & Trim(txtBeiZhu.Text) & "')")
Call SetNew
Call Ref
End Sub

Private Sub cmdCancel_Click()
Call SetNew
cmdUpdate.Enabled = False
cmdAdd.Enabled = True
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub cmdFind_Click()
Dim SQL As String
Dim SName, sType, sDate As String
If chkName.Value = 1 Then
   SName = " Name Like '" & Trim(cobFindName.Text) & "%'"
Else
   SName = "Name like '%'"
End If
If chkType.Value = 1 Then
   sType = "Type like '" & Trim(CobFindType.Text) & "%'"
Else
   sType = "Type like '%'"
End If
If chkStart.Value = 1 Then
   sDate = " StartDay between '" + Format(dtFindStart.Value, "yyyy-mm-dd") + "' and '" + Format(dtFindEnd.Value, "yyyy-mm-dd") + "'"
Else
   sDate = " StartDay like '%'"
End If

SQL = "select Name as 姓名,StartDay as 开始时间,EndDay as 结束时间,"
SQL = SQL + "  Type as 类别,Reason as 备注 from QingJia"
SQL = SQL + " where " + SName + " and " + sType + " and " + sDate
SQL = SQL + " order by QingJiaID,StartDay"
With AdoFind
   .ConnectionString = RtnStr
   .RecordSource = SQL
   .Refresh
End With
End Sub

Private Sub cmdMOdify_Click()
dtEnd.Enabled = False
If SName = "" Then
   MsgBox "请选中要修改的记录！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If

Set adoRs = adoCon.Execute("select * from QingJia where QingJiaID='" & Trim(SName) & "'")
  If Not adoRs.EOF Then
     TypeStr = Trim(adoRs!Type)
  If (adoRs!EndDay) - (adoRs!StartDay) > 0 Then
     dtEnd.Enabled = True
     cobType.Text = "多天"
  Else
     If Right(TypeStr, 2) = "半天" Then
       cobType.Text = Right(TypeStr, 2)
       cobTType.Text = Left(TypeStr, Len(TypeStr) - 2)
     Else
       cobType.Text = "全天"
       cobTType.Text = TypeStr
    End If
  End If
  cobName.Text = adoRs!Name
  txtBeiZhu.Text = adoRs!Reason
  sCardID = adoRs!CardID
  dtStart.Value = adoRs!StartDay
  dtEnd.Value = adoRs!EndDay
End If

cmdAdd.Enabled = False
cmdUpdate.Enabled = True
SSTab.Tab = 0
End Sub

Private Sub cmdShowAll_Click()
 Call Ref
End Sub

Private Sub cmdUpdate_Click()
Dim SSTR As String
SSTR = Trim(cobTType.Text)
If cobName.Text = "" Then
   MsgBox "您没有选择姓名！", vbOKCancel + vbExclamation, "录入提示"
   Exit Sub
End If


Set adoRs = adoCon.Execute("exec QingName_proc '" & Trim(cobName.Text) & "' ")
If Not adoRs.EOF Then
   sCardID = adoRs!CardID
Else
   MsgBox "查无此人,请核实！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If

If cobTType.Text = "" Then
   MsgBox "请填写请假类型！", vbOKOnly, "录入提示"
   Exit Sub
End If

Select Case Trim(cobType.Text)
   Case "半天"
         dtEnd.Value = dtStart.Value
        If Trim(cobTType.Text) = "加班" Or Trim(cobTType.Text) = "节日加班" Or Trim(cobTType.Text) = "出差" Then
       Else
          SSTR = SSTR + Trim(cobType.Text)
       End If
    Case "全天"
        dtEnd.Value = dtStart.Value
      
   Case "多天"
      If dtStart.Value >= dtEnd.Value Then
         MsgBox "请假时间填写有误！", vbOKOnly + vbExclamation, " 录入提示"
         Exit Sub
      End If
      
End Select


SQL = "update QingJia set CardID='" & Trim(sCardID) & "',"
SQL = SQL + "Name='" & Trim(cobName.Text) & "',"
SQL = SQL + "StartDay='" & CStr(dtStart.Value) & "',"
SQL = SQL + "EndDay='" & Trim(dtEnd.Value) & "',"
SQL = SQL + "Type='" & Trim(SSTR) & "',"
SQL = SQL + " Reason='" & Trim(txtBeiZhu.Text) & "'"
SQL = SQL + "where QingJiaID='" & Trim(SName) & "'"
adoCon.Execute (SQL)
MsgBox "修改成功！", vbOKOnly, "修改提示"
Call SetNew
Call Ref
cmdUpdate.Enabled = False
cmdAdd.Enabled = True

End Sub



Private Sub cobType_Click()
Select Case cobType.Text
   Case "半天"
      dtEnd.Enabled = False
   Case "全天"
      dtEnd.Enabled = False
   Case "多天"
      dtEnd.Enabled = True
End Select
End Sub


Private Sub comQuit_Click()
Unload Me
End Sub

Private Sub DataGrid1_Click()
  DataGrid1.Col = 0
 Dim TypeStr As String
  If AdoFind.Recordset.EOF And AdoFind.Recordset.BOF Then
     MsgBox "您没有选种记录！", vbOKOnly + vbExclamation, "修改提示"
     Exit Sub
  End If
  SName = DataGrid1.Text
  
End Sub



Private Sub Form_Load()
If lNum = 0 Then
   cmdAdd.Enabled = False
   cmdAdd.Value = False
   cmdModify.Enabled = False
   cmdUpdate.Enabled = False
End If
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 900
txtTime.Text = " " + Time$
txtDate.Text = Date$
txtWeek.Text = "  " + WeekdayName(Weekday(Date))
Call SetNew
dtFindStart.Value = Date
dtFindEnd.Value = Date
dtStart.Value = Date
dtEnd.Value = Date
cmdUpdate.Enabled = False

Set adoRs = adoCon.Execute("select Min(StartDay) as Startt,max(StartDay)as Endd from QingJia")
SSTab.Tab = 0
End Sub



Private Sub Timer1_Timer()
txtTime.Text = " " + Time$
End Sub