frmsearchclient.frm

需要控件：Active Report 2.0(专业报表控件破解版)2.0下的ardespro2.dll和arpro2.dll ARVIEW2.OCX等文件。即可打开源代码。

Private Sub Combo1_Change()
   If Len(Combo1.Text) > 0 Then
      CmdPrintPercentage.Enabled = True
      CmdPrintList.Enabled = True
   Else
      CmdPrintPercentage.Enabled = False
      CmdPrintList.Enabled = False
   End If
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      If Len(Combo1.Text) = 0 Then
        MsgBox "请输入要查询的客户名称!", vbCritical, "提示"
        Exit Sub
      Else
        Call CmdSearch_Click
      End If
   End If
End Sub

Private Sub Form_Load()
   '初始化列表
   Call LoadComBox("Client", Combo1)
   '初始化网格
   Call iListv
   
   List1.AddHeader 120, LeftJustify, "维修零件名称"
   List1.AddHeader 50, RightJustify, "数量"
   
   List2.AddHeader 120, LeftJustify, "维修零件名称"
   List2.AddHeader 50, RightJustify, "数量"
   List2.AddHeader 55, RightJustify, "所占比率"
   
   Dim i As Integer
   
   For i = 1 To 12
       Combo2.AddItem Format(Date, "yyyy") & Format(Str(i), "00")
   Next
   
   Combo2.ListIndex = Val(Month(Date)) - 1
End Sub

'开始搜索
Private Sub CmdSearch_Click()
  '先清空
  Call ClearData
  '载入数据
  Call LoadData
End Sub

'加载查询数据
Sub LoadData()
    '查询总数，计算损坏率用
    Dim p_Baifenbi As Long
    If Len(Combo2.Text) = 0 Then
       MsgBox "请选择要查询的日期.", vbInformation, "提示"
       Exit Sub
    End If
    
    
    If Len(Combo1.Text) = 0 Then
       MsgBox "请输入要查询的客户名称.", vbInformation, "提示"
       Exit Sub
    End If
    
    With rs
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = "select * from Product where ClientName='" & Combo1.Text & "' and Adddate='" & Combo2.Text & "'"
        .ActiveConnection = Cn
        .Open
    End With
    
    If rs.RecordCount = 0 Then
       rs.Close
       MsgBox "没有检索到记录.", vbInformation, "提示"
       Exit Sub
    End If
    Me.Caption = "按客户查询维修记录 ---->当前查询记录数:" & rs.RecordCount
    p_Baifenbi = rs.RecordCount
    
    Dim nIdx As Integer
    Dim nCol As Integer
      
    With ListView1
         .Visible = False
         For nCol = 0 To 2
             m_ColumnSortOrder(nCol) = [soDefault] '~None
             .ColumnIcon(nCol) = -1                '~None
         Next nCol
         m_CurrentColumn = -1
         For nIdx = .Count To .Count + rs.RecordCount - 1
             Call .ItemAdd(nIdx, rs.Fields(0), 0, 0)
             Call .SubItemSet(nIdx, 1, rs.Fields(5), 0)
             Call .SubItemSet(nIdx, 2, rs.Fields(6), 0)
             Call .SubItemSet(nIdx, 3, rs.Fields(7), 0)
             Call .SubItemSet(nIdx, 4, rs.Fields(2), 0)
             Call .SubItemSet(nIdx, 5, rs.Fields(3), 0)
             Call .SubItemSet(nIdx, 6, rs.Fields(10) & "", 0)
             Call .SubItemSet(nIdx, 7, rs.Fields(8), 0)
             Call .SubItemSet(nIdx, 8, rs.Fields(9), 0)
             rs.MoveNext
         Next nIdx
         .Visible = True
    End With

    rs.Close

    With rs
         .CursorType = adOpenKeyset
         .LockType = adLockOptimistic
         .Source = "SELECT PartsName,PartsSum FROM (SELECT PartsName, SUM(quantity) AS PartsSum" & _
                   " FROM [SELECT Product.ProductID, Product.ProductModel, Product.ProductSpec, Product.ClientName, Product.MakeDate, Product.ServiceDate, Product.OkDate, Product.ServiceResult, Product.DisposeMode, Product.Cause, PartsList.PartsName, PartsList.quantity" & _
                   " FROM Product INNER JOIN PartsList ON Product.ProductID = PartsList.ProductID" & _
                   " WHERE Product.ClientName='" & Combo1 & "']. AS [HHH]" & _
                   " GROUP BY PARTSNAME) ORDER BY PartsSum DESC"
         .ActiveConnection = Cn
         .Open
    End With
  
   '加载维修部件及损坏率
   
   Dim i As Integer
   
   List2.ClearList
   
   For i = 0 To rs.RecordCount - 1
       List2.AddItem rs.Fields(0) & vbTab & rs.Fields(1) & vbTab & Format((rs.Fields(1) / p_Baifenbi) * 100, "0.00") & "%"
       rs.MoveNext
   Next
   
   rs.Close
   CmdPrintPercentage.Enabled = True
   CmdPrintList.Enabled = True
