📄 +
字号:
ElseIf Shift = 0 And Toolbar1.Buttons("CheckCancel").Enabled And Not FindFlag Then
Gen_Key "CheckCancel"
End If
Case vbKeyF5
If Shift = 0 And Toolbar1.Buttons("AddRecord").Enabled And Not FindFlag Then
Gen_Key "AddRecord"
End If
Case vbKeyF6
If Shift = 0 And Toolbar1.Buttons("SaveRecord").Enabled And Not FindFlag Then
Gen_Key "SaveRecord"
End If
Case vbKeyF7
If Shift = vbAltMask And Toolbar1.Buttons("PingZheng").Enabled Then
Gen_Key "PingZheng"
End If
Case vbKeyC
If Shift = vbCtrlMask And Not FindFlag And Toolbar1.Buttons("CopyRecord").Enabled And Toolbar1.Buttons("CopyRecord").ToolTipText = "Ctrl+C" Then
Gen_Key "CopyRecord"
End If
KeyCode = 0
Case vbKeyV
If Shift = vbCtrlMask And Not FindFlag And Toolbar1.Buttons("CopyRecord").Enabled And Toolbar1.Buttons("CopyRecord").ToolTipText = "Ctrl+V" Then
Gen_Key "CopyRecord"
End If
KeyCode = 0
Case vbKeyY
If Shift = vbCtrlMask And Not FindFlag And Toolbar1.Buttons("DeleteRecord").Enabled And Toolbar1.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y" Then
Gen_Key "DeleteRecord"
End If
KeyCode = 0
Case vbKeyR
If Shift = vbCtrlMask And Not FindFlag And Toolbar1.Buttons("DeleteRecord").Enabled And Toolbar1.Buttons("DeleteRecord").ToolTipText = "Ctrl+R" Then
Gen_Key "DeleteRecord"
End If
KeyCode = 0
Case vbKeyP
If Shift = vbCtrlMask And Toolbar1.Buttons("Print").Enabled Then
Gen_Key "Print"
End If
KeyCode = 0
Case vbKeyS
'cuidong 2001.01.15
'If Shift = vbCtrlMask And Toolbar1.Buttons("Preview").Enabled Then
' Gen_Key "Preview"
'End If
KeyCode = 0
Case vbKeyW
If Shift = vbCtrlMask And Toolbar1.Buttons("Dataout").Enabled Then
Gen_Key "Dataout"
End If
KeyCode = 0
Case vbKeyPageUp
If Shift = 0 And Toolbar1.Buttons("PriorPage").Enabled Then
Gen_Key "PriorPage"
ElseIf Shift = vbCtrlMask And Toolbar1.Buttons("FirstPage").Enabled Then
Gen_Key "FirstPage"
End If
Case vbKeyPageDown
If Shift = 0 And Toolbar1.Buttons("NextPage").Enabled Then
Gen_Key "NextPage"
ElseIf Shift = vbCtrlMask And Toolbar1.Buttons("LastPage").Enabled Then
Gen_Key "LastPage"
End If
End Select
End Sub
Private Sub Form_Load()
Dim sqlCad As String
dSysStart = ZjAccInfo.zjStartdate
Screen.MousePointer = vbHourglass
With Combo2
.Clear
.AddItem ""
' .AddItem Ywbhtoname("01")
' .AddItem Ywbhtoname("03")
.AddItem Ywbhtoname("05")
.AddItem Ywbhtoname("06")
.AddItem Ywbhtoname("07")
.ListIndex = 0
End With
If FindFlag Then '查询界面
sqlCad = "SELECT * FROM FD_CadAcr WHERE cCarID LIKE '16%'"
sqlCad = sqlCad & sqlFind
Informtlb Me.Toolbar1, Me.ImageList1, True
Checkqx = False
initFind_Form
Else
sqlCad = "SELECT * FROM FD_CadAcr WHERE [cBookCode] IS NULL ORDER BY [cCarID]"
Checkqx = Informtlb(Me.Toolbar1, Me.ImageList1, True, 16)
End If
Set rstCad = dbsZJ.OpenRecordset(sqlCad, dbOpenDynaset)
While Not rstCad.EOF
Combo1.AddItem Right(rstCad![cCarID], 8)
rstCad.MoveNext
Wend
If rstCad.RecordCount > 0 Then rstCad.MoveFirst
LoadStaticRes
InitForm
Screen.MousePointer = vbDefault
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If blnSavFlag Then
Select Case PromptSav
Case vbYes:
JudgeSaves
If VeriSuccess Then
If VerifySav Then
If Not CadSave Then Cancel = True
Else
Cancel = True
End If
Else
Cancel = True
End If
Case vbNo:
Case vbCancel
Cancel = True
End Select
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
rstCad.oClose
blnSavFlag = False
FindFlag = False
blnAddFlag = False
End Sub
Private Sub JudgeSaves()
If Not blnAddFlag Then
If JudgeExistOrNot(rstCad, 0) Then '当前记录存在
If JudgeCheckOrNot(rstCad, 1) Then '已审核
VeriSuccess = False
Else '未审核
'If Not JudgeLockOrNot(rstCad, 1) Then '未锁定
VeriSuccess = True
'End If
End If
Else '当前记录不存在
blnAddFlag = True
VeriSuccess = True
End If
Else
VeriSuccess = True
End If
End Sub
Private Sub TurnPage(mPageType As Integer)
If MoveRs(mPageType) Then
GetRecord
Else
SetFormZero
End If
End Sub
'********************************************************************
'*函数说明: 增加记录 *
'*参 数: *
'* *
'*返回值 : *
'*********************************************************************
Private Sub CadAdd()
blnAddFlag = True
EmptyForm
iArtype_Cad = 1
Label2(1).Visible = False
Label1(1).Visible = False
Label2(15).Visible = True
Combo2.Visible = True
Combo2.ListIndex = 0
edtYwbh = oV.getMaxID("16")
edtYwbh.Visible = True
Combo1.Visible = False
SetControlsStatus
Label1(4) = zjLogInfo.cUserName
Toolbar1.Buttons("SaveRecord").Enabled = False
blnSavFlag = False
Combo2.ListIndex = 1
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Gen_Key Button.Key
End Sub
Private Sub Gen_Key(TLB_Key As String)
Dim i As Integer
Dim id As Integer
On Error Resume Next
Select Case TLB_Key
Case Is = "Print", "Preview", "Dataout"
zjPrnViewOut Me, "zjlxdj", TLB_Key
Case "AddRecord":
If blnSavFlag Then
Select Case PromptSav
Case vbYes:
JudgeSaves
If VeriSuccess Then
If VerifySav Then
CadSave
CadAdd
End If
End If
Case vbNo:
CadAdd
Case vbCancel
End Select
Else
CadAdd
End If
Case "SaveRecord":
JudgeSaves
If VeriSuccess Then
If VerifySav Then
If CadSave Then GetRecord
End If
VeriSuccess = False
Else
GetRecord
End If
Case "DeleteRecord":
If Toolbar1.Buttons("DeleteRecord").Caption = "恢复" Then
If JudgeExistOrNot(rstCad, 0) Then '当前记录存在
GetRecord
Else
If MoveRs(3) Then
GetRecord
Else
SetFormZero
End If
End If
Else
If Not blnAddFlag Then '非新增单据
If PromptCadDel = vbYes Then
If JudgeExistOrNot(rstCad, 0) Then '当前记录存在
If Not JudgeLockOrNot(rstCad, 1) Then '未锁定
If Not CadDelete Then Exit Sub
Else
Exit Sub
End If
End If
MoveRs 3
If rstCad.RecordCount > 0 Then
Dim ia As Integer
ia = Combo1.ListIndex
Combo1.RemoveItem Combo1.ListIndex
If ia > Combo1.ListCount - 1 Then ia = Combo1.ListCount - 1
Combo1.ListIndex = ia
End If
End If
Else
If PromptDel = vbYes Then
If JudgeExistOrNot(rstCad, 0) Then '当前记录存在
GetRecord
Else
If Combo1.ListIndex = -1 Then Combo1_DropDown
edtYwbh = Combo1.List(Combo1.ListIndex)
If MoveRs(3) Then
GetRecord
End If
End If
End If
End If
If rstCad.RecordCount = 0 Then
SetFormZero
End If
End If
Case "CopyRecord"
If Toolbar1.Buttons("CopyRecord").Caption = "复制" Then
CopyInformation
Else
PasteInformation
End If
Case "FirstPage":
ReQryCombo
Combo1.ListIndex = 0
Case "PriorPage":
ReQryCombo
Combo1.ListIndex = Combo1.ListIndex - 1
Case "NextPage":
ReQryCombo
Combo1.ListIndex = Combo1.ListIndex + 1
Case "LastPage":
ReQryCombo
Combo1.ListIndex = Combo1.ListCount - 1
Case "Check":
InitFrmCheck_xz True
Select Case CheckStatus
Case 0: ' 审核
'Cuidong 2000/06/09
'if 审核=制单 Then Exit Sub
If Not Trim(Label1(2).Caption) = "" Then Exit Sub
If zjLogInfo.cUserName = Label1(4) Then
Beep
MsgBox "审核与制单不能为同一人！", vbInformation, zjGl_Name
Exit Sub
End If
'
Check "One"
Case 1: ' 批审
Check "All"
End Select
Case "CheckCancel":
InitFrmCheck_xz False
Select Case CheckStatus
Case 0: ' 取消审核
'Cuidong 2000/06/09
'if 审核=制单 Then Exit Sub
If Trim(Label1(2).Caption) = "" Then Exit Sub
If Not zjLogInfo.cUserName = Label1(2).Caption Then
Beep
MsgBox "已复核单据只能由复核人本人取消复核！", vbInformation, zjGl_Name
Exit Sub
End If
UnCheck "One"
Case 1: ' 批消
UnCheck "All"
Case 2: '
End Select
Case "PingZheng":
If Not JudgeExistOrNot(rstCad, 0) Then Combo1_Click
If (Not edtFrom = "") And (edtFrom = edtTo) And (Val(edtBje) = 0) Then Exit Sub 'Cuidong 2000/09/06
With pzInfo
.pDjrq = edtRq
.pMoney = edtJe
.pYwID = rstCad![cCarID]
If edtSxzh = "" Then
.pZhID1 = pzZhID2
Else
.pZhID1 = edtSxzh
End If
If edtFxzh = "" Then
.pZhID2 = pzZhID2
Else
.pZhID2 = edtFxzh
End If
.pDigest = edtDigest
.pHl = edtHl
.blnFind = FindFlag
End With
If ZjAccInfo.zjPrnCtrl Then Exit Sub
ZjAccInfo.zjPrnCtrl = True
DoVouch
ZjAccInfo.zjPrnCtrl = False
SetControlsStatus
oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy_binCopy, Label1(2)
Case "Help":
SendKeys "{F1}"
Case "Exit":
Unload Me
End Select
End Sub
'********************************************************************
'*函数说明: 删除记录 *
'*参 数: *
'* *
'*返回值 : *
'*********************************************************************
Private Function CadDelete() As Boolean
Dim sqlAccSum As String
Dim rsAccSum As New UfRecordset
Dim sqlT As String
Dim Rst As New UfRecordset
On Error GoTo ErrL
CadDelete = False
'dbszj.BeginTrans
Select Case rstCad![iDanType]
Case 0
sqlT = "SELECT * FROM FD_CadAcr WHERE [iDantype]=0 AND [cGAccID]='" & rstCad![cGAccID] & _
"' AND [dTo] > '" & FormatDate(rstCad![dTo]) & "'"
Set Rst = dbsZJ.OpenRecordset(sqlT, dbOpenSnapshot)
If Not Rst.EOF Then
MsgBox "应按时间顺序从后往前删除账户或单据的利息！", vbInformation, zjGl_Name
Err.Raise v⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -