i-+

VB财务软件系统下载源代码提供自由下载使用学习

    Set objEO = Nothing
    Set objfrmRefCtl = Nothing
End Sub

Private Sub cmdIRate_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyRight Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub cmdOpendate_Click()
  DisplayCalendar Me.txtOpendate, Me.hWnd, Me.picView.left, Me.picView.top
  txtOpendate.SetFocus
End Sub

Private Sub cmdOpendate_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyRight Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub cmdSwitch_Click()
    GenSwitch
End Sub

Private Sub cmdYtCad_Click()
    Dim objfrmRefCtl As New frmRefCtl
    Dim objEO        As U8FDEso.EntityObject
    Dim objCadBI     As New U8FDBso.clsCadBI
    
    Set objEO = objCadBI.Init(g_sDataSourceName)
    Load objfrmRefCtl
    objfrmRefCtl.FormName = "frmAccDef"
    objfrmRefCtl.ControlName = "txtYtCad"
    objfrmRefCtl.FDRefCtrl.ReferenceType = enmCad
    Set objfrmRefCtl.FDRefCtrl.EO = objEO
    objfrmRefCtl.FDRefCtrl.Refresh
    objfrmRefCtl.Show
    Set objCadBI = Nothing
    Set objEO = Nothing
    Set objfrmRefCtl = Nothing
End Sub

Private Sub cmdYtCad_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyRight Then
        SendKeys "{TAB}"
    End If
End Sub

'Private Sub cmdFetchAdd_Click()
'    Dim iRows As Integer
'    If Len(Me.sgdEnterSubject.TextMatrix(sgdEnterSubject.Rows - 1, 1)) > 0 Then
'        sgdEnterSubject.Rows = sgdEnterSubject.Rows + 1
'        iRows = sgdEnterSubject.Rows
'        sgdEnterSubject.RowHeight(iRows - 1) = 300
'    Else
'
'    End If
'End Sub
'
'Private Sub cmdFetchDel_Click()
'If Me.sgdEnterSubject.Rows > 2 Then
'    sgdEnterSubject.Rows = sgdEnterSubject.Rows - 1
'End If
'    Me.sgdEnterSubject.Col = 3
'    Me.sgdEnterSubject.Row = 1
'    Me.sgdEnterSubject.CellBackColor = &H0
'
'End Sub

Public Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    On Error GoTo ErrHandler
    Dim ShiftDown, AltDown, CtrlDown
    ShiftDown = (Shift And vbShiftMask) > 0
    AltDown = (Shift And vbAltMask) > 0
    CtrlDown = (Shift And vbCtrlMask) > 0
    
    Select Case KeyCode
        Case vbKeyF1
            SendKeys "{F1 3}"
        Case vbKeyF3
            If Me.tlbAction.Buttons("Find").Enabled Then
                frmAccFind.m_ShowDestroy = m_ShowDestroy
                frmAccFind.Show vbModal
            End If
        Case vbKeyF5
            If Me.tlbAction.Buttons("AddNew").Enabled Then
                AddNew
            End If
        Case vbKeyF8
            If Me.tlbAction.Buttons("Edit").Enabled Then
                Edit
            End If
        Case vbKeyDelete
            If Me.tlbAction.Buttons("Delete").Enabled Then
                Delete
            End If
        Case vbKeyF6
            If Me.tlbAction.Buttons("Save").Enabled Then
                Save
            End If
        Case vbKeyZ
            If CtrlDown And Me.tlbAction.Buttons("Cancel").Enabled Then
                CancelDo
            End If
        Case vbKeyC
            If CtrlDown And Me.tlbAction.Buttons("Copy").Enabled And Me.tlbAction.Buttons("Copy").Visible Then
                CopyPaste "复制"
            End If
        Case vbKeyV
            If CtrlDown And Me.tlbAction.Buttons("Paste").Visible Then
                CopyPaste "粘贴"
            End If
        Case vbKeyP
            If CtrlDown And Me.tlbAction.Buttons("Print").Enabled Then
                If Not InitPrnGrid Then Exit Sub
                Print_Doc Me, "Print", TAB_ACCDEF
            End If
        Case vbKeyF4
            If CtrlDown Then
                Unload Me
            End If
    End Select
ErrHandler:
    Exit Sub
End Sub

Public Sub Gen_Key(TLB_Key As String)
    On Error Resume Next
    Select Case TLB_Key
        Case "Print", "Preview", "Dataout"
            If Not InitPrnGrid Then Exit Sub
             Print_Doc Me, TLB_Key, TAB_ACCDEF
    End Select
End Sub

