frmqk.frm

本程序源码是由vb编写的

   End
End
Attribute VB_Name = "frmQK"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim GuestLay As Integer

Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub Command1_Click()
  
  FormID = "QK200"
  Me.MousePointer = 11
  Dim sSQL As String
  If optType(0).Value = True Then
     sSQL = ""
  End If
  If optType(1).Value = True Then
     sSQL = " And BalAmo>0"
  End If
  If optType(2).Value = True Then
     sSQL = " And BalAmo=0"
  End If
  If Trim(txtSearch.Text) <> "" Then
     If InStr(1, txtSearch.Text, "'", vbTextCompare) Then
        MsgBox "对不起，查询的供应商名称中不能有《'》号？    ", vbInformation
        Exit Sub
      Else
        ConfigSuppler "Select  * From Suppler Where (UnitID Like '*" & Trim(txtSearch.Text) & "*' Or UnitName Like '*" & Trim(txtSearch.Text) & "*')" & sSQL, False
     End If
  End If
  Me.MousePointer = 0

End Sub

Private Sub Command2_Click()
   
  If GuestLay = 2 Then
     FormID = "QK100"
     ConfigSuppler "Select  * From SupplerType", True
  End If
  
End Sub

Private Sub Form_Load()

   FormID = "QK100"
   ConfigSuppler "Select  * From SupplerType", True
   
End Sub

Private Sub Form_Resize()

 If Me.WindowState = 1 Then Exit Sub
 On Error Resume Next
 lbStatus.left = Me.Width - lbStatus.Width - 300
 lbStatus.tOp = 150
 With picSelectSuppler
      .Width = Me.ScaleWidth
      .left = 0
      .tOp = tbOrder.Height + 40
      .Height = Me.ScaleHeight - tbOrder.Height - 40
 End With
End Sub

Private Sub Grid2_DblClick()
   
   On Error Resume Next
   If Grid2.Text = "" Then
      Exit Sub
   End If
   If GuestLay = 2 Then
      Exit Sub
   End If
   If GuestLay = 1 Then
      FormID = "QK200"
      ConfigSuppler "Select * From Suppler Where Class='" & Grid2.Text & "'", False
   End If
   
End Sub

Private Sub optType_Click(Index As Integer)

  FormID = "QK200"
  Me.MousePointer = 11
  Dim sSQL As String
  If optType(0).Value = True Then
     sSQL = ""
  End If
  If optType(1).Value = True Then
     sSQL = " And BalAmo>0"
  End If
  If optType(2).Value = True Then
     sSQL = " And BalAmo=0"
  End If
  If Trim(txtSearch.Text) <> "" Then
     If InStr(1, txtSearch.Text, "'", vbTextCompare) Then
        MsgBox "对不起，查询的供应商名称中不能有《'》号？    ", vbInformation
        Exit Sub
      Else
        ConfigSuppler "Select  * From Suppler Where (UnitID Like '*" & Trim(txtSearch.Text) & "*' Or UnitName Like '*" & Trim(txtSearch.Text) & "*')" & sSQL, False
     End If
    Else
        ConfigSuppler "Select  * From Suppler Where UnitID<>''" & sSQL, False
  End If
  Me.MousePointer = 0

End Sub

Private Sub picSelectSuppler_Resize()

  On Error Resume Next
  Grid2.left = 0
  Grid2.tOp = 0
  Grid2.Width = picSelectSuppler.ScaleWidth
  Grid2.Height = picSelectSuppler.ScaleHeight - picTool.Height - 100
  picTool.left = 0
  picTool.tOp = Grid2.Height + 50
  picTool.Width = Grid2.Width

End Sub

Private Sub picTool_Resize()
   On Error Resume Next
   cmdExit.left = picTool.Width - cmdExit.Width - 200
End Sub

Private Sub tbOrder_ButtonClick(ByVal Button As MSComctlLib.Button)

 Select Case Button.Key
 
   Case "return"
     Unload Me
 End Select

End Sub
Private Sub tbOrder_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)

          '打印时给表头三部分+表名+行高++++++++++++++++++++++++++++++++++++++++++++++++++
             'On Error GoTo Print_Err
        Select Case FormID
          Case "QK100"
                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 = Grid2
          Case "QK200"
                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 = Grid2
        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
