结息日设置.frm

财务信息管理系统,适合做毕业论文的人使用

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 treStyle_Collapse(ByVal Node As MSComctlLib.Node)
Node.Image = 1
End Sub

Private Sub treStyle_Expand(ByVal Node As MSComctlLib.Node)
Node.Image = 2
End Sub

Private Sub treStyle_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim objCadBI    As New U8FDBso.clsCadBI
    Dim objOID      As New U8FDEso.OIDObject
    Dim iAnswer     As VbMsgBoxResult
    
    If NodeKey <> Node.key Then ' Or m_EO.State = esoAddNew
        If Me.picView.Enabled = True Then
            iAnswer = MsgBox("放弃当前工作吗？", vbQuestion + vbYesNo)
            If iAnswer = vbNo Then
                Me.treStyle.Nodes(NodeKey).Selected = True
                Me.picView.SetFocus
                Exit Sub
            Else
                m_EditStatus = True
                CancelDo
                m_EditStatus = False
                Me.picView.Enabled = False
            End If
        End If
                        
        NodeKey = Node.key
        
        If mID(Node.key, 2, 2) = m_conBIStyle Then
            objOID.id = mID(Node.key, 2)
            Set m_EO = objCadBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, objOID)
            m_OID.id = mID(Node.child.FirstSibling.key, 2)
        Else
            objOID.id = mID(Node.Parent.key, 2)
            Set m_EO = objCadBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, objOID)
            m_OID.id = mID(Node.key, 2)
        End If
        Set objCadBI = Nothing
        Set objOID = Nothing
        SetUI
    End If
End Sub

Private Sub txtCode_CustKeyDown(ByVal key As EDITLib.KeyTypes)
    If key = KeyDown Or key = KeyRet Then
        SetEdtTxtFocus Me.txtMonth
    End If
End Sub

Private Sub txtDate_CustKeyDown(ByVal key As EDITLib.KeyTypes)
    If key = KeyDown Or key = KeyRet Then
        SetEdtTxtFocus Me.txtDelay
    ElseIf key = KeyUp Then
        SetEdtTxtFocus Me.txtMonth
    End If
End Sub

Private Sub txtDate_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 113 Then 'F2
        DisplayCalendar Me.txtDate, Me.hWnd, Me.picView.left, Me.picView.top
        txtDate.SetFocus
    End If
End Sub

Private Sub txtDate_LostFocus()
    If Me.ActiveControl.Name = "cmdDate" Then
        Exit Sub
    End If
    
    If Len(CStr(ForDate(txtDate.Text))) = 1 Then
        SetEdtTxtFocus txtDate
    Else
        txtDate.Text = ForDate(txtDate.Text)
    End If
End Sub

Private Sub txtDelay_CustKeyDown(ByVal key As EDITLib.KeyTypes)
    If key = KeyDown Or key = KeyRet Then
        SetEdtTxtFocus Me.txtDigest
    ElseIf key = KeyUp Then
        SetEdtTxtFocus Me.txtDate
    End If
End Sub

Private Sub txtDelay_KeyPress(KeyAscii As Integer)
    If KeyAscii = Asc("-") Then KeyAscii = 0
End Sub

Private Sub txtDelay_LostFocus()
    If Me.txtDelay = "" Then Exit Sub
    
    On Error GoTo lblHandel
    
    If Not IsNull(txtDelay.Text) And txtDelay.Text <> "" Then
        Dim EditText As Integer
        EditText = m_EO("delay_num")
        If txtDelay.Text > updDelay.Max Then
            txtDelay.Text = EditText
        End If
        If txtDelay.Text < updDelay.Min Then
            txtDelay.Text = EditText
        End If
    End If
    
    m_EO("delay_num") = Me.txtDelay.Text
    
    Exit Sub
    
lblHandel:
    MsgBox Err.Description, vbInformation, g_conSysName
    Me.txtDelay.SetFocus
End Sub

Private Sub txtDigest_CustKeyDown(ByVal key As EDITLib.KeyTypes)
    If key = KeyRet Then
        Save
    ElseIf key = KeyUp Then
        SetEdtTxtFocus Me.txtDelay
    End If
