frmgongxiu.frm

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

         Top             =   240
         Width           =   1560
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFC0C0&
         Caption         =   "年1月1日"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Left            =   2415
         TabIndex        =   5
         Top             =   240
         Width           =   1230
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFC0C0&
         Caption         =   "设定公休日"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   1500
      End
   End
   Begin MSDataGridLib.DataGrid DataGrid1 
      Bindings        =   "frmGongXiu.frx":0000
      Height          =   2415
      Left            =   120
      TabIndex        =   18
      Top             =   3360
      Width           =   5055
      _ExtentX        =   8916
      _ExtentY        =   4260
      _Version        =   393216
      AllowUpdate     =   0   'False
      BackColor       =   12648447
      ForeColor       =   12582912
      HeadLines       =   1
      RowHeight       =   16
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   12
         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
End
Attribute VB_Name = "frmGongXiu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SName As String
Private Sub cmdAdd_Click()

Dim TDate As Date
If txtStartYear.Text = "" Or Not IsNumeric(txtStartYear.Text) Then
   MsgBox "您设定的年有误，请核实！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If
Set adoRs = adoCon.Execute("select count(*) from GongXiu where Name='" & Trim(SName) & "'")
If adoRs(0) > 0 Then
   MsgBox "此节假日已经存在，请选择修改！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If
If CobName.Text = "" Then
   MsgBox "请填写节假日名称！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If
If Len(Trim(CobName.Text)) > 15 Then
   MsgBox "假期的名称过长，请核实！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If
If CobName.Text = "星期六" Then
    TDate = CDate(txtStartYear.Text + "-01-01")
    Do While TDate <= CDate(txtEndYear.Text + "-12-31")
       If Weekday(TDate) = 7 Then
          adoCon.Execute ("insert into GongXiu values('" & Trim(SName) & "','" & TDate & "','" & DTEnd.Value & "') ")
       End If
       TDate = TDate + 1
    Loop
ElseIf CobName.Text = "星期日" Then
    TDate = CDate(txtStartYear.Text + "-01-01")
    Do While TDate <= CDate(txtEndYear.Text + "-12-31")
       If Weekday(TDate) = 1 Then
          adoCon.Execute ("insert into GongXiu values('" & Trim(SName) & "','" & TDate & "','" & DTEnd.Value & "') ")
       End If
       TDate = TDate + 1
    Loop

Else
    TDate = DTStart.Value
    Do While TDate <= DTEnd.Value
        adoCon.Execute ("insert into GongXiu values('" & Trim(SName) & "','" & TDate & "','" & DTEnd.Value & "') ")
        TDate = TDate + 1
    Loop
End If
Call SetNew
End Sub

Private Sub cmdDel_Click()
 If MsgBox("您是否要删除节假日“" + CobName.Text + "”吗？", vbYesNo + vbExclamation, "删除提示") = vbYes Then
    adoCon.Execute ("delete GongXiu where Name='" & CobName.Text & "'")
    Call SetNew
  End If
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub
Public Sub SetNew()

txtStartYear.Text = "2002"
txtEndYear.Text = "2002"
Set adoRs = adoCon.Execute("exec GongName_proc ")
With List
    .Clear
    .AddItem "所有假日"
    Do While Not adoRs.EOF
       .AddItem adoRs!Name
       adoRs.MoveNext
    Loop
End With
With CobName
   .Clear
   .AddItem ""
   .AddItem "星期六"
   .AddItem "星期日"
   .AddItem "元旦"
   .AddItem "春节(初一)"
   .AddItem "正月十五"
   .AddItem "三八妇女节"
   .AddItem "五、一"
   .AddItem "八月十五"
   .AddItem "十、一"
   
   
End With
DTStart.Value = CDate(txtStartYear.Text + "-01-01")
DTEnd.Value = CDate(txtStartYear.Text + "-01-01")
Set adoRs = adoCon.Execute("select count(distinct StarDay) from GongXiu")
txtCount.Text = CStr(Trim(adoRs(0)))
With AdoFind
   .ConnectionString = RtnStr
   .RecordSource = "exec GongXiu_proc"
   .Refresh
End With
End Sub


Private Sub CmdMod_Click()
Dim TDate As Date
If txtStartYear.Text = "" Or Not IsNumeric(txtStartYear.Text) Then
   MsgBox "您设定的年有误，请核实！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If
If CobName.Text = "" Then
   MsgBox "请填写节假日名称！", vbOKOnly + vbExclamation, "系统提示"
   Exit Sub
End If
If MsgBox("您是否要修改节假日“" + CobName.Text + "”吗？", vbYesNo, "修改提示") = vbYes Then
    If CobName.Text = "星期六" Then
    TDate = CDate(txtStartYear.Text + "-01-01")
    Do While TDate <= CDate(txtEndYear.Text + "-12-31")
       If Weekday(TDate) = 7 Then
          adoCon.Execute ("insert into GongXiu values('" & Trim(CobName.Text) & "','" & TDate & "','" & DTEnd.Value & "') ")
       End If
       TDate = TDate + 1
    Loop
