frmsearchdate.frm

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

      Left            =   45
      TabIndex        =   0
      Top             =   30
      Width           =   11775
      _ExtentX        =   20770
      _ExtentY        =   8969
   End
End
Attribute VB_Name = "FrmSearchDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_ColumnSortOrder(2) As eSortOrderConstants
Private m_CurrentColumn      As Integer

'执行查询
Private Sub CmdSearch_Click()
    If DTPicker2.Value < DTPicker1.Value Then
       MsgBox "终止日期小于起始日期，请重新选择!", vbCritical, "日期错误"
       CmdPrintPercentage.Enabled = False
       CmdPrintList.Enabled = False
       Exit Sub
    End If
    With rs
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = "SELECT * FROM Product where format(ServiceDate,'yyyy-mm-dd') between #" & Format(DTPicker1.Value, "yyyy-mm-dd") & "# and #" & Format(DTPicker2.Value, "yyyy-mm-dd") & "#"
        .ActiveConnection = Cn
        .Open
    End With
    
    'rs.Close
  '"SELECT * FROM Product where format(ServiceDate,'yyyy-mm-dd') between #" & Format(DTPicker1.Value, "yyyy-mm-dd") & "# and #" & Format(DTPicker2.Value, "yyyy-mm-dd") & "#"      ' and MobileNo='" & Left(Combo1.Text, 11) & "'"
  
  If rs.RecordCount = 0 Then
     MsgBox "无此段日期间的数据，请检查日期!", vbCritical, "提示"
     rs.Close
     CmdPrintPercentage.Enabled = False
     CmdPrintList.Enabled = False
     Exit Sub
  End If
  Dim nIdx As Integer
  Dim nCol As Integer
    
  Screen.MousePointer = 11
  '显示前景窗体
  FrmOnTopWindow.Caption = "正在搜索数据，请稍候..."
  FrmOnTopWindow.Show
  
  Me.Caption = "按时间段查询产品维修记录 ---->当前查询记录数:" & rs.RecordCount
  Call ClearData
  With ListView1
       .Visible = False
       For nCol = 0 To 2
           m_ColumnSortOrder(nCol) = [soDefault] '~None
           .ColumnIcon(nCol) = -1                '~None
       Next nCol
       m_CurrentColumn = -1
       FrmOnTopWindow.XP_PrBar.Max = rs.RecordCount - 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)
           Call .SubItemSet(nIdx, 9, rs.Fields(4), 0)
           FrmOnTopWindow.XP_PrBar.Value = nIdx
           rs.MoveNext
       Next nIdx
       .Visible = True
  End With
  Dim p_Baifenbi As Long
  p_Baifenbi = rs.RecordCount
  rs.Close
  
  With rs
       .CursorType = adOpenKeyset
       .LockType = adLockOptimistic
       .Source = "SELECT PartsName,PartsCount FROM (SELECT PartsName, SUM(quantity) AS PartsCount" & _
                 " 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 format(ServiceDate,'yyyy-mm-dd') between #" & Format(DTPicker1.Value, "yyyy-mm-dd") & "# and #" & Format(DTPicker2.Value, "yyyy-mm-dd") & "#]. AS [HHH]" & _
                 " GROUP BY PARTSNAME) ORDER BY PartsCount DESC"
       .ActiveConnection = Cn
       .Open
  End With
  
   Dim i As Integer
   List2.ClearList

   For i = 0 To rs.RecordCount - 1
       'List2.AddItem PadSpaces(rs.Fields(0), 12, 1) & vbTab & PadSpaces(rs.Fields(1), 2, 2) & vbTab & Format((rs.Fields(1) / p_Baifenbi) * 100, "0.00") & "%"
       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
   Unload FrmOnTopWindow
   Set FrmOnTopWindow = Nothing
   Screen.MousePointer = 0
End Sub

Private Sub Form_Load()
    Cn.Open "dsn=SerManage"
    Set rs = New ADODB.Recordset
    DTPicker1.Value = Date
    DTPicker2.Value = Date
    Call iListv
   
    List1.AddHeader 120, LeftJustify, "维修零件名称"
    List1.AddHeader 50, RightJustify, "数量"
   
    List2.AddHeader 120, LeftJustify, "维修零件名称"
    List2.AddHeader 50, RightJustify, "数量"
    List2.AddHeader 55, RightJustify, "所占比率"
    
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, "型号", 110, [caleft])
        Call .ColumnAdd(5, "规格", 40, [caRight])
        
        Call .ColumnAdd(6, "损坏原因", 300, [caleft])
        
        Call .ColumnAdd(7, "维修结果", 60, [caleft])
        Call .ColumnAdd(8, "处理方式", 100, [caleft])
        Call .ColumnAdd(9, "客户名称", 200, [caleft])
        Call .ColumnAdd(10, "备注", 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
   
   List1.ClearList
   Dim i As Integer
   
   For i = 0 To rs.RecordCount - 1
       'List1.AddItem PadSpaces(rs.Fields(1), 18, 1) & Space(2) & PadSpaces(rs.Fields(2), 2, 2)
       List1.AddItem rs.Fields(1) & vbTab & rs.Fields(2)
       rs.MoveNext
   Next
   
   rs.Close
End Sub

Private Sub CmdPrintPercentage_Click()
   ProductPercentage.Show vbModal
End Sub

Private Sub CmdExit_Click()
   Unload Me
End Sub

Private Sub CmdPrintList_Click()
   PrintSearchClient.Show vbModal
End Sub