form9.frm

一套收费计算机系统

Private Sub Command1_Click()
Load frmSplash
frmSplash.Show
DoEvents

'为城市户出表
  hzzde.Commands("daycnn").Parameters(0).Value = jfd
  
  hzzde.Commands("daycnn").Parameters(1).Value = jfx
     
  hzzde.Commands("daycnn").Parameters(2).Value = "城市户"
  
  hzzde.Commands("daycnn").Execute
        
  If hzzde.rsdaycnn.State <> adStateOpen Then
  hzzde.rsdaycnn.Open
  End If
  
  hzzde.rsdaycnn.Requery '使记录集重新定位
  If hzzde.rsdaycnn.RecordCount = 0 Then
  '实际无用___________
    MSHFlexGrid1.Clear
    MsgBox "符合此条件的记录不存在，请重新选择", vbOKOnly, "警示"
    Exit Sub
  '____________________
  Else
    Set MSHFlexGrid1.DataSource = hzzde
    MSHFlexGrid1.DataMember = "daycnn"
    MSHFlexGrid1.Refresh
    MSHFlexGrid1.Redraw = True
    '城市户三计赋值
    If Not IsNull(hzzde.rsdaycnn.Fields(0).Value) Then
      Label14.Caption = hzzde.rsdaycnn.Fields(0).Value
    Else
      Label14.Caption = "0"
    End If
    If Not IsNull(hzzde.rsdaycnn.Fields(1).Value) Then
      Label15.Caption = hzzde.rsdaycnn.Fields(1).Value
    Else
      Label15.Caption = "0"
    End If
    If Not IsNull(hzzde.rsdaycnn.Fields(2).Value) Then
      Label16.Caption = hzzde.rsdaycnn.Fields(2).Value
    Else
      Label16.Caption = "0"
    End If
    
    Label25.Caption = Trim(Text3.Text)
  End If
  
'为农村户出表
  hzzde.Commands("daycnn").Parameters(2).Value = "农村户"
  
  hzzde.Commands("daycnn").Execute
        
  If hzzde.rsdaycnn.State <> adStateOpen Then
  hzzde.rsdaycnn.Open
  End If
  
  hzzde.rsdaycnn.Requery '使记录集重新定位
  If hzzde.rsdaycnn.RecordCount = 0 Then
  '实际无用___________
    MSHFlexGrid1.Clear
    MsgBox "符合此条件的记录不存在，请重新选择", vbOKOnly, "警示"
    Exit Sub
  '___________________
  Else
    Set MSHFlexGrid2.DataSource = hzzde
    MSHFlexGrid2.DataMember = "daycnn"
    MSHFlexGrid2.Refresh
    MSHFlexGrid2.Redraw = True
    '农村户三计赋值
    If Not IsNull(hzzde.rsdaycnn.Fields(0).Value) Then
      Label19.Caption = hzzde.rsdaycnn.Fields(0).Value
    Else
      Label19.Caption = "0"
    End If
    If Not IsNull(hzzde.rsdaycnn.Fields(1).Value) Then
      Label18.Caption = hzzde.rsdaycnn.Fields(1).Value
    Else
      Label18.Caption = "0"
    End If
    If Not IsNull(hzzde.rsdaycnn.Fields(2).Value) Then
      Label17.Caption = hzzde.rsdaycnn.Fields(2).Value
    Else
      Label17.Caption = "0"
    End If
    
    Label26.Caption = Trim(Text3.Text)
    '总计赋值
    Label23.Caption = Str(Val(Label14.Caption) + Val(Label19.Caption))
    Label22.Caption = Str(Val(Label15.Caption) + Val(Label18.Caption))
    Label21.Caption = Str(Val(Label16.Caption) + Val(Label17.Caption))
    
    Label4.Caption = Label21.Caption
    Label8.Caption = Label16.Caption
    Label11.Caption = Label17.Caption
  End If
  
  Unload frmSplash
  
