项目定义.frm

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

   If Not blnRuned Then lngDl1 = 0
   If lngDl1 = cobDl1.ListIndex + 1 Then Exit Sub
   lngDl1 = cobDl1.ListIndex + 1
   
   FillListBoxDl Option1(0)
   
End Sub

Private Sub cobDl2_Click()
   Static lngDl2 As Long
   If blnRuned Then
      cobDl1.ListIndex = cobDl2.ListIndex
      cobDl3.ListIndex = cobDl2.ListIndex
   End If
   If Not blnRuned Then lngDl2 = 0
   If lngDl2 = cobDl2.ListIndex + 1 Then Exit Sub
   lngDl2 = cobDl2.ListIndex + 1
   
   FillFlxgrid
   
End Sub

Private Sub cobDl3_Click()
   Static lngDl3 As Long
   If blnRuned Then
      cobDl1.ListIndex = cobDl3.ListIndex
      cobDl2.ListIndex = cobDl3.ListIndex
   End If
   If Not blnRuned Then lngDl3 = 0
   If lngDl3 = cobDl3.ListIndex + 1 Then Exit Sub
   lngDl3 = cobDl3.ListIndex + 1
   blnDlXmKm = False
   
   FillComboXm

End Sub

Private Sub cobXm_Click()
   Static lngXm As Long
   
   If Not blnRuned Or Not blnDlXmKm Then lngXm = 0
   If lngXm = cobXm.ListIndex + 1 Then Exit Sub
   lngXm = cobXm.ListIndex + 1
   
   FillListBoxXm
   blnDlXmKm = True
   
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   Shift = Shift And 7
   Select Case KeyCode
      Case vbKeyF5
          If Shift = 0 Then
              Gen_Key "Modify"
          End If
      Case vbKeyF4
          If Shift = vbCtrlMask And Toolbar1.Buttons("Exit").Enabled Then
              Gen_Key "Exit"
          End If
          KeyCode = 0
   End Select
End Sub

Private Sub Form_Load()
   Dim rsX As New UfRecordset, sqlX As String
   
   Screen.MousePointer = vbHourglass
   Me.Height = 5200
   Me.Width = 7400
   Me.Icon = LoadResPicture(109, vbResIcon)
   ItemTlb Toolbar1, ImageList1
   InitFlxgrid
   Option2(0).Enabled = False
   Option2(1).Enabled = False
   blnRuned = False
   blnDlXmKm = True
   sqlX = "SELECT [cItems_name] AS ItemName FROM FD_Item"
   Set rsX = dbsZJ.OpenRecordset(sqlX, dbOpenSnapshot)
   If Not rsX.EOF Then
      FillComboDl cobDl1, rsX
      rsX.MoveFirst
      FillComboDl cobDl2, rsX
      rsX.MoveFirst
      FillComboDl cobDl3, rsX
   End If
   CenterForm Me
   blnRuned = True
   Screen.MousePointer = vbDefault
   
End Sub

Private Sub FillComboDl(mCombo As ComboBox, rsCombo As UfRecordset)
   mCombo.Clear
   With rsCombo
      While Not .EOF
         mCombo.AddItem ![ItemName]
         .MoveNext
      Wend
   End With
   mCombo.Text = mCombo.List(0)
   
End Sub

Private Sub FillComboXm()
   Dim i As Long, j As Long, sqlX As String, rsX As New UfRecordset
   
   sqlX = "SELECT [igrade], [citem_name] AS ItemName, [iitem_id] AS [ItemID] " & _
          "FROM FD_Items WHERE [iitems_id] = " & (cobDl3.ListIndex + 1) & _
          " ORDER BY [citem_id]"
   Set rsX = dbsZJ.OpenRecordset(sqlX, dbOpenSnapshot)
   
   ReDim lngXmID(iXmID)
   cobXm.Clear
   i = 0: j = 0
   With rsX
      If .EOF Then               'Cuidong 2000/08/09
         lstKm2.Clear            'Cuidong 2000/08/09
      Else                       'Cuidong 2000/08/09
         While Not .EOF
            cobXm.AddItem Space(![iGrade] * 3 - 3) & ![ItemName]
            lngXmID(j) = ![ItemID]
            j = j + 1
            If j >= i + iXmID Then
               ReDim Preserve lngXmID(j + iXmID)
               i = i + iXmID
            End If
            .MoveNext
         Wend
      End If                     'Cuidong 2000/08/09
   End With
   If cobXm.ListCount <> 0 Then cobXm.Text = cobXm.List(0)
   
End Sub

Private Sub FillListBoxDl(bOption As Boolean)
   Dim rsLst As New UfRecordset, sqlLst As String
   
   If bOption Then
      sqlLst = "SELECT DISTINCT FD_Itemss.[ccode] AS mCode, FD_AccDef.[cAccName] AS mName " & _
         "FROM FD_Itemss INNER JOIN FD_AccDef ON FD_Itemss.[ccode] = " & _
         "FD_AccDef.[cAccID] WHERE FD_Itemss.[iitem_id] IN (SELECT [iitem_id] " & _
         "FROM FD_Items WHERE [iitems_id] = " & (cobDl1.ListIndex + 1) & _
         " AND [bSource] = 0)"
   Else
      sqlLst = "SELECT DISTINCT FD_Itemss.[ccode] AS mCode, code.[ccode_name] AS mName " & _
         "FROM FD_Itemss INNER JOIN code ON FD_Itemss.[ccode] = " & _
         "code.[ccode] WHERE FD_Itemss.[iitem_id] IN (SELECT [iitem_id] " & _
         "FROM FD_Items WHERE [iitems_id] = " & (cobDl1.ListIndex + 1) & _
         " AND [bSource] <> 0)"
   End If
   Set rsLst = dbsZJ.OpenRecordset(sqlLst, dbOpenSnapshot)
   lstKm1.Clear
   While Not rsLst.EOF
      lstKm1.AddItem "[" & rsLst![mCode] & "] " & rsLst![mName]
      rsLst.MoveNext
   Wend
   