End Sub

'加载客户名单
Sub LoadComBox(DbName As String, ComboxObj As Object)
    Dim i As Integer
    Cn.Open "dsn=SerManage"
    Set rs = New ADODB.Recordset

    With rs
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = "select * from " & DbName
        .ActiveConnection = Cn
        .Open
    End With
    ComboxObj.Clear
    
    For i = 0 To rs.RecordCount - 1
        ComboxObj.AddItem rs.Fields(1)
        rs.MoveNext
    Next
    rs.Close
End Sub

Sub iListv()
    With ListView1
        Call .Initialize
        Call .InitializeImageListSmall
        'Call .InitializeImageListLarge
        Call .InitializeImageListHeader
        'Call .ImageListSmall_AddIcon(ilsIcons)
        Call .ImageListSmall_AddBitmap(LoadResPicture(102, vbResBitmap), vbMagenta)
        'Call .ImageListLarge_AddBitmap(LoadResPicture("IL32x32", vbResBitmap), vbMagenta)
        Call .ImageListHeader_AddBitmap(LoadResPicture("ILHEADER", vbResBitmap), vbMagenta)
        
        Call .ColumnAdd(0, "产品编号", 90, [caleft])
        Call .ColumnAdd(1, "生产日期", 80, [caCenter])
        Call .ColumnAdd(2, "维修日期", 80, [caCenter])
        Call .ColumnAdd(3, "修好日期", 80, [caCenter])
        Call .ColumnAdd(4, "型号", 120, [caleft])
        Call .ColumnAdd(5, "规格", 40, [caleft])
        
        Call .ColumnAdd(6, "损坏原因", 300, [caleft])
        
        Call .ColumnAdd(7, "维修结果", 60, [caleft])
        Call .ColumnAdd(8, "处理方式", 100, [caleft])
        'Call .ColumnAdd(8, "备注", 100, [caCenter])
        .RaiseSubItemPrePaint = True
    End With
    
    ListView1.BorderStyle = bsThick
    ListView1.ViewMode = vmDetails
    ListView1.GridLines = True
    ListView1.FullRowSelect = True
    Call Randomize(Timer)
End Sub


Private Sub Form_Unload(Cancel As Integer)
   On Error Resume Next
   rs.Close
   Cn.Close
End Sub

''设置隔行颜色
Private Sub ListView1_OnSubItemPrePaint(ByVal Item As Integer, ByVal SubItem As Integer, TextBackColor As Long, TextForeColor As Long, Process As Boolean)
    If (Item Mod 2) Then
        TextBackColor = RGB(250, 242, 190)  'RGB(150, 200, 250)
        TextForeColor = RGB(0, 0, 250)
        Process = True
    End If
End Sub

'清除listview
Private Sub ClearData()
    Dim nCol As Integer
  
    For nCol = 0 To 2
        m_ColumnSortOrder(nCol) = [soDefault]
        ListView1.ColumnIcon(nCol) = -1
    Next nCol
    m_CurrentColumn = -1
    
    Call ListView1.Clear
End Sub

Private Sub ListView1_ItemClick(Item As Integer)
   'On Error Resume Next
   Dim textobj As String
   textobj = ListView1.SubItemText(Item, 0)
   If Len(convert_string(textobj)) > 0 Then
      textobj = Left$(textobj, (InStr(textobj, Chr(0))) - 1)
   End If
   
   With rs
       .CursorType = adOpenKeyset
       .LockType = adLockOptimistic
       .Source = "select * from PartsList where ProductID='" & textobj & "'"
       .ActiveConnection = Cn
       .Open
   End With
   
   Dim i As Integer
   
   List1.ClearList
   
   For i = 0 To rs.RecordCount - 1
       List1.AddItem PadSpaces(rs.Fields(1), 12, 1) & vbTab & PadSpaces(rs.Fields(2), 2, 2)
       rs.MoveNext
   Next
   
   rs.Close
End Sub

Private Sub CmdPrintList_Click()
   PrintSearchClient.Show vbModal
End Sub

Private Sub CmdPrintPercentage_Click()
   ProductPercentage.Show vbModal
End Sub