Public Function InitPrnGrid() As Boolean
    Dim objEO           As U8FDEso.EntityObject
    Dim objclsAccUnitBI As New U8FDBso.clsAccUnitBI
    
    Set objEO = objclsAccUnitBI.Init(g_sDataSourceName)
    Set objclsAccUnitBI = Nothing
    
    InitPrnGrid = False
    With frmRightMenu.GrdPrn
        frmRightMenu.TabFlg = TAB_ACCDEF
        .Redraw = False
        .Cols = 20
        .FixedCols = 0
        .ColWidth(0) = 2205
        .ColWidth(1) = 2445
        .ColWidth(2) = 2445
        .ColWidth(3) = 990
        .ColWidth(4) = 990
        .ColWidth(5) = 705
        .ColWidth(6) = 705
        .ColWidth(7) = 705
        .ColWidth(8) = 705
        .ColWidth(9) = 1335
        .ColWidth(10) = 2635
        .ColWidth(11) = 1335
        .ColWidth(12) = 2635
        .ColWidth(13) = 1450
        .ColWidth(14) = 1450
        .ColWidth(15) = 705
        .ColWidth(16) = 705
        .ColWidth(17) = 705
        .ColWidth(18) = 705
        .ColWidth(19) = 3000
        
        Dim vt As Variant
        Dim rsl As New UfRecordset
        Dim SQL As String
        'SQL = "Select FD_AccUnit.cUnitName,cAccID,cAccName,cIntrID,cCadID,iio,FD_AccDef.itype,iDataSrc,cexch_name,mb,mh,dOpenDate " & _
        '      "from FD_AccDef INNER JOIN FD_AccUnit ON FD_AccDef.cUnitCode = FD_AccUnit.cUnitCode order by FD_AccUnit.iType,FD_AccDef.cUnitCode,FD_AccDef.cAccID"
        
        SQL = "Select " & objEO.SourceTable & "." & objEO("accunit_name").SourceField & "," & EO("accdef_code").SourceField & "," & EO("accdef_name").SourceField & "," & EO("irate_code").SourceField & "," & EO("cad_code").SourceField & "," & EO("io_flag").SourceField & "," & EO.SourceTable & "." & EO("type_flag").SourceField & "," & EO("datasrc_flag").SourceField & "," & EO("money_name").SourceField & "," & EO("qcye_mny").SourceField & "," & EO("qcye_natural_mny").SourceField & "," & EO("qcjs_mny").SourceField & "," & EO("qcjs_natural_mny").SourceField & "," & EO("open_date").SourceField & "," & EO("accbank").SourceField & _
             "," & EO("freeze_flag").SourceField & "," & EO("destroy_flag").SourceField & "," & EO("deficit_flag").SourceField & "," & EO("yt_flag").SourceField & "," & EO.SourceTable & "." & EO("digest").SourceField & " from " & EO.SourceTable & " INNER JOIN " & objEO.SourceTable & " ON " & EO.SourceTable & "." & EO("accunit_id").SourceField & "=" & objEO.SourceTable & "." & objEO("accunit_id").SourceField & " order by " & objEO.SourceTable & "." & objEO("type_flag").SourceField & "," & EO.SourceTable & "." & EO("accunit_code").SourceField & "," & EO.SourceTable & "." & EO("accdef_code").SourceField
        Set objEO = Nothing
        
        Set rsl = dbsZJ.OpenRecordset(SQL, dbOpenSnapshot)
        If rsl.EOF Then
            MsgBox "没有打印数据!", vbCritical, App.ProductName
            Exit Function
        Else
            rsl.MoveLast
            rsl.MoveFirst
        End If
        Set vt = rsl.Recordset
        .Rows = 2
        .FixedRows = 2
        .BindRecordSet vt, False, True, True
        CloseRS rsl
        
        '初始化表头及对齐方式
        .TextMatrix(0, 0) = "单位名称"
        .ColAlignment(0) = UG_ALIGNLEFT
        .JoinCells 0, 0, 1, 0, True
        
        .TextMatrix(0, 1) = "账户号"
        .ColAlignment(1) = UG_ALIGNLEFT
        .JoinCells 0, 1, 1, 1, True
        
        .TextMatrix(0, 2) = "账户名称"
        .ColAlignment(2) = UG_ALIGNLEFT
        .JoinCells 0, 2, 1, 2, True
                    
        .TextMatrix(0, 3) = "利率代码"
        .ColAlignment(3) = UG_ALIGNLEFT
        .JoinCells 0, 3, 1, 3, True
        
        .TextMatrix(0, 4) = "结息日"
        .ColAlignment(4) = UG_ALIGNLEFT
        .JoinCells 0, 4, 1, 4, True
        
        .TextMatrix(0, 5) = "类型"
        .ColAlignment(5) = UG_ALIGNCENTER
        .JoinCells 0, 5, 1, 5, True
        
        .TextMatrix(0, 6) = "标志"
        .ColAlignment(6) = UG_ALIGNCENTER
        .JoinCells 0, 6, 1, 6, True
        
        .TextMatrix(0, 7) = "数据源"
        .ColAlignment(7) = UG_ALIGNCENTER
        .JoinCells 0, 7, 1, 7, True
    
        .TextMatrix(0, 8) = "币别"
        .ColAlignment(8) = UG_ALIGNCENTER
        .JoinCells 0, 8, 1, 8, True
        
        .TextMatrix(0, 9) = "期初余额"
        .ColAlignment(9) = UG_ALIGNRIGHT
        .JoinCells 0, 9, 1, 9, True
        
        .TextMatrix(0, 10) = "期初本位币余额"
        .ColAlignment(10) = UG_ALIGNRIGHT
        .JoinCells 0, 10, 1, 10, True
    
        .TextMatrix(0, 11) = "期初积数"
        .ColAlignment(11) = UG_ALIGNRIGHT
        .JoinCells 0, 11, 1, 11, True
        
        .TextMatrix(0, 12) = "期初本位币积数"
        .ColAlignment(12) = UG_ALIGNRIGHT
        .JoinCells 0, 12, 1, 12, True
        
        .TextMatrix(0, 13) = "开户日期"
        .ColAlignment(13) = UG_ALIGNRIGHT
        .JoinCells 0, 13, 1, 13, True
        
        .TextMatrix(0, 14) = "开户银行"
        .ColAlignment(14) = UG_ALIGNRIGHT
        .JoinCells 0, 14, 1, 14, True
        
        .TextMatrix(0, 15) = "冻结"
        .ColAlignment(15) = UG_ALIGNRIGHT
        .JoinCells 0, 15, 1, 15, True
    
        .TextMatrix(0, 16) = "销户"
        .ColAlignment(16) = UG_ALIGNRIGHT
        .JoinCells 0, 16, 1, 16, True
    
        .TextMatrix(0, 17) = "赤字控制"
        .ColAlignment(17) = UG_ALIGNRIGHT
        .JoinCells 0, 17, 1, 17, True
    
        .TextMatrix(0, 18) = "预提利息"
        .ColAlignment(18) = UG_ALIGNRIGHT
        .JoinCells 0, 18, 1, 18, True
        
        .TextMatrix(0, 19) = "备注"
        .ColAlignment(19) = UG_ALIGNRIGHT
        .JoinCells 0, 19, 1, 19, True
        
        .HeadForeColor = &H404040
        .HeadFont.Name = "宋体"
        .HeadFont.Size = 9
        .HeadFont.Bold = True
    End With
    InitPrnGrid = True