End Sub

Private Sub txtMonth_CustKeyDown(ByVal key As EDITLib.KeyTypes)
    If key = KeyDown Or key = KeyRet Then
        SetEdtTxtFocus Me.txtDate
    ElseIf key = KeyUp Then
        If Me.txtCode.Enabled Then SetEdtTxtFocus Me.txtCode
    End If
End Sub

Private Sub txtMonth_KeyPress(KeyAscii As Integer)
    If KeyAscii = Asc("-") Then KeyAscii = 0
    If txtMonth.SelStart = 0 Then
        If KeyAscii = Asc("0") Then KeyAscii = 0
    End If
End Sub

Private Sub txtMonth_LostFocus()
    If Me.txtMonth = "" Or Me.txtMonth = "0" Then txtMonth.Text = updMonth.Min: Exit Sub
    
    On Error GoTo lblHandel
    
    If Not IsNull(txtMonth.Text) And txtMonth.Text <> "" Then
        Dim EditText As Integer
        EditText = m_EO("month_num")
        If txtMonth.Text > updMonth.Max Then
            If EditText <> 0 Then
                txtMonth.Text = EditText
            Else
                txtMonth.Text = updMonth.Max
            End If
        End If
        If txtMonth.Text < updMonth.Min Then
            If EditText <> 0 Then
                txtMonth.Text = EditText
            Else
                txtMonth.Text = updMonth.Min
            End If
        End If
    End If
    
    m_EO("month_num") = Me.txtMonth
    
    Exit Sub
    
lblHandel:
    MsgBox Err.Description, vbInformation, g_conSysName
    Me.txtMonth.SetFocus
End Sub

Private Sub updDelay_DownClick()
    If txtDelay.Text = "" Then txtDelay.Text = updDelay.Min
    
    If txtDelay.Text > updDelay.Min And txtDelay.Text <= updDelay.Max Then
        updDelay.Value = txtDelay.Text
        updDelay.Value = updDelay.Value - 1
        txtDelay.Text = updDelay.Value
    End If
End Sub

Private Sub updDelay_UpClick()
    If txtDelay.Text = "" Then
        txtDelay.Text = updDelay.Min
    Else
        If txtDelay.Text < updDelay.Max And txtDelay.Text >= updDelay.Min Then
            updDelay.Value = txtDelay.Text
            updDelay.Value = updDelay.Value + 1
            txtDelay.Text = updDelay.Value
        End If
    End If
End Sub

Private Sub updMonth_DownClick()
    If txtMonth.Text = "" Then txtMonth.Text = updMonth.Min
    
    If txtMonth.Text > updMonth.Min And txtMonth.Text <= updMonth.Max Then
        updMonth.Value = txtMonth.Text
        updMonth.Value = updMonth.Value - 1
        txtMonth.Text = updMonth.Value
    End If
End Sub

Private Sub updMonth_UpClick()
    If txtMonth.Text = "" Then
        txtMonth.Text = updMonth.Min
    Else
        If txtMonth.Text < updMonth.Max And txtMonth.Text >= updMonth.Min Then
            updMonth.Value = txtMonth.Text
            updMonth.Value = updMonth.Value + 1
            txtMonth.Text = updMonth.Value
        End If
    End If
End Sub

Private Sub tlbAction_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.key
        Case "Print"
            PrintData
        Case "Preview"
            PrintView
        Case "Export"
            Export
'        Case "Print", "Preview", "Export"
'            If Not InitPrnGrid Then Exit Sub
'            Print_Doc Me, Button.key, TAB_CADSET
        Case "AddNew"
            AddNew
        Case "Edit"
            Edit
        Case "Delete"
            Delete
        Case "Save"
            Save
        Case "Cancel"
            CancelDo
        Case "Refresh"
            RefreshUI
        Case "Help"
            SendKeys "{F1 3}"
        Case "Exit"
            Unload Me
    End Select
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_CADSET
    End Select
End Sub

