clscad.cls

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

'            MsgBox "结息日编码设置冲突!", vbCritical, zjGl_Name
'            Exit Function
'        End If
'        jxrst.oClose
'      Case Child_Add
'        If FindNode(.tvwCad, True, .txt(0), .txt(1)) Then
'          MsgBox "结息日设置冲突!", vbCritical, zjGl_Name
'          Exit Function
'        End If
'      Case Child_Edit
''        If FindDupNode(.tvwCad, curNode, .txt(1)) Then
''          MsgBox "结息日设置冲突!", vbCritical, zjGl_Name
''          Exit Function
''        End If
'    End Select
'  End With
'
'  Valid = True
  
End Function

Private Function IsNodeExist(tvw As TreeView, cur_node As Node, key1 As String, key2 As String, _
                              Optional bAdd As Boolean) As Boolean

Dim nodx As Node, pnode As Node
Dim key As String

  IsNodeExist = True
  If IsMissing(bAdd) Then bAdd = True
  
  If cur_node.Parent Is Nothing Then
    Set pnode = cur_node
  Else
    Set pnode = cur_node.Parent
  End If
  
  If key2 = vbNullString Then
    key = key1
  Else
    key = key1 + Chr(9) + key2
  End If
  
  For Each nodx In tvw.Nodes
    If nodx.Parent Is Nothing Then GoTo NextFor
    If nodx.Parent = pnode Then
      If bAdd Then
        If nodx.Text = key Then Exit Function
      Else
        If nodx <> cur_node And nodx.Text = key Then Exit Function
      End If
    End If
NextFor:
  Next
  
  IsNodeExist = False
End Function

Private Function IsCurrentPeriod(dPre As Date, lngMonth As Long) As Boolean
   Dim rsTemp  As New UfRecordset
   Dim sqlTemp As String
   Dim dEnd    As Date
   Dim dNow    As Date
   
   sqlTemp = "Select dEnd From UA_Period Where cAcc_ID='" & zjLogInfo.cacc_id & "' And iYear=" & zjLogInfo.cIYear & " Order By iID DESC"
   Set rsTemp = zjLogInfo.UfSystemDb.OpenRecordset(sqlTemp, dbOpenSnapshot)
   If rsTemp.EOF Then Exit Function
   dEnd = rsTemp!dEnd
   CloseRS rsTemp
   
   On Error GoTo lblErr
   Dim iYear   As Long
   Dim iMonth  As Long
   Dim iDay    As Long
   
   iMonth = (Month(dPre) + lngMonth) Mod 12
   If iMonth = 0 Then iMonth = 12
   iYear = Year(dPre) + (Month(dPre) + lngMonth - 1) \ 12
   iDay = Day(dPre)
   dNow = CDate(iYear & "-" & iMonth & "-" & iDay)
   
   If dNow <= dEnd Then IsCurrentPeriod = True
   Exit Function
lblErr:
   iDay = iDay - 1
   Resume
End Function

Public Sub SaveChange1()