End Function

Private Sub jkrTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Me.jkrTree.ZOrder 0
End Sub

Private Sub jkrTree_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Me.jkrTree.left < conMoveLimit Then
        Me.jkrTree.left = conMoveLimit
    ElseIf Me.jkrTree.left > Me.ScaleWidth - conMoveLimit Then
        Me.jkrTree.left = Me.ScaleWidth - conMoveLimit
    End If
    
    Me.treStyle.width = Me.jkrTree.left
    Me.picView.left = Me.jkrTree.left + 50
    Me.picView.width = Me.ScaleWidth - Me.treStyle.width - 50
End Sub

Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
    tlbAction_ButtonClick tlbAction.Buttons(cButtonId)
End Sub

Private Sub RefCmd4_Initialize()
    RefCmd4.InitSys zjLogInfo.UfDbName, txtIRate(1).Text
End Sub

Private Sub RefCmd4_RefCancel()
    If Me.txtIRate(1).Enabled Then Me.txtIRate(1).SetFocus
End Sub

Private Sub RefCmd4_RefOK(code As String)
    If Me.txtIRate(1).Enabled Then
        Me.txtIRate(1) = code
        Me.txtIRate(1).SetFocus
    End If
End Sub

Private Sub sgdEnterSubject_BrowUser(RetValue As String, ByVal R As Long, ByVal C As Long)
    Select Case C
        Case 1
            ShowAssRef iKm, RetValue, Switch_Mode
        Case 2
            ShowAssRef iDepart, RetValue, Switch_Mode
        Case 3
            ShowAssRef iPerson, RetValue, Switch_Mode
        Case 4
            ShowAssRef iCustomer, RetValue, Switch_Mode
        Case 5
            ShowAssRef iVendor, RetValue, Switch_Mode
        Case 6
            Dim lx As String
            lx = WKm_Propty(sgdEnterSubject.TextMatrix(R, 1), 5)
            If lx <> "" Then
                ShowAssRef iItem, RetValue, Switch_Mode, lx
            End If
    End Select
End Sub

Private Sub sgdEnterSubject_CancelRow()
    set_edstatus_browse
End Sub

Private Sub sgdEnterSubject_CellDataCheck(RetValue As String, RetState As MsSuperGrid.OpType, ByVal R As Long, ByVal C As Long)
    Dim ccdd As String
    sgdRow =