内部拆借单.frm

不处的管理软件包

Private Sub edtJe_Change()
   On Error Resume Next
   edtBje = edtJe * edtHl
   If Err <> 0 Then edtBje = ""
   On Error GoTo 0
   If Not blnSavFlag And Not blnGetRecord Then
       Combo1.Visible = False
       edtYwbh.Visible = True
       blnSavFlag = True
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(1)
   End If
End Sub

Private Sub edtJe_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
      SendKeys "{Tab}", False
      KeyAscii = 0
      Exit Sub
   End If
End Sub

Private Sub edtLldm_Change()
   bLldm = True
   If Not blnSavFlag And Not blnGetRecord Then
      Combo1.Visible = False
      edtYwbh.Visible = True
      blnSavFlag = True
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(1)
   End If

End Sub

Private Sub edtLldm_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      RefCmd1(4).RunReference
      edtLldm.SetFocus
   End If
End Sub

Private Sub edtLldm_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
      SendKeys "{Tab}", False
      KeyAscii = 0
      Exit Sub
   End If

End Sub
' 利率代码
Private Sub edtLldm_LostFocus()
   If edtLldm <> "" And bLldm Then
      bLldm = False
      If Not JudgeIntra(edtLldm) Then
         MsgBox "利率代码不存在！", vbInformation
         SetTxtFocus edtLldm
      End If
   End If

End Sub

Private Sub edtRq_Change()
   If Not blnSavFlag And Not blnGetRecord Then
      bRq = True
      Combo1.Visible = False
      edtYwbh.Visible = True
      blnSavFlag = True
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(1)
   End If

End Sub

Private Sub edtRq_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      Command1(0).Value = True
      edtRq.SetFocus
   End If

End Sub

Private Sub edtRq_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
      SendKeys "{Tab}", False
      KeyAscii = 0
      Exit Sub
   End If
End Sub

' 日期
Private Sub edtRq_LostFocus()
   If edtRq <> "" And bRq Then
      bRq = False
      edtRq = ForDate(edtRq)
      If IsDate(edtRq) Then
         edtRq = FormatDate(edtRq)
         If CDate(edtRq) > zjLogInfo.curDate Then
            MsgBox "业务日期不能超过系统登录时间！", vbInformation
            SetTxtFocus edtRq
         End If
      Else
         MsgBox "日期非法，请检查！", vbInformation
         SetTxtFocus edtRq
      End If
   End If

End Sub

Private Sub edtSkjb_Change()
    If Not blnSavFlag And Not blnGetRecord Then
        Combo1.Visible = False
        edtYwbh.Visible = True
        blnSavFlag = True
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(1)
    End If

End Sub

Private Sub edtSkjb_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
      SendKeys "{Tab}", False
      KeyAscii = 0
      Exit Sub
   End If

End Sub

Private Sub edtSkzh_Change()
   bSkzh = True
   If Not blnSavFlag And Not blnGetRecord Then
      Combo1.Visible = False
      edtYwbh.Visible = True
      blnSavFlag = True
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(1)
   End If
   Dim strTemp As String
   If edtSkzh <> "" Then
      strTemp = AccIDToUnitName(edtSkzh)
      If strTemp <> "" Then
         edtCrbm = strTemp
         edtBib = AccToExch(edtSkzh)
      End If
   End If

End Sub

Private Sub edtSkzh_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      RefCmd1(1).RunReference
      edtSkzh.SetFocus
   End If
End Sub

Private Sub edtSkzh_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
      SendKeys "{Tab}", False
      KeyAscii = 0
      Exit Sub
   End If

End Sub
' 收款账号
Private Sub edtSkzh_LostFocus()
   Dim strTemp As String
   Dim iZhNy As Byte
   If edtSkzh <> "" And bSkzh Then
      bSkzh = False
      strTemp = AccIDToUnitName(edtSkzh)
      If strTemp = "" Then
         MsgBox "收款账号不存在！", vbInformation
         SetTxtFocus edtSkzh
         Exit Sub
      Else
         edtCrbm = strTemp
         edtBib = AccToExch(edtSkzh)
      End If
      iZhNy = GetZhNY(edtSkzh)
      If iZhNy = 1 Then
        MsgBox "请输入内部账户！", vbInformation
        SetTxtFocus edtSkzh
      End If
   End If

End Sub

'业务编号
Private Sub edtYwbh_LostFocus()
   If edtYwbh <> "" Then
      edtYwbh = String(8 - Len(edtYwbh), "0") & edtYwbh
   End If
End Sub

Private Sub edtZxjb_Change()
    If Not blnSavFlag And Not blnGetRecord Then
        Combo1.Visible = False
        edtYwbh.Visible = True
        blnSavFlag = True
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(1)
    End If

End Sub