'Dim cID As String
'Dim nodx As Node
'Dim PreDate As Date
'Dim sql As String
'Dim rsl As New UfRecordset
'Dim iDay As Integer
'Dim Count As Integer
'
'On Error Resume Next
'saver1:
'    If Not Valid Then Exit Sub
'
'  If edstatus = Child_Add Then
'    cID = rsCad!cCadID
'    rsCads.AddNew
'    rsCads!cCadID = cID
'    rsCads!dClosDate = frmCadSet.txt(1).Text
'    rsCads.Update
'    If Err.Number = 3022 Then GoTo saver1
'
'    rsCads.FindFirst "cCadID = '" & cID & "' And dClosDate = #" & frmCadSet.txt(1) & "#"
'
'    Set nodx = frmCadSet.tvwCad.Nodes.Add("o" + cID, tvwChild, "t" + CStr(rsCads!iID), frmCadSet.txt(1), "leaf", "leafsel")
'    nodx.Tag = rsCads!iID
'    nodx.Sorted = True
'    nodx.Selected = True
'  ElseIf edstatus = Child_Edit Then
'    rsCad.FindFirst "cCadID = '" & frmCadSet.txt(0) & "'"
'    rsCad.Delete                                              'Cuidong 2000/08/16
'    rsCads.FindFirst "cCadID = '" & frmCadSet.txt(0) & "'"    'Cuidong 2000/08/16
'    Do While Not rsCads.NoMatch                               'Cuidong 2000/08/16
'       rsCads.Delete                                          'Cuidong 2000/08/16
'       rsCads.FindNext "cCadID = '" & frmCadSet.txt(0) & "'"  'Cuidong 2000/08/16
'    Loop                                                      'Cuidong 2000/08/16
'    With frmCadSet.tvwCad                                     'Cuidong 2000/08/16
'        .Nodes.Remove ("o" + frmCadSet.txt(0))                'Cuidong 2000/08/16
'    End With                                                  'Cuidong 2000/08/16
'    edstatus = Parent_Add                                     'Cuidong 2000/08/16
'    GoTo saver1:                                              'Cuidong 2000/08/16
'
'''    If Not rsCads.NoMatch Then 'Cuidong 2000/08/15          'Cuidong 2000/08/16
''    If Not rsCad.NoMatch Then   'Cuidong 2000/08/15          'Cuidong 2000/08/16
''      rsCad.edit                                             'Cuidong 2000/08/16
''      rsCad!iDelay = IIf(frmCADSet.txt(2) = "", 0, frmCADSet.txt(2))   'Cuidong 2000/08/16
''      rsCad!cMark = IIf(frmCADSet.txt(3) = "", Null, frmCADSet.txt(3)) 'Cuidong 2000/08/16
''      rsCad.Update                                           'Cuidong 2000/08/16
''      If Err.Number = 3022 Then GoTo saver1                  'Cuidong 2000/08/16
''
''      rsCads.FindFirst "cCadID='" & frmCADSet.txt(0).Text & "' And dClosDate='" & StrOldDate & "'" 'Cuidong 2000/08/16
''      If Not rsCads.NoMatch Then                             'Cuidong 2000/08/16
''         rsCads.edit                                         'Cuidong 2000/08/16
''         rsCads!dClosDate = frmCADSet.txt(1).Text            'Cuidong 2000/08/16
''         rsCads.Update                                       'Cuidong 2000/08/16
''      End If                                                 'Cuidong 2000/08/16
''    End If                                                   'Cuidong 2000/08/16
''    frmCADSet.Command1.Enabled = False                       'Cuidong 2000/08/16
'    Exit Sub
'  ElseIf edstatus = Parent_Add Then
'    rsCad.AddNew
'    rsCad!cCadID = frmCadSet.txt(0).Text
'    rsCad!iDelay = IIf(frmCadSet.txt(2) = "", 0, frmCadSet.txt(2))
'    rsCad!cMark = IIf(frmCadSet.txt(3) = "", Null, frmCadSet.txt(3))
'    rsCad!iMonth = CInt(frmCadSet.txt(5))
'    rsCad.Update
'    If Err.Number = 3022 Then GoTo saver1
'    PreDate = frmCadSet.txt(1).Text
'    Count = 0
'    Do While True
'        rsCads.AddNew
'        rsCads!cCadID = frmCadSet.txt(0)
'        rsCads!dClosDate = RetEndDay(PreDate, Count * CInt(frmCadSet.txt(5)))
'        rsCads.Update
'        If Err.Number = 3022 Then GoTo saver1
'        Count = Count + 1
'        If Not IsCurrentPeriod(PreDate, Count * CInt(frmCadSet.txt(5))) Then Exit Do
'    Loop
'
'    Set nodx = frmCadSet.tvwCad.Nodes.Add(, , "o" + frmCadSet.txt(0), frmCadSet.txt(0), "tree", "seltree")
'    nodx.Tag = frmCadSet.txt(0)
'    nodx.Sorted = True
'
'    sql = "select * from FD_CadSets where cCadID='" & frmCadSet.txt(0) & "'"
'    Set rsl = dbsZJ.OpenRecordset(sql, dbOpenSnapshot)
'    While Not rsl.EOF
'        Set nodx = frmCadSet.tvwCad.Nodes.Add("o" + frmCadSet.txt(0), tvwChild, "t" + CStr(rsl!iID), Format(rsl!dClosDate, "yyyy-mm-dd"), "leaf", "leafsel")
'        nodx.Tag = rsl!iID
'        nodx.Sorted = True
'        nodx.EnsureVisible
'        nodx.Selected = True
'        rsl.MoveNext
'    Wend
'  End If
'
'  GenMove
'  Call frmCadSet.tvwCad.SetFocus
'
'  set_edstatus_true_1
'
End Sub

Private Sub set_edstatus_true_1()

'  edstatus = Child_Edit
'
'  With frmCadSet
'    .txt(0).Enabled = False
'    .Command1.Enabled = False
'  End With

End Sub

Public Function valid2() As Boolean

valid2 = True

End Function


Public Sub GenDel1()

'Dim nodx As Node
'
'    If MsgBox("是否删除当前结息日?", vbQuestion + vbOKCancel, zjGl_Name) _
'              = vbCancel Then Exit Sub
'
'    With frmCadSet.tvwCad
'        Set nodx = curNode.Parent
'        .Nodes.Remove (curNode.Index)
'        rsCads.Delete
'        If nodx.Child Is Nothing Then
'            .Nodes.Remove nodx.Index
'            rsCad.Delete
'        End If
'    End With
'    With rsCad
'        .MoveFirst
'        If .EOF Then
'            Set_rsnull_true
'            GenAdd2
'            Exit Sub
'        End If
'    End With
'    GenMove
'    Call frmCadSet.tvwCad.SetFocus
 
End Sub

Public Sub GenDel2()
'    On Error Resume Next
'    If frmCadSet.UsedFlag1.Visible Then
'        MsgBox "当前结息日代码已使用，不能删除！", vbCritical, zjGl_Name
'        Exit Sub
'    End If
'    If MsgBox("是否确认删除此结息日编码?", vbQuestion + vbOKCancel, zjGl_Name) = vbCancel Then Exit Sub
'    dbsZJ.Execute "delete from FD_Cadsets where cCadID='" & rsCad!cCadID & "'"
'    rsCad.Delete
'    frmCadSet.tvwCad.Nodes.Remove (curNode.Index)
'
'    If frmCadSet.tvwCad.SelectedItem Is Nothing Then
'      GenAdd2
'    Else
'      GenMove
'      Call frmCadSet.tvwCad.SetFocus
'    End If

End Sub

Public Sub GenExit()
  
  Unload frmCadSet
  
End Sub