Private Function InitPrnGrid() As Boolean
    InitPrnGrid = False
    With frmRightMenu.GrdPrn
        frmRightMenu.TabFlg = TAB_CADSET
        .Redraw = False
        .Cols = 5
        .FixedCols = 0
        .ColWidth(0) = 1000
        .ColWidth(1) = 1600
        .ColWidth(2) = 1900
        .ColWidth(3) = 1900
        .ColWidth(4) = 1900
        
        Dim vt As Variant
        Dim rsl As New UfRecordset
        Dim SQL As String
        'sql = "SELECT FD_CadSet.cCadID, dClosDate, iMonth, idelay, cMark " & _
              "FROM FD_CadSet INNER JOIN FD_CadSets ON FD_CadSet.cCadID = FD_CadSets.cCadID"
        SQL = "select " & EO.SourceTable & "." & EO("cad_code").SourceField & "," & EO.EOS.EOMetaData("close_date").SourceField & "," & EO("month_num").SourceField & "," & EO("delay_num").SourceField & "," & EO("digest").SourceField & " from " & EO.SourceTable & "," & EO.EOS.EOMetaData.SourceTable & " where " & EO.SourceTable & "." & EO.SourceOIDField & "=" & EO.EOS.EOMetaData.SourceTable & "." & EO.SourceOIDField & " order by " & EO.SourceTable & "." & EO("cad_code").SourceField & "," & EO.EOS.EOMetaData("close_date").SourceField
        
        Set rsl = dbsZJ.OpenRecordset(SQL, dbOpenSnapshot)
        If rsl.EOF Then
            MsgBox "没有打印数据!", vbCritical, zjGl_Name
            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_ALIGNRIGHT
        .JoinCells 0, 2, 1, 2, True
                    
        .TextMatrix(0, 3) = "付息延期天数"
        .ColAlignment(3) = UG_ALIGNRIGHT
        .JoinCells 0, 3, 1, 3, True
        
        .TextMatrix(0, 4) = "备注"
        .ColAlignment(4) = UG_ALIGNRIGHT
        .JoinCells 0, 4, 1, 4, True
                
        .HeadForeColor = &H404040
        .HeadFont.Name = "宋体"
        .HeadFont.Size = 9
        .HeadFont.Bold = True
    End With
    InitPrnGrid = True
End Function

Private Sub PrintData()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML
    frmRightMenu.ocxPrint.DoPrint
End Sub

Private Sub PrintView()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML
    frmRightMenu.ocxPrint.PrintPreview
End Sub

Private Sub Export()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML
    frmRightMenu.ocxPrint.ExportToFile 0, PrintTypeList, PrintSizeList, "", ""
End Sub

Public Sub SetPrintDataStyleXML()
    Dim lRet        As Long
    Dim sData       As String
    Dim sStyle      As String
    Dim sModuleId   As String
    Dim SQL         As String
    
    On Error GoTo lblHandle
    
    SQL = "select " & EO.SourceTable & "." & EO("cad_code").SourceField & " as 结息日代码," & EO.EOS.EOMetaData("close_date").SourceField & " as 日期," & EO("month_num").SourceField & " as [结息周期(月)]," & EO("delay_num").SourceField & " as 延期天数," & EO("digest").SourceField & " as 备注 from " & EO.SourceTable & "," & EO.EOS.EOMetaData.SourceTable & " where " & EO.SourceTable & "." & EO.SourceOIDField & "=" & EO.EOS.EOMetaData.SourceTable & "." & EO.SourceOIDField & " order by " & EO.SourceTable & "." & EO("cad_code").SourceField & "," & EO.EOS.EOMetaData("close_date").SourceField
    
    sData = SetPrintDataXML(SQL, "结息日定义", PrintTypeList, PrintSizeList)
    sStyle = SetPrintStyleXML("")
    sModuleId = "Default"
    
    lRet = frmRightMenu.ocxPrint.SetDataStyleXML(sData, False, sStyle, False, sModuleId)
    If lRet <> 0 Then
        MsgBox "打印数据格式设置失败！", vbInformation, App.ProductName
        SetPrintDataStyleXML_flag = False
    End If
    
    SetPrintDataStyleXML_flag = True
    Exit Sub
lblHandle:
    SetPrintDataStyleXML_flag = False
    MsgBox "打印数据格式设置失败！", vbInformation, App.ProductName
End Sub