Private Sub edtZxjb_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
      SendKeys "{Tab}", False
      KeyAscii = 0
      Exit Sub
   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 sqlLend As String
    
    Screen.MousePointer = vbHourglass
    Me.Icon = LoadResPicture(109, vbResIcon)
    If FindFlag Then    '查询界面
''''        sqlLend = "select * from FD_UnwDeb WHERE [cUnwID] LIKE '07%'"
''''        sqlLend = sqlLend & sqlFind
        Informtlb Me.Toolbar1, Me.ImageList1, True
        Checkqx = False
        initFind_Form
    Else
'''        sqlLend = "select * from FD_UnwDeb WHERE [cBookCode] IS NULL "
        Checkqx = Informtlb(Me.Toolbar1, Me.ImageList1, True, 11)
    End If
    If InStr(1, sqlLend, "ORDER BY", vbTextCompare) = 0 Then
         sqlLend = sqlLend & " ORDER BY [cUnwID]"
    End If
''''    Set rstLend = dbsZJ.OpenRecordset(sqlLend, dbOpenDynaset)
      If FindFlag Then
            Set rstLend = oV.getUnBookRst(True)
      Else
            Set rstLend = oV.getUnBookRst
      End If
    While Not rstLend.EOF
         Combo1.AddItem right(rstLend![cUnwID], 10)
         rstLend.MoveNext
    Wend
    If rstLend.RecordCount > 0 Then rstLend.MoveFirst
    LoadStaticRes
    InitForm
    Screen.MousePointer = vbDefault
End Sub

Private Sub initFind_Form()
    Dim i As Integer
    For i = 4 To 8
        Toolbar1.Buttons(i).Visible = False
    Next i
    For i = 15 To 16
        Toolbar1.Buttons(i).Visible = False
    Next i
End Sub

Private Sub LoadStaticRes()
    ' 将资源放这儿
   Dim id As Integer
   Command1(0).Picture = LoadResPicture(1108, vbResBitmap)
   Command1(1).Picture = LoadResPicture(1108, vbResBitmap)
   Me.Caption = "内部拆借"
   lbldkd(23) = "内部拆借单"
   label4(11) = "业务编号"
   label4(7) = "日期"
   label4(0) = "拆入部门"
   label4(1) = "拆出部门"
   label4(2) = "收款账号"
   label4(4) = "付款账号"
   label4(5) = "拆借金额"
   label4(3) = "币别"
   label4(18) = "汇率"
   label4(6) = "本位币金额"
   label4(13) = "还款日期"
   label4(10) = "利率代码"
   label4(14) = "收款经办"
   label4(12) = "付款经办"
   label4(9) = "中心经办"
   label4(8) = "摘  要"
   Label5(5) = "审核："
   Label5(4) = "记账："
   Label5(3) = "制单："

End Sub

Private Sub InitForm()
''''    Dim rsTemp As New UfRecordset
''''
''''    Set rsTemp = dbsZJ.OpenRecordset("select * from FD_Class where csign='07'", dbOpenDynaset)
    Label1(0) = oV.voucherName
    If UnionFindflag Then
        rstLend.MoveFirst
        rstLend.Find "cUnwID='" & sqlUnionkey & " '"
    End If
    If Not rstLend.EOF Then
        GetRecord
    Else
        SetFormZero
    End If
    
End Sub

'********************************************************************
'*函数说明: 取填充数据到窗体                                          *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub GetRecord()
    blnGetRecord = True
    With rstLend
        edtYwbh = right(![cUnwID], Len(![cUnwID]) - 2)       ' 业务编号
        edtYwbh.Visible = False
        blnCombo = True
'        Combo1.Text = edtYwbh          'cuidong 2001.08.23
        MoveComboByText Combo1, edtYwbh 'cuidong 2001.08.23
        Combo1.Visible = True
        blnCombo = False
        edtRq = Format(![dbill_date], "YYYY-MM-DD")   ' 业务日期
        edtCrbm = AccIDToUnitName(![cGAccID])      ' 拆入部门
        edtCcbm = AccIDToUnitName(![cPAccID])      ' 拆出部门
        edtSkzh = ![cGAccID]       ' 收款账号
        edtFkzh = ![cPAccID]       ' 付款账号
        edtJe = Format(![mMoney], "#0.00")  ' 金额
        edtBib = AccToExch(![cGAccID])    ' 币别
        edtHkrq = Format(![Dret_date], "YYYY-MM-DD")    ' 还款日期
        edtBje = Format(![mMoney_F], "#0.00")     ' 本位币
        edtLldm = ![cintrid]      ' 利率代码
        edtHl = ![nFrat]       ' 汇率
        edtSkjb = IIf(IsNull(![crun_name]), "", ![crun_name])     ' 收款经办