?? frm_kao_holiday_z.frm
字號:
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_Z.DJ_holiday
' If Len(txtFields(3).Text) = 0 Then
' Unload Me
' End If
' If tmp_i = 0 Then
'''********************************
''第一種方法:綁定adoprimaryrs到控件;
''第一種方法:寫SQL語句;和上面方法一樣,表越大時,速度越慢;
''第三種方法: 用批量更改的AdoprimaryRS Batch 在內(nèi)存修改,關閉窗體前,執(zhí)行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 發(fā)票號,emplyname as 經(jīng)手人,PriceType as 費用類型,Qty as 數(shù)量,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("發(fā)票號").Value = txtFields(0).Text
' .Fields("車牌號").Value = Combo1(0).Text
' .Fields("經(jīng)手人").Value = Combo1(1).Text
' .Fields("費用類型").Value = Combo1(2).Text
' .Fields("備注").Value = Combo1(3).Text
' .Fields("數(shù)量").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:
DisPlayErr Err
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) ' 循環(huán)至文件尾。
' Line Input #1, txtline ' 讀入一行數(shù)據(jù)并將其賦予某變量。
' Combo1.AddItem txtline
' ' Debug.Print TextLine ' 在立即窗口中顯示數(shù)據(jù)。
' 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:
DisPlayErr Err
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
'''''''==========================================================
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -