frmchart.frm

本程序源码是由vb编写的

      Grid3.Col = 1
      Grid3.Visible = True
      Grid3.ColSel = 6 + CodeQua
      rRecord.Close
      Con.Close
      Set rRecord = Nothing
      Set Con = Nothing
   Else
      Dim GridNO As Long
      Dim qSum As Long, cSum As Currency
      Do While Not rRecord.EOF
         GridNO = GridNO + 1
         rRecord.MoveNext
      Loop
         Grid3.Rows = GridNO + 5
            Grid3.BackColorSel = SelectBackColor
         Grid3.ForeColorSel = SelectForeColor
         If Grid3.Rows < 29 Then  '缺省的30行
            Grid3.Rows = 29
         End If
        '定义三种颜色:    红、绿、黑
         Dim fColor As Long, lMax As Long, lMin As Long, lSum As Long
      If rRecord.BOF And rRecord.EOF Then
         Else
         rRecord.MoveFirst
             hh = 1: qSum = 0: cSum = 0
         Do While Not rRecord.EOF
            Grid3.Row = hh
            Grid3.Col = 5 + CodeQua
            Grid3.CellAlignment = 1
            If Not IsNull(rRecord.Fields("SumQua")) Then
                   qSum = qSum + rRecord.Fields("SumQua") '数量小计
                   lSum = rRecord.Fields("SumQua"): lMin = rRecord.Fields("MinRec"): lMax = rRecord.Fields("MaxRec")
               If (lSum >= lMin) And (lSum <= lMax) Then
                  '黑色
                  bColor = &H0&
                 Else
                  If lSum > lMax Then bColor = &HFF&     '红色
                  If lSum < lMin Then bColor = &HC000& '绿色
               End If
              Grid3.CellForeColor = bColor
              Grid3.Text = lSum
            End If
            Grid3.Col = 1
            Grid3.CellAlignment = 1
            Grid3.CellForeColor = bColor
            If Not IsNull(rRecord.Fields("GoodsID")) Then
               Grid3.Text = rRecord.Fields("GoodsID")
            End If
            Grid3.Col = 2
            Grid3.CellForeColor = bColor
            Grid3.CellAlignment = 1
            If Not IsNull(rRecord.Fields("GoodsName")) Then
               Grid3.Text = rRecord.Fields("GoodsName")
            End If
            Grid3.Col = 3
            Grid3.CellAlignment = 1
            Grid3.CellForeColor = bColor
            If Not IsNull(rRecord.Fields("Unit")) Then
               Grid3.Text = rRecord.Fields("Unit")
            End If
            Grid3.Col = 4
            Grid3.CellAlignment = 1
            Grid3.CellForeColor = bColor
            If Not IsNull(rRecord.Fields("Price")) Then
               Grid3.Text = rRecord.Fields("Price")
            End If
            For X = 1 To CodeQua
                Grid3.Col = X + 4
                Grid3.CellAlignment = 1
                Grid3.CellForeColor = bColor
                If Not IsNull(rRecord.Fields(X + 12)) Then
                   Grid3.Text = rRecord.Fields(X + 12)
                End If
            Next
            Grid3.Col = 6 + CodeQua
            Grid3.CellForeColor = bColor
            Grid3.CellAlignment = 1
            If Not IsNull(rRecord.Fields("Amo")) Then
               Grid3.Text = rRecord.Fields("Amo")
               cSum = cSum + rRecord.Fields("Amo")
            End If
            rRecord.MoveNext
            hh = hh + 1
         Loop
      End If
    rRecord.Close
    Con.Close
    Set rRecord = Nothing
    Set Con = Nothing
    Grid3.Row = hh + 1
    Grid3.Col = 1
    Grid3.Text = "合计"
    Grid3.CellForeColor = &HFF&
    Grid3.CellBackColor = &HFFFF&
    Grid3.Col = 5 + CodeQua
    Grid3.CellForeColor = &HFF&
    Grid3.CellBackColor = &HFFFF&
    Grid3.Text = qSum  '数量合
    Grid3.Col = 6 + CodeQua
    Grid3.CellForeColor = &HFF&
    Grid3.CellBackColor = &HFFFF&
    Grid3.Text = cSum  '金额合计
    Grid3.Row = 1
    Grid3.Col = 1
    Grid3.ColSel = 6 + CodeQua
    Grid3.Visible = True
  End If
 Else '配置Content网格
   ProductLay = 1
   Grid3.Visible = False
   Grid3.Clear
   Grid3.Cols = 2
   Grid3.FormatString = "..|^* * * * * * * * * *   产 品 分 类  * * * * * * * * * *"
   Grid3.ColWidth(0) = 200
   Grid3.ColWidth(1) = 11800

   If rRecord.BOF Or rRecord.EOF Then
      rRecord.Close
      Con.Close
      Set rRecord = Nothing
      Set Con = Nothing
   Else
      Do While Not rRecord.EOF
         GridNO = GridNO + 1
         rRecord.MoveNext
      Loop
         Grid3.BackColorSel = SelectBackColor
         Grid3.ForeColorSel = SelectForeColor
         Grid3.Rows = GridNO + 5
         If Grid3.Rows < 30 Then  '缺省的30行
            Grid3.Rows = 30
         End If
      If rRecord.BOF And rRecord.EOF Then
         Else
         rRecord.MoveFirst
             hh = 1
         Do While Not rRecord.EOF
            Grid3.Row = hh
            Grid3.Col = 1
            Grid3.CellAlignment = 4
            If Not IsNull(rRecord.Fields("Class")) Then
               Grid3.Text = rRecord.Fields("Class")
            End If
            rRecord.MoveNext
            hh = hh + 1
         Loop
      End If
    rRecord.Close
    Con.Close
    Set rRecord = Nothing
    Set Con = Nothing
    Grid3.Row = 1
    Grid3.Col = 1
  End If
    Grid3.ColSel = 1
    Grid3.Visible = True
 End If
    
   Exit Sub
Err_S:
  MsgBox "很抱歉，不能正常配置网格（或查询供应商） " & vbCrLf & vbCrLf & "：请 WWW.VB-CODE.NET,网咨询   " & vbCrLf & vbCrLf & Err.Description, vbInformation, "Error for form load."
  Exit Sub

End Sub

Private Sub Command3_Click()

  Unload Me

End Sub

Private Sub Command4_Click()

  Me.MousePointer = 11
  FormID = "KC200"
  Dim sSQL As String
  If optType(0).Value = True Then
     sSQL = ""
  End If
  '库存不足
  If optType(1).Value = True Then
     sSQL = " SumQua<MinRec "
  End If
  '库存过剩
  If optType(2).Value = True Then
     sSQL = " SumQua>MaxRec "
  End If
  '库存正常产品
  If optType(3).Value = True Then
     sSQL = " SumQua>MinRec And SumQua<MaxRec "
  End If
  If Trim(FocusText1.Text) <> "" Then
     If InStr(1, FocusText1.Text, "'", vbTextCompare) Then
        MsgBox "对不起，查询的产品名称或编号不能有《'》号？    ", vbInformation
        Exit Sub
      ElseIf sSQL <> "" Then
        ConfigProduct "Select  * From Goods Where (GoodsID Like '*" & Trim(FocusText1.Text) & "*' Or GoodsName Like '*" & Trim(FocusText1.Text) & "*') And " & sSQL, False
        Else
        ConfigProduct "Select  * From Goods Where GoodsID Like '*" & Trim(FocusText1.Text) & "*' Or GoodsName Like '*" & Trim(FocusText1.Text) & "*'", False
     End If
  End If
  Me.MousePointer = 0

End Sub

Private Sub Command5_Click()

  If ProductLay = 2 Then
     FormID = "KC100"
     ConfigProduct "Select  * From ProductType", True
  End If

End Sub

Private Sub FocusText1_Change()

    If Trim(FocusText1.Text) <> "" Then
       Command4.Enabled = True
     Else
       Command4.Enabled = False
    End If

End Sub

Private Sub FocusText1_KeyPress(KeyAscii As Integer)

   If FocusText1.Text <> "" And KeyAscii = 13 Then
      Call Command4_Click
   End If
End Sub

Private Sub Form_Load()

  ProductLay = 1
  FormID = "KC100"
  '显示产品目录
  ConfigProduct "Select * From ProductType", True
  
End Sub

Private Sub Form_Resize()

 If frmChart.WindowState = 1 Then Exit Sub
 On Error Resume Next
 lbStatus.Left = Me.Width - lbStatus.Width - 300
 lbStatus.Top = 150
 With picSelectP
      .Width = Me.ScaleWidth
      .Left = 0
      .Top = tbOrder.Height + 40
      .Height = Me.ScaleHeight - tbOrder.Height - 40
 End With
 
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Set Start_print = Nothing

End Sub

Private Sub Grid3_DblClick()
   
   If Grid3.Text = "" Then
      Exit Sub
   End If
   If ProductLay = 1 Then
        FormID = "KC200"
        ProductType = Grid3.Text
        Me.MousePointer = 11
        Dim sSQL As String
        If optType(0).Value = True Then
           sSQL = ""
        End If
        '库存不足
        If optType(1).Value = True Then
           sSQL = " SumQua<MinRec "
        End If
        '库存过剩
        If optType(2).Value = True Then
           sSQL = " SumQua>MaxRec "
        End If
        '库存正常产品
        If optType(3).Value = True Then
           sSQL = " SumQua>MinRec And SumQua<MaxRec "
        End If
        Me.MousePointer = 0
     If sSQL <> "" Then
        ConfigProduct "Select * From Goods Where Class='" & Grid3.Text & "' And " & sSQL, False
       Else
        ConfigProduct "Select * From Goods Where Class='" & Grid3.Text & "'", False
     End If
   End If
   
End Sub

Private Sub optType_Click(Index As Integer)

  '目录时退出
  If ProductLay = 1 Then Exit Sub
  Me.MousePointer = 11
  Dim sSQL As String
  If optType(0).Value = True Then
     sSQL = ""
  End If
  '库存不足
  If optType(1).Value = True Then
     sSQL = " SumQua<MinRec "
  End If
  '库存过剩
  If optType(2).Value = True Then
     sSQL = " SumQua>MaxRec "
  End If
  '库存正常产品
  If optType(3).Value = True Then
     sSQL = " SumQua>MinRec And SumQua<MaxRec "
  End If
  If sSQL <> "" Then
    ConfigProduct "Select  * From Goods Where Class='" & ProductType & "' And " & sSQL, False
    Else
    ConfigProduct "Select  * From Goods Where class='" & ProductType & "'", False
  End If
  Me.MousePointer = 0
  
End Sub

Private Sub picSelectP_Resize()

  On Error Resume Next
  Grid3.Left = 0
  Grid3.Top = 0
  Grid3.Width = picSelectP.ScaleWidth
  Grid3.Height = picSelectP.ScaleHeight - Picture1.Height - 100
  Picture1.Left = 0
  Picture1.Top = Grid3.Height + 50
  Picture1.Width = Grid3.Width

End Sub

Private Sub Picture1_Resize()
   On Error Resume Next
   Command3.Left = Picture1.Width - Command3.Width - 200

End Sub

Private Sub tbOrder_ButtonClick(ByVal Button As MSComctlLib.Button)

   If Button.Key = "return" Then
      Unload Me
      Exit Sub
   End If
   
End Sub

Private Sub tbOrder_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)

          '打印时给表头三部分+表名+行高++++++++++++++++++++++++++++++++++++++++++++++++++
             'On Error GoTo Print_Err
        Select Case FormID
          Case "KC100"
                Start_print.N_TiTle = "库存产品目录"
                Start_print.N_Head10 = ""
                Start_print.N_Head11 = "制单人：" & sUserName
                Start_print.N_Head2 = "时间：" & Format(Now, "Long Date")
                Set Start_print.N_Grid = Grid3
          Case "KC200"
                Start_print.N_TiTle = "库存产品明细"
                Start_print.N_Head10 = "制单人：" & sUserName
                Start_print.N_Head11 = ""
                Start_print.N_Head2 = "制单时间：" & Format(Now, "Long Date")
                Set Start_print.N_Grid = Grid3
        End Select
         Select Case ButtonMenu.Key
           Case "set"
                  '如果值改变，将保存新的记录
                  SavePrintSet Start_print, "Get", FormID '给出该ID配置
                  frmPrintSet.Show 1
                   If PrintSetChange = True Then
                      SavePrintSet Start_print, "Save", FormID
                   End If
           Case "print"
                 Start_print.PrintPage
         End Select
         
           '释放内存
          '打印结束++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          Exit Sub
Print_Err:
          MsgBox "对不起，打印设置或打印错误，请与供应商联系！    " & vbCrLf & vbCrLf & " 电话：[phone] 8269007 [e-mail]   ", vbInformation
          Exit Sub
End Sub


Private Sub TimeDate_Timer()
   lbDate.Caption = Format(Time, "hh:mm:ss AM/PM")

End Sub