Private Sub ConfigSuppler(sSQL As String, bContent As Boolean)

  On Error GoTo Err_S
  
  'dim Con as Database
  'Dim rRecord As Recordset
  '
  '    set con=opendatabase(condata,0,0,constr)     '打开ODBC数据源
  'Set rRecord = New Recordset
  '    rRecord.Open sSql, Con, adOpenStatic, adLockPessimistic, adCmdText
  Dim Con As Database
  Dim rRecord As Recordset
  Set Con = OpenDatabase(ConData, 0, 0, ConStr)
  Set rRecord = Con.OpenRecordset(sSQL, dbOpenDynaset)
  If bContent = False Then
     GuestLay = 2
  '配置网格
   Grid2.Visible = False
   Grid2.Clear
   Grid2.Cols = 6
   Grid2.FormatString = "..|^ 编号 |^ 供应商名称 |^ 联系人 |^ 电话 |^ 欠款金额"
   Grid2.ColWidth(0) = 200
   Grid2.ColWidth(1) = 1000
   Grid2.ColWidth(2) = 4500
   Grid2.ColWidth(3) = 1200
   Grid2.ColWidth(4) = 2660
   Grid2.ColWidth(5) = 2000
   If rRecord.BOF Or rRecord.EOF Then
      rRecord.Close
      Con.Close
      Set rRecord = Nothing
      Set Con = Nothing
   Else
      Dim GridNO As Long
      Do While Not rRecord.EOF
         GridNO = GridNO + 1
         rRecord.MoveNext
      Loop
         Grid2.BackColorSel = SelectBackColor
         Grid2.ForeColorSel = SelectForeColor
         Grid2.Rows = GridNO + 5
         If Grid2.Rows < 32 Then  '缺省的30行
            Grid2.Rows = 32
         End If
      If rRecord.BOF And rRecord.EOF Then
         Else
         rRecord.MoveFirst
             HH = 1
         Do While Not rRecord.EOF
            Grid2.Row = HH
            Grid2.Col = 1
            Grid2.CellAlignment = 1
            If Not IsNull(rRecord.Fields("UnitID")) Then
               Grid2.Text = rRecord.Fields("UnitID")
            End If
            Grid2.Col = 2
            Grid2.CellAlignment = 1
            If Not IsNull(rRecord.Fields("UnitName")) Then
               Grid2.Text = rRecord.Fields("UnitName")
            End If
            Grid2.Col = 3
            Grid2.CellAlignment = 1
            If Not IsNull(rRecord.Fields("UnitContact")) Then
               Grid2.Text = rRecord.Fields("UnitContact")
            End If
            Grid2.Col = 4
            Grid2.CellAlignment = 1
            If Not IsNull(rRecord.Fields("UnitTel")) Then
               Grid2.Text = rRecord.Fields("UnitTel")
            End If
            Grid2.Col = 5
            Grid2.CellAlignment = 1
            If Not IsNull(rRecord.Fields("BalAmo")) Then
               Grid2.Text = rRecord.Fields("BalAmo")
            End If
            rRecord.MoveNext
            HH = HH + 1
         Loop
      End If
       
    rRecord.Close
    Con.Close
    Set rRecord = Nothing
    Set Con = Nothing
    Grid2.Row = 1
    Grid2.Col = 1
  End If
    Grid2.ColSel = 5
    Grid2.Visible = True
 Else '配置Content网格
   GuestLay = 1
   Grid2.Visible = False
   Grid2.Clear
   Grid2.Cols = 2
   Grid2.FormatString = "..|^* * * * * * * * * *  供 应 商 分 类  * * * * * * * * * *"
   Grid2.ColWidth(0) = 200
   Grid2.ColWidth(1) = 11560

   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
         Grid2.BackColorSel = SelectBackColor
         Grid2.ForeColorSel = SelectForeColor
         Grid2.Rows = GridNO + 5
         If Grid2.Rows < 32 Then  '缺省的30行
            Grid2.Rows = 32
         End If
      If rRecord.BOF And rRecord.EOF Then
         Else
         rRecord.MoveFirst
             HH = 1
         Do While Not rRecord.EOF
            Grid2.Row = HH
            Grid2.Col = 1
            Grid2.CellAlignment = 4
            If Not IsNull(rRecord.Fields("Class")) Then
               Grid2.Text = rRecord.Fields("Class")
            End If
            rRecord.MoveNext
            HH = HH + 1
         Loop
      End If
    rRecord.Close
    Con.Close
    Set rRecord = Nothing
    Set Con = Nothing
    Grid2.Row = 1
    Grid2.Col = 1
  End If
    Grid2.ColSel = 1
    Grid2.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 txtSearch_Change()
    If Trim(txtSearch.Text) <> "" Then
       Command1.Enabled = True
     Else
       Command1.Enabled = False
    End If
End Sub

Private Sub txtSearch_KeyPress(KeyAscii As Integer)

  If txtSearch.Text <> "" And KeyAscii = 13 Then
     Call Command1_Click
  End If
  
End Sub