End Sub

Private Sub FillListBoxXm()
   Dim rsLst As New UfRecordset, sqlLst As String
   Dim bOption As Boolean
   
   lstKm2.Clear
   Set rsLst = dbsZJ.OpenRecordset("SELECT [bSource], [bend] FROM FD_Items WHERE [iitem_id]=" & lngXmID(cobXm.ListIndex), dbOpenSnapshot)
   If Not rsLst.EOF Then
      bOption = Not rsLst![bSource]
      Option2(0) = bOption
      Option2(1) = Not bOption
      If Not rsLst![bend] Then Exit Sub
   End If
   If bOption Then
      sqlLst = "SELECT FD_Itemss.[ccode] AS mCode, FD_AccDef.[cAccName] AS mName " & _
         "FROM FD_Itemss INNER JOIN FD_AccDef ON FD_Itemss.[ccode] = " & _
         "FD_AccDef.[cAccID] WHERE FD_Itemss.[iitem_id] IN (SELECT [iitem_id] " & _
         "FROM FD_Items WHERE [iitems_id] = " & (cobDl3.ListIndex + 1) & _
         " AND [iitem_id] = " & lngXmID(cobXm.ListIndex) & ")"
   Else
      sqlLst = "SELECT FD_Itemss.[ccode] AS mCode, code.[ccode_name] AS mName " & _
         "FROM FD_Itemss INNER JOIN code ON FD_Itemss.[ccode] = " & _
         "code.[ccode] WHERE FD_Itemss.[iitem_id] IN (SELECT [iitem_id] " & _
         "FROM FD_Items WHERE [iitems_id] = " & (cobDl3.ListIndex + 1) & _
         " AND [iitem_id] = " & lngXmID(cobXm.ListIndex) & ")"
   End If
   Set rsLst = dbsZJ.OpenRecordset(sqlLst, dbOpenSnapshot)
   While Not rsLst.EOF
      lstKm2.AddItem "[" & rsLst![mCode] & "] " & rsLst![mName]
      rsLst.MoveNext
   Wend
   
End Sub

Private Sub Option1_Click(Index As Integer)
   FillListBoxDl Option1(0)
   
End Sub

Private Sub InitFlxgrid()
   With flgXm
      .Cols = 2
      .Rows = 2
      .RowHeight(1) = 0
      .FixedRows = 1
      
      .ColWidth(0) = 1500
      .ColWidth(1) = 2200
      .TextMatrix(0, 0) = "项目编码"
      .TextMatrix(0, 1) = "项目名称"
      .ColAlignment(0) = 0
      .ColAlignment(1) = 0
      
      .Row = 0
      .Col = 0
      .CellAlignment = 4
      .Col = 1
      .CellAlignment = 4
   End With
   
End Sub

Private Sub FillFlxgrid()
   Dim rsGrid As New UfRecordset, sqlGrid As String
   
   sqlGrid = "SELECT * FROM FD_Items WHERE [iitems_id] = " & (cobDl2.ListIndex + 1) & _
           " ORDER BY [citem_id]"
   Set rsGrid = dbsZJ.OpenRecordset(sqlGrid, dbOpenSnapshot)
   flgXm.Rows = 2
   While Not rsGrid.EOF
      flgXm.AddItem rsGrid![cItem_id] & vbTab & Space(rsGrid![iGrade] * 3 - 3) & rsGrid![cItem_Name]
      rsGrid.MoveNext
   Wend
   
End Sub

Public Sub RefreshMe()
   Dim sqlX As String, rsX As New UfRecordset
   
   Screen.MousePointer = vbHourglass
   blnRuned = False
   blnDlXmKm = True
   sqlX = "SELECT [cItems_name] AS ItemName FROM FD_Item"
   Set rsX = dbsZJ.OpenRecordset(sqlX, dbOpenSnapshot)
   If Not rsX.EOF Then
      FillComboDl cobDl1, rsX
      rsX.MoveFirst
      FillComboDl cobDl2, rsX
      rsX.MoveFirst
      FillComboDl cobDl3, rsX
   End If
   blnRuned = True
   Screen.MousePointer = vbDefault
   
End Sub

Private Sub Gen_Key(TLB_Key As String)
   Dim i As Long
   
   Select Case TLB_Key
      Case "Modify"
         Unload frmItmWzd
         Set frmItmWzd = Nothing
         With frmItmWzd
            Load frmItmWzd
            For i = 0 To 3
               .cobDl.List(i) = cobDl1.List(i)
            Next i
            .cobDl.ListIndex = cobDl1.ListIndex
            .Show vbModal
            DoEvents
            If blnRefresh Then
               RefreshMe
               blnRefresh = False
            End If
         End With
      Case "Help"
         SendKeys "{F1}"
      Case "Exit"
         Unload Me
   End Select

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
   Gen_Key Button.key
   
End Sub