'绘制图表
  hzzde.Commands("daychart").Parameters(0).Value = jfd
  
  hzzde.Commands("daychart").Parameters(1).Value = jfx
     
  hzzde.Commands("daychart").Execute
        
  If hzzde.rsdaychart.State <> adStateOpen Then
  hzzde.rsdaychart.Open
  End If
  
  hzzde.rsdaychart.Requery '使记录集重新定位
  
    '曾经出现问题，发现错误触发点为在mschart1.pointselected中未hzzde.rsdaychart.adnonefilter
  If hzzde.rsdaychart.RecordCount <> 0 Then
  
    hzzde.rsdaychart.MoveFirst
    
    Dim i As Integer
    Dim rsfirst As Date
    Dim rslast As Date
    i = 0
    Do While Not hzzde.rsdaychart.EOF
      rsfirst = hzzde.rsdaychart.Fields(0).Value
      hzzde.rsdaychart.MoveNext
      
        If hzzde.rsdaychart.EOF Then
          i = i + 1
          Exit Do
        Else
          rslast = hzzde.rsdaychart.Fields(0).Value
        End If
        
        If rsfirst = rslast Then
          i = i + 1
          hzzde.rsdaychart.MoveNext
        Else
          i = i + 1
        End If
    Loop
   
   ReDim cchart(1 To i, 1 To 3) As Variant
   hzzde.rsdaychart.MoveFirst '重新定位第一个记录，再次循环以赋值
   Dim j As Integer
   Dim cshj As Integer
   Dim nchj As Integer
    j = 0
    Do While Not hzzde.rsdaychart.EOF
      rsfirst = hzzde.rsdaychart.Fields(0).Value
        If hzzde.rsdaychart.Fields(1).Value = "城市户" Then
           cshj = hzzde.rsdaychart.Fields(4).Value
           nchj = 0
        Else
           nchj = hzzde.rsdaychart.Fields(4).Value
           cshj = 0
        End If
        
      hzzde.rsdaychart.MoveNext
      
        If hzzde.rsdaychart.EOF Then
          j = j + 1
  
          cchart(j, 1) = Str(Day(rsfirst))
          cchart(j, 2) = cshj
          cchart(j, 3) = nchj
          Exit Do
        Else
          rslast = hzzde.rsdaychart.Fields(0).Value
        End If
        
        If rsfirst = rslast Then
          j = j + 1
          cchart(j, 1) = Str(Day(hzzde.rsdaychart.Fields(0).Value))
            If hzzde.rsdaychart.Fields(1).Value = "城市户" Then
               cchart(j, 2) = hzzde.rsdaychart.Fields(4).Value
               cchart(j, 3) = nchj
            Else
               cchart(j, 3) = hzzde.rsdaychart.Fields(4).Value
               cchart(j, 2) = cshj
            End If
          hzzde.rsdaychart.MoveNext
        Else
          j = j + 1
          cchart(j, 1) = Str(Day(rsfirst))
          cchart(j, 2) = cshj
          cchart(j, 3) = nchj
        End If
   Loop
  MSChart1.ShowLegend = True
  MSChart1.ChartData = cchart
  havechart = True '图表已绘出
Else
  ReDim cchart(1 To 1, 1 To 3) As Variant
  cchart(1, 1) = ""
  cchart(1, 2) = 0
  cchart(1, 3) = 0
  MSChart1.ShowLegend = False
  MSChart1.ChartData = cchart
  havechart = False '图表未绘出
End If

MSChart1.Column = 1
MSChart1.ColumnLabel = "城市户"
'MSChart1.ColumnLabelIndex = 2
MSChart1.Column = 2
MSChart1.ColumnLabel = "农村户"
'MSChart1.ColumnLabelIndex = 1

With MSChart1
      .Plot.Light.LightSources(1).Set 10, 10, 10, 1
End With



Command1.Enabled = False '关闭Command1

End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Toolbar1.Visible = False
Toolbar2.Visible = False
Toolbar3.Visible = False
Toolbar4.Visible = False
End Sub

Private Sub Form_Load()
entrydate = Now()

  MSHFlexGrid1.ColWidth(0, 0) = 100
  MSHFlexGrid1.ColWidth(1, 0) = 0
  MSHFlexGrid1.ColWidth(2, 0) = 0
  MSHFlexGrid1.ColWidth(3, 0) = 0
  MSHFlexGrid1.ColWidth(0, 1) = 900
  MSHFlexGrid1.ColWidth(1, 1) = 700
  MSHFlexGrid1.ColWidth(2, 1) = 710
  MSHFlexGrid1.ColWidth(3, 1) = 710
  MSHFlexGrid1.ColWidth(4, 1) = 710
  MSHFlexGrid1.RowHeight(0) = 600
  MSHFlexGrid1.MergeCol(1) = True
  MSHFlexGrid1.MergeCol(2) = True
  MSHFlexGrid1.MergeCol(3) = True
  MSHFlexGrid1.MergeCol(4) = True
  MSHFlexGrid1.MergeCol(5) = True
'  MSHFlexGrid1.MergeCol(6) = True
'  MSHFlexGrid1.MergeCol(7) = True
'  MSHFlexGrid1.MergeCol(8) = True
  
MSHFlexGrid1.BackColorFixed = vbCyan
MSHFlexGrid1.BackColorSel = &HFF8080
MSHFlexGrid1.BackColor = &HFF8080

