frm_kao_holiday.frm

考勤系统,智能判断刷卡异常,是一大型ERP系统的一个分支

'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const CB_FINDSTRING = &H14C
Private Const CB_ERR = (-1)
'Declarations for alternate code (see comments below)
'Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const CB_SETCURSEL = &H14E

'Private flag
Private m_bEditFromCode As Boolean

Public bSave As Boolean


Private Sub Command1_Click(Index As Integer)
    On Error GoTo Err1
    

    Select Case Index
        Case 0
        
        
        bSave = True
        Frm_Rpt_KaoQinYC.DJ_holiday
        
        
'            If Len(txtFields(3).Text) = 0 Then
'                Unload Me
'            End If

'            If tmp_i = 0 Then
'''********************************
''第一种方法：绑定adoprimaryrs到控件；
''第一种方法：写SQL语句；和上面方法一样，表越大时，速度越慢；
''第三种方法: 用批量更改的AdoprimaryRS Batch 在内存修改，关闭窗体前，执行adoPrimaryRS4.UpdateBatch,速度最快；
'''********************************


'                With adoprimaryRS
'                    .AddNew
'                    txtFields(1).Text = sx_quantity_cg.DataCombo1.Text
'                    txtFields(2).Text = Format(Date, "yyyy-mm-dd")
'                    DataCombo1.BoundText = tmp_datacombo1
'                End With
                
'                InsertDataToQuantity_cg
'                     TxtFields(1).Text = sx_quantity_cg.DataCombo1.Text
'                    TxtFields(2).Text = Format(Date, "yyyy-mm-dd")
'                    DataCombo1.BoundText = tmp_datacombo1
'     strSQL4 = "select  CheCode as 车牌号,FPCode as 发票号,emplyname as 经手人,PriceType as 费用类型,Qty as 数量,Price as 金额,Memo as 备注,FixFac as 修理厂,DjDate as 登记日期,FixFlag as 是否维修,rq1 as 日期1,rq2 as 日期2 from Che_MingXi where Djdate between '" & DTPicker1(0).Value & "' and  '" & DTPicker1(1).Value & "'"
              
'              With Frm_Che_MingXi.adoprimaryRS4
'                .AddNew
'                .Fields("发票号").Value = txtFields(0).Text
'                .Fields("车牌号").Value = Combo1(0).Text
'                .Fields("经手人").Value = Combo1(1).Text
'                .Fields("费用类型").Value = Combo1(2).Text
'                .Fields("备注").Value = Combo1(3).Text
'                .Fields("数量").Value = IIf(txtFields(2).Text = "", 0, txtFields(2).Text)
'                .Fields("金额").Value = txtFields(3).Text
'                .Fields("登记日期").Value = txtFields(1).Text
'                .Fields("修理厂").Value = Combo1(4).Text
'                If DTPicker1(0).Visible = True Then
'                .Fields("日期1").Value = DTPicker1(0).Value
'                .Fields("日期2").Value = DTPicker1(1).Value
'                End If
'
'                .Update
'            End With
'            Frm_Che_MingXi.DataGrid1.Refresh
'
'             bSave = True
'
'Dim o As ComboBox
'For Each o In Combo1
'o.Text = ""
'Next
'Dim otxt As TextBox
'For Each otxt In txtFields
'otxt.Text = ""
'Next
'
'   txtFields(0).SetFocus




              
                
'                Call sx_quantity_cg.DataList1_Click
                'Call sx_quantity_cg.DataList1_Click
'                SendKeys vbTab
'                SendKeys vbTab
            
                '            SendKeys vbKeyBack
                'ElseIf tmp_i = 1 Then
                'With adoprimaryRS
                '.AddNew
                'txtFields(1).Text = sx_quantity_js.DataCombo1.Text
                'txtFields(2).Text = sx_quantity_js.DataList1.BoundText
                'End With
                'Call sx_quantity_js.DataList1_Click
                '            SendKeys vbTab
                'ElseIf tmp_i = 2 Then
                'With adoprimaryRS
                '.AddNew
                'txtFields(1).Text = sx_quantity_jj.DataCombo1.Text
                'txtFields(2).Text = sx_quantity_jj.DataList1.BoundText
                'txtFields(3).Text = sx_quantity_jj.Text1(1).Text
                'End With
                'Call sx_quantity_jj.DataList1_Click
                '            SendKeys vbTab
'            End If
        Case 1
            Unload Me
    End Select