ElseIf CobName.Text = "星期日" Then
    TDate = CDate(txtStartYear.Text + "-01-01")
    Do While TDate <= CDate(txtEndYear.Text + "-12-31")
       If Weekday(TDate) = 1 Then
          adoCon.Execute ("insert into GongXiu values('" & Trim(CobName.Text) & "','" & TDate & "','" & DTEnd.Value & "') ")
       End If
       TDate = TDate + 1
    Loop

Else
       adoCon.Execute ("delete GongXiu where Name='" & Trim(CobName.Text) & "'")
       TDate = DTStart.Value
        Do While TDate <= DTEnd.Value
             adoCon.Execute ("insert into GongXiu values('" & Trim(CobName.Text) & "','" & TDate & "','" & DTEnd.Value & "') ")
            TDate = TDate + 1
        Loop
    End If
    End If
Call SetNew
End Sub

Private Sub cobName_Click()
Dim TDate As Date
Dim STR As String
SName = CobName.Text
Select Case Trim(SName)
   Case "星期日"
      DTStart.Value = CDate(txtStartYear.Text + "-01-01")
      DTEnd.Value = CDate(txtEndYear.Text + "-12-31")
   Case "星期六"
      DTStart.Value = CDate(txtStartYear.Text + "-01-01")
      DTEnd.Value = CDate(txtEndYear.Text + "-12-31")
   
   Case "元旦"
      DTStart.Value = CDate(txtStartYear.Text + "-01-01")
      DTEnd.Value = CDate(txtStartYear.Text + "-01-03")

   Case "春节(初一)"
      TDate = CDate(txtStartYear.Text + "-01-01")
      Do While TDate <= CDate(txtStartYear.Text + "-03-01")
         ChinaDay.DateNow = TDate
         ChinaDay.ChineseDateType = dateNumeric
         STR = ChinaDay.ChineseDate
         If STR = "101" Then
            DTStart.Value = TDate
            DTEnd.Value = TDate + 6
             SName = Left(SName, 2)
            Exit Sub
         End If
         TDate = TDate + 1
      Loop
      
     
   Case "正月十五"
      TDate = CDate(txtStartYear.Text + "-01-15")
      Do While TDate <= CDate(txtStartYear.Text + "-03-15")
         ChinaDay.DateNow = TDate
         ChinaDay.ChineseDateType = dateNumeric
         STR = ChinaDay.ChineseDate
         If STR = "115" Then
            DTStart.Value = TDate
            DTEnd.Value = TDate
            Exit Sub
         End If
         TDate = TDate + 1
      Loop
   Case "三八妇女节"
      DTStart.Value = CDate(txtStartYear.Text + "-03-08")
      DTEnd.Value = CDate(txtStartYear.Text + "-03-08")
       
   Case "五、一"
      DTStart.Value = CDate(txtStartYear.Text + "-05-01")
      DTEnd.Value = CDate(txtStartYear.Text + "-05-03")
   
   Case "八月十五"
            TDate = CDate(txtStartYear.Text + "-08-01")
      Do While TDate <= CDate(txtStartYear.Text + "-11-01")
         ChinaDay.DateNow = TDate
         ChinaDay.ChineseDateType = dateNumeric
         STR = ChinaDay.ChineseDate
         If STR = "815" Then
            DTStart.Value = TDate
            DTEnd.Value = TDate
            Exit Sub
         End If
         TDate = TDate + 1
      Loop
   Case "十、一"
      DTStart.Value = CDate(txtStartYear.Text + "-10-01")
      DTEnd.Value = CDate(txtStartYear.Text + "-10-04")
   
End Select
End Sub



Private Sub Form_Load()
If lNum = 0 Then
   cmdAdd.Enabled = False
   cmdDel.Enabled = False
   CmdMod.Enabled = False
End If
   
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 800
Call SetNew

End Sub





Private Sub List_Click()
Dim SSTR, sSQL As String
sSQL = " where Name='" & Trim(List.Text) & "' "
SSTR = Trim(List.Text)
Select Case SSTR
   Case "所有假日"
    SSTR = ""
    sSQL = " "
    DTStart.Value = CDate(txtStartYear.Text + "-01-01")
    DTEnd.Value = CDate(txtEndYear.Text + "-12-31")
   Case "星期日"
      DTStart.Value = CDate(txtStartYear.Text + "-01-01")
      DTEnd.Value = CDate(txtEndYear.Text + "-12-31")
   Case "星期六"
      DTStart.Value = CDate(txtStartYear.Text + "-01-01")
      DTEnd.Value = CDate(txtEndYear.Text + "-12-31")
   Case Else
     Set adoRs = adoCon.Execute("select StarDay,EndDay from GongXiu where Name='" & Trim(SSTR) & "'")
     DTStart.Value = adoRs!StarDay
     DTEnd.Value = adoRs!EndDay

End Select

CobName.Text = Trim(SSTR)
With AdoFind
   .ConnectionString = RtnStr
   .RecordSource = "select Name as 假期名称, StarDay as 假期时间 from GongXiu" + sSQL + "order by Name,StarDay"
   .Refresh
End With
Set adoRs = adoCon.Execute("select count(distinct StarDay) from GongXiu " + sSQL)
txtCount.Text = CStr(Trim(adoRs(0)))
End Sub