MSHFlexGrid1.ScrollTrack = True
  
  MSHFlexGrid2.ColWidth(0, 0) = 100
  MSHFlexGrid2.ColWidth(1, 0) = 0
  MSHFlexGrid2.ColWidth(2, 0) = 0
  MSHFlexGrid2.ColWidth(3, 0) = 0
  MSHFlexGrid2.ColWidth(0, 1) = 900
  MSHFlexGrid2.ColWidth(1, 1) = 700
  MSHFlexGrid2.ColWidth(2, 1) = 710
  MSHFlexGrid2.ColWidth(3, 1) = 710
  MSHFlexGrid2.ColWidth(4, 1) = 710
  MSHFlexGrid2.RowHeight(0) = 600
  MSHFlexGrid2.MergeCol(1) = True
  MSHFlexGrid2.MergeCol(2) = True
  MSHFlexGrid2.MergeCol(3) = True
  MSHFlexGrid2.MergeCol(4) = True
  MSHFlexGrid2.MergeCol(5) = True
'  MSHFlexGrid2.MergeCol(6) = True
'  MSHFlexGrid2.MergeCol(7) = True
'  MSHFlexGrid2.MergeCol(8) = True

MSHFlexGrid2.BackColorFixed = vbCyan
MSHFlexGrid2.BackColorSel = &H80FF80
MSHFlexGrid2.BackColor = &H80FF80

havechart = False

Load Form9tip '装载标记窗口

Command1.Enabled = False '关闭Command1
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call history(staff, entrydate, Me.Caption, Now())
Unload Form9tip
End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Toolbar1.Visible = False
Toolbar2.Visible = False
Toolbar3.Visible = False
Toolbar4.Visible = False
End Sub

Private Sub MSChart1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If x <= MSChart1.Width And y <= MSChart1.Height Then
  Toolbar1.Visible = True
  Toolbar1.Left = x + (9480 - MSChart1.Width)
  Toolbar1.Top = y + 800
  
If MSChart1.ChartType = VtChChartType3dLine Or MSChart1.ChartType = VtChChartType3dBar Then
  Toolbar3.Visible = True
  Toolbar3.Left = x + (9480 - MSChart1.Width) + 350
  Toolbar3.Top = y + 1190
  
  Toolbar2.Visible = True
  Toolbar2.Left = x + (9480 - MSChart1.Width)
  Toolbar2.Top = y + 1580
  
  Toolbar4.Visible = True
  Toolbar4.Left = x + (9480 - MSChart1.Width) + 350
  Toolbar4.Top = y + 1970
End If

If MSChart1.ChartType = VtChChartType2dLine Or MSChart1.ChartType = VtChChartType2dBar Then

  Toolbar2.Visible = False
  Toolbar3.Visible = False
  Toolbar4.Visible = False
End If
End If
'为标记窗口位置赋值
sx = x + (9480 - MSChart1.Width)
sy = y + 800
End Sub

Private Sub MSChart1_PlotSelected(MouseFlags As Integer, Cancel As Integer)
If havechart Then
  chen = 0: nong = 0: shou = 0: chu = 0
  
  dyear = Text2.Text
  dmonth = Text3.Text
  dday = ""
  
  qhj = Val(Label21.Caption)
  chen = Val(Label16.Caption)
  nong = Val(Label17.Caption)
  shou = Val(Label23.Caption)
  chu = Val(Label22.Caption)
  
  Form9tip.Show
End If
End Sub

Private Sub MSChart1_PointSelected(Series As Integer, DataPoint As Integer, MouseFlags As Integer, Cancel As Integer)
If havechart Then
  chen = 0: nong = 0: shou = 0: chu = 0
  
  dyear = Text2.Text
  dmonth = Text3.Text
  dday = cchart(DataPoint, 1)
  
  Dim num As Double
  If (Val(dyear) - 2000) Mod 4 <> 0 Then '年
    num = 36525 + 365 * (Val(dyear) - 2000) + ((Val(dyear) - 2000) \ 4 + 1)
  Else
    num = 36525 + 365 * (Val(dyear) - 2000) + ((Val(dyear) - 2000) \ 4)
  End If
  
  If dmonth = "2" Then '月
    num = num + 31
  End If
  If dmonth = "3" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29
    Else
      num = num + 31 + 28
    End If
  End If
  If dmonth = "4" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31
    Else
      num = num + 31 + 28 + 31
    End If
  End If
  If dmonth = "5" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31 + 30
    Else
      num = num + 31 + 28 + 31 + 30
    End If
  End If
  If dmonth = "6" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31 + 30 + 31
    Else
      num = num + 31 + 28 + 31 + 30 + 31
    End If
  End If
  If dmonth = "7" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31 + 30 + 31 + 30
    Else
      num = num + 31 + 28 + 31 + 30 + 31 + 30
    End If
  End If
  If dmonth = "8" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31 + 30 + 31 + 30 + 31
    Else
      num = num + 31 + 28 + 31 + 30 + 31 + 30 + 31
    End If
  End If
  If dmonth = "9" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31
    Else
      num = num + 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31
    End If
  End If
  If dmonth = "10" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30
    Else
      num = num + 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30
    End If
  End If
  If dmonth = "11" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31
    Else
      num = num + 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31
    End If
  End If
  If dmonth = "12" Then
    If (Val(dyear) - 2000) Mod 4 = 0 Then
      num = num + 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30