Exit Sub
Err1:
MsgBox Err.Description
End Sub
''''''''''''''''***********************************************************



Private Sub DataCombo1_LostFocus(Index As Integer)
If DataCombo1(0).Text <> "" Then
            If Check1.Value Then
            txtFields(2).Text = 8
            Else
                If DTPicker1(0).Value = DTPicker1(1).Value Then
                If endtm1 > SETIMER1(0).Text And bgtm2 < SETIMER1(1).Text Then
                txtFields(2).Text = Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1) - Round(DateDiff("n", endtm1, bgtm2) / 60, 1)
                Else
                txtFields(2).Text = Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1)
                End If
                
                ElseIf DTPicker1(0).Value < DTPicker1(1).Value Then
                '''txtFields(2).Text = DateDiff("d", DTPicker1(0).Value, DTPicker1(1).Value) * 8 + Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1)
                If endtm1 > SETIMER1(0).Text And bgtm2 < SETIMER1(1).Text Then
                txtFields(2).Text = DateDiff("d", DTPicker1(0).Value, DTPicker1(1).Value) * 8 + Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1) - Round(DateDiff("n", endtm1, bgtm2) / 60, 1)
                Else
                txtFields(2).Text = DateDiff("d", DTPicker1(0).Value, DTPicker1(1).Value) * 8 + Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1)
                End If
                
               End If
                
            End If
                
End If


End Sub

''''''''''''''''***********************************************************

Private Sub Form_Deactivate()

    Unload Me
End Sub

Private Sub Form_Load()
'    Set mDB = New mDB
'    mDB.InitDB_RY strconnDR

'    tmp_i = GetSetting("temp", "tempint", "tmpi")
    GetAppSettings App.Title, Me

    AlwaysOnTop Me, True

    'If FileExists(App.Path & "\yuanyin.txt") = True Then
    '' Dim txtline As String
    '    Open App.Path & "\yuanyin.txt" For Input As #1   ' 打开文件。
    '    Do While Not EOF(1)   ' 循环至文件尾。
    '       Line Input #1, txtline    ' 读入一行数据并将其赋予某变量。
    '       Combo1.AddItem txtline
    '    '   Debug.Print TextLine   ' 在立即窗口中显示数据。
    '    Loop
    '    Close #1   ' 关闭文件。
    'End If
    
'    Label1(1).Visible = False
'    txtFields(1).Visible = False
'    Label1(2).Visible = False
'    txtFields(2).Visible = False
'
''    strSQL = "select shui_id,shui_lx from sx_shuilx"
'    strSQL = "select shui_id,shui_lx from sx_shuilx where shui_lx<>''"
'    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'    With DataCombo1
'        Set .RowSource = adoprimaryRS
'        .BoundColumn = "shui_id"
'        .ListField = "shui_lx"
'        .Refresh
'    End With
    


'    Call Reload_PrimaryRS(tmp_i)
'    Command1_Click 0

bSave = False
   

Exit Sub
Err1:
MsgBox Err.Description


End Sub





Private Sub Form_Unload(Cancel As Integer)
'If bSave Then
'If MsgBox("记录未保存，要保存吗？", vbYesNo) = vbYes Then
'Frm_Che_MingXi.adoprimaryRS4.UpdateBatch
'End If
'End If
    SaveAppSettings App.Title, Me
'    Set mDB = Nothing

End Sub

Private Sub txtFields_GotFocus(Index As Integer)
    Select Case Index
        Case 1
            txtFields(1).Text = Date
        Case 2
            If Check1.Value Then
            txtFields(2).Text = 8
            Else
                If DTPicker1(0).Value = DTPicker1(1).Value Then
                If endtm1 > SETIMER1(0).Text And bgtm2 < SETIMER1(1).Text Then
                txtFields(2).Text = Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1) - Round(DateDiff("n", endtm1, bgtm2) / 60, 1)
                Else
                txtFields(2).Text = Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1)
                End If
                
                ElseIf DTPicker1(0).Value < DTPicker1(1).Value Then
                '''txtFields(2).Text = DateDiff("d", DTPicker1(0).Value, DTPicker1(1).Value) * 8 + Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1)
                If endtm1 > SETIMER1(0).Text And bgtm2 < SETIMER1(1).Text Then
                txtFields(2).Text = DateDiff("d", DTPicker1(0).Value, DTPicker1(1).Value) * 8 + Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1) - Round(DateDiff("n", endtm1, bgtm2) / 60, 1)
                Else
                txtFields(2).Text = DateDiff("d", DTPicker1(0).Value, DTPicker1(1).Value) * 8 + Round(DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text) / 60, 1)
                End If
                
               End If
                
            End If
    End Select

End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        
        
        SendKeys vbTab
    End If

End Sub

'''''''==========================================================