?? 銀行貸款單.frm
字號:
edtYqjx.SetFocus
End If
End Sub
Private Sub edtYwbh_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{Tab}", False
KeyAscii = 0
Exit Sub
End If
End Sub
Private Sub edtYwbh_LostFocus()
If edtYwbh <> "" Then
edtYwbh = String(8 - Len(edtYwbh), "0") & edtYwbh
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Shift = Shift And 7
Select Case KeyCode
Case vbKeyF3
If Shift = 0 And Not FindFlag And Toolbar1.Buttons("Check").Enabled Then
Gen_Key "Check"
End If
Case vbKeyF4
If Shift = vbAltMask Then
Gen_Key "Exit"
ElseIf Shift = 0 And Not FindFlag And Toolbar1.Buttons("CheckCancel").Enabled Then
Gen_Key "CheckCancel"
End If
Case vbKeyF5
If Shift = 0 And Not FindFlag And Toolbar1.Buttons("AddRecord").Enabled Then
Gen_Key "AddRecord"
End If
Case vbKeyF6
If Shift = 0 And Not FindFlag And Toolbar1.Buttons("SaveRecord").Enabled 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 sqlCred As String
Screen.MousePointer = vbHourglass
Me.Icon = LoadResPicture(109, vbResIcon)
If FindFlag Then '查詢界面
'''' sqlCred = "SELECT * FROM FD_Cred WHERE [cCreID] LIKE " & _
'''' IIf((iCredType = 1), "'05%'", "'06%'")
'''' sqlCred = sqlCred & sqlFind
Informtlb Me.Toolbar1, Me.ImageList1, True
Checkqx = False
initFind_Form
Else
'''' sqlCred = "SELECT * FROM FD_Cred WHERE [cBookCode] IS NULL AND [cCreID] LIKE " & _
'''' IIf((iCredType = 1), "'05%'", "'06%'") & " ORDER BY [cCreID]"
Checkqx = Informtlb(Me.Toolbar1, Me.ImageList1, True, IIf(iCredType = 1, 5, 8))
End If
LoadStaticRes
''''' Set rstCred = dbsZJ.OpenRecordset(sqlCred, dbOpenDynaset)
If FindFlag Then
Set rstCred = oV.getUnBookRst(True)
Else
Set rstCred = oV.getUnBookRst
End If
While Not rstCred.EOF
Combo1.AddItem Right(rstCred![cCreID], 8)
rstCred.MoveNext
Wend
If rstCred.RecordCount > 0 Then rstCred.MoveFirst
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 CredSave 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)
rstCred.Close
FindFlag = False
blnSavFlag = False
End Sub
Private Sub JudgeSaves()
If Not blnAddFlag Then
If oV.IDExists(rstCred.Fields!cCreID) Then '當(dāng)前記錄存在
If oV.isChecked(rstCred.Fields!cCreID) Then '已審核
VeriSuccess = False
Else '未審核
'If Not JudgeLockOrNot(rstCred, 1) Then '未鎖定
VeriSuccess = True
'End If
End If
Else '當(dāng)前記錄不存在
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 frmYqjx_OK(Yqfs As Byte)
iArtype_Cred = Yqfs
edtYqjx = Getjxfs(iArtype_Cred)
End Sub
Private Sub RefCmd1_Initialize(Index As Integer)
Select Case Index
Case 0
RefCmd1(Index).InitSys 0, dbsZJ
RefCmd1(Index).InitSys 1, edtYhmc
Case 1
RefCmd1(Index).InitSys 0, dbsZJ
RefCmd1(Index).InitSys 1, edtYhzh
RefCmd1(Index).InitSys 2, edtYhmc
Case 2
RefCmd1(Index).InitSys 0, dbsZJ
RefCmd1(Index).InitSys 1, edtLldm
Case 3
RefCmd1(Index).InitSys 0, dbsZJ
RefCmd1(Index).InitSys 1, edtCad
End Select
End Sub
Private Sub RefCmd1_RefCancel(Index As Integer)
Select Case Index
Case 0: edtYhmc.SetFocus
Case 1: edtYhzh.SetFocus
Case 2: edtLldm.SetFocus
Case 3: edtCad.SetFocus
End Select
End Sub
Private Sub RefCmd1_RefOK(Index As Integer, Code As String)
Select Case Index
Case 0: edtYhmc = Code: edtYhmc.SetFocus
Case 1: edtYhzh = Code: edtYhzh.SetFocus
Case 2: edtLldm = Code: edtLldm.SetFocus
Case 3: edtCad = Code: edtCad.SetFocus
End Select
End Sub
Private Sub SetFormZero()
Combo1.Clear
EmptyForm
blnSavFlag = False
blnAddFlag = False
oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy_binCopy, Label1(0)
SetControlsStatus
End Sub
Private Sub Gen_Key(TLB_Key As String)
On Error Resume Next
Dim i As Integer, id As Integer
Select Case TLB_Key
Case Is = "Print", "Preview", "Dataout"
zjPrnViewOut Me, "yhdkdj", TLB_Key, IIf(iCredType = 1, 46, 139)
Case "AddRecord":
If blnSavFlag Then
Select Case PromptSav
Case vbYes:
JudgeSaves
If VeriSuccess Then
If VerifySav Then
CredSave
CredAdd
End If
End If
Case vbNo:
CredAdd
Case vbCancel
End Select
Else
CredAdd
End If
Case "SaveRecord":
SaveRecords
Case "DeleteRecord":
If Toolbar1.Buttons("DeleteRecord").Caption = "恢復(fù)" Then
If oV.IDExists(rstCred.Fields!cCreID) Then '當(dāng)前記錄存在
GetRecord
Else
If MoveRs(3) Then
GetRecord
Else
SetFormZero
End If
End If
Else
If PromptDel = vbYes Then
If Not blnAddFlag Then '非新增單據(jù)
'''' If JudgeExistOrNot(rstCred, 0) Then '當(dāng)前記錄存在
If oV.IDExists(rstCred.Fields!cCreID) Then
'''' If Not JudgeLockOrNot(rstCred, 1) Then '未鎖定
''' rstCred.Delete
oV.Delete rstCred.Fields!cCreID
rstCred.Requery
''' Else
''' Exit Sub
''' End If
End If
MoveRs 3
If rstCred.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
Else
If oV.IDExists(rstCred.Fields!cCreID) Then '當(dāng)前記錄存在
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
If rstCred.RecordCount = 0 Then
SetFormZero
End If
End If
End If
Case "CopyRecord"
If Toolbar1.Buttons("CopyRecord").Caption = "復(fù)制" 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: ' 審核
'if 審核=制單 Then Exit Sub
If zjLogInfo.cUserName = Label1(1) Then
Beep
MsgBox "審核與制單不能為同一人！", vbInformation, zjGl_Name
Exit Sub
End If
Check "One"
Case 1: ' 批審
Check "All"
Case 2: '
End Select
Case "CheckCancel":
InitFrmCheck_xz False
Select Case CheckStatus
Case 0: ' 取消審核
UnCheck "One"
Case 1: ' 批消
UnCheck "All"
Case 2: '
End Select
Case "PingZheng":
With pzInfo
.pDjrq = edtRq
.pMoney = edtJkje
.pYwID = rstCred![cCreID]
.pZhID1 = edtYhzh
.pZhID2 = pzZhID2
.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(0)
Case "Help":
SendKeys "{F1}"
Case "Exit":
Unload Me
End Select
End Sub
Private Sub SaveRecords()
JudgeSaves
If VeriSuccess Then
If VerifySav Then
If CredSave Then
GetRecord
End If
End If
VeriSuccess = False
Else
GetRecord
End If
' If Not VerifySav Then Exit Sub
'
' Dim tRst As SaveResultInfomation
' tRst = CredSave
' Select Case tRst.lngErrNumber
' Case 0
' Beep
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -