Option Explicit

'动态控件
'Dim WebBrowser As Object
'Dim ctl As Object

Private Declare Function GetClientRect Lib "user32 " (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowRect Lib "user32 " (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function InvalidateRect Lib "user32 " (ByVal hWnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function SendMessage Lib "user32 " Alias "SendMessageA " (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageLong Lib "user32 " Alias "SendMessageA " (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMem Lib "kernel32 " Alias "RtlMoveMemory " (Destination As Any, Source As Any, ByVal Length As Long)

Private Type POINT
      X   As Long
      Y   As Long
End Type

Private Type RECT
      Left   As Long
      Top   As Long
      Right   As Long
      Bottom   As Long
End Type

Private Const LVM_FIRST       As Long = &H1000
Private Const LVM_GETITEM       As Long = LVM_FIRST + 5
Private Const LVM_FINDITEM       As Long = LVM_FIRST + 13
Private Const LVM_ENSUREVISIBLE = LVM_FIRST + 19
Private Const LVM_SETCOLUMNWIDTH       As Long = LVM_FIRST + 30
Private Const LVM_GETTOPINDEX = LVM_FIRST + 39
Private Const LVM_SETITEMSTATE       As Long = LVM_FIRST + 43
Private Const LVM_GETITEMSTATE       As Long = LVM_FIRST + 44
Private Const LVM_GETITEMTEXT       As Long = LVM_FIRST + 45
Private Const LVM_SORTITEMS       As Long = LVM_FIRST + 48
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE       As Long = LVM_FIRST + 54
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE       As Long = LVM_FIRST + 55
Private Const LVM_SETCOLUMNORDERARRAY = LVM_FIRST + 58
Private Const LVM_GETCOLUMNORDERARRAY = LVM_FIRST + 59

Private Const LVS_EX_GRIDLINES       As Long = &H1
Private Const LVS_EX_SUBITEMIMAGES       As Long = &H2
Private Const LVS_EX_CHECKBOXES       As Long = &H4
Private Const LVS_EX_TRACKSELECT       As Long = &H8
Private Const LVS_EX_HEADERDRAGDROP       As Long = &H10
Private Const LVS_EX_FULLROWSELECT       As Long = &H20

Private Const LVFI_PARAM       As Long = 1

Private Const LVIF_TEXT       As Long = 1
Private Const LVIF_IMAGE       As Long = 2
Private Const LVIF_PARAM       As Long = 4
Private Const LVIF_STATE       As Long = 8
Private Const LVIF_INDENT       As Long = &H10
Private Const LVIF_NORECOMPUTE       As Long = &H800
Private Const LVIS_STATEIMAGEMASK       As Long = &HF000&

Private Type LV_ITEM
      Mask   As Long
      Index   As Long
      SubItem   As Long
      State   As Long
      StateMask   As Long
      Text   As String
      TextMax   As Long
      Icon   As Long
      Param   As Long
      Indent   As Long
End Type

Private Type LV_FINDINFO
      Flags   As Long
      pSz   As String
      lParam   As Long
      pt   As POINT
      vkDirection   As Long
End Type

'---   Array   used   to   speed   custom   sorts   --- '
Private m_lvSortData()     As LV_ITEM
Private m_lvSortColl     As Collection
Private m_lvSortColumn     As Long
Private m_lvHWnd     As Long
Private m_lvSortType     As LVItemTypes

'---   ListView   Set   Column   Width   Messages   --- '
Public Enum LVSCW_Styles
      LVSCW_AUTOSIZE = -1
      LVSCW_AUTOSIZE_USEHEADER = -2
End Enum

Public Enum LVItemTypes
      lvDate = 0
      lvNumber = 1
      lvBinary = 2
      lvAlphabetic = 3
End Enum
Public Enum LVSortTypes
      lvAscending = 0
      lvDescending = 1
End Enum

Public BuildLookup     As Long
Public PerformSort     As Long

Public Function LVSortK(lv As ListView, ByVal Index As Long, ByVal ItemType As LVItemTypes, ByVal SortOrder As LVSortTypes) As Boolean
      Dim tmr     As New CStopWatch
    
      '   turn   off   the   default   sorting   of   the   control
      With lv
            .Sorted = False
            .SortKey = Index
            .SortOrder = SortOrder
      End With

      '   store   some   values   used   during   the   sort
      m_lvSortColumn = Index
      m_lvSortType = ItemType
      m_lvHWnd = lv.hWnd
      BuildLookup = 0
    
      '   start   sorting   to   type-specific   callback   routines
      tmr.Reset
      Select Case ItemType
            Case lvDate
                  Call SendMessageLong(lv.hWnd, LVM_SORTITEMS, SortOrder, AddressOf LVCompareDates)
            Case lvNumber
                  Call SendMessageLong(lv.hWnd, LVM_SORTITEMS, SortOrder, AddressOf LVCompareNumbers)
      End Select
      PerformSort = tmr.Elapsed
End Function

Private Sub RemveCtrl()
    '删除动态控件
    For Each ctl In Me.Controls
        If ctl.Name = "Web1" Then
            Controls.Remove "Web1"
        End If
    Next
    'Controls.Remove "Web1"
End Sub

Private Sub UrlBrowser()
    WebBrowser.Navigate "www.163.com"
End Sub

Private Sub command1_click()
    Call UrlBrowser
End Sub

Private Sub Command2_Click()

    ListView1.ListItems.Clear               '清空列表
    ListView1.ColumnHeaders.Clear           '清空列表头
    ListView1.View = lvwReport              '设置列表显示方式
    ListView1.GridLines = True              '显示网络线
    ListView1.LabelEdit = lvwManual         '禁止标签编辑
    ListView1.FullRowSelect = True          '选择整行
   
    'ListView1.View = lvwReport              '设置显示方式为列表
    'ListView1.AllowColumnReorder = True     '对行进行程序排列，用鼠标进行排列
    'ListView1.Arrange = lvwAutoLeft         '图标横排列
    'ListView1.Arrange = lvwAutoTop          '图标竖排列
    'ListView1.FlatScrollBar = False         '显示滚动条
    'ListView1.FlatScrollBar = True          '隐藏滚动条
    'ListView1.FullRowSelect = True          '选择整行
    'ListView1.LabelEdit = lvwManual         '禁止标签编辑
    'ListView1.GridLines = True              '显示网络线
    'ListView1.LabelWrap = True              '图标可以换行
    'ListView1.MultiSelect = True            '可以选择多个项目
    'ListView1.PictureAlignment = lvwTopLeft '图片对齐方式是左顶部，其他有右顶部(1)、左底部(2)、右底部(3)、居中(4)、平铺(5)
    'ListView1.Checkboxes = True             '显示复选框
    'ListView1.DropHighlight = ListView1.ListItems.Item(2)   '显示系统颜色
   
       
    ListView1.ColumnHeaders.Add , , "", 350 '给列表中添加列名
    ListView1.ColumnHeaders.Add , , "代码", 1500
    ListView1.ColumnHeaders.Add , , "URL", 1200
   

    'ListView1.View = lvwReport          '设置ListView控件中ListItem对象的外观形式为报表，其值为3
    'ListView1.ColumnHeaders.Clear       '清除原有的列标题
    'With ListView1.ColumnHeaders        '添加新的列标题
    '    .Add , , "", 10
    '    .Add , , "第一列", 1000         '第一列标题，标题内容为“第一列”，列宽为1000
    '    .Add , , "第二列", 1000         '第二列标题，标题内容为“第二列”，列宽为1000
    'End With
   
    'ListView1.ListItems.Clear           '清除原有的记录内容
    'With ListView1.ListItems.Add        '添加新记录
    '    .SubItems(1) = 1                '第一列内容
    '    .SubItems(2) = 2                '第二列内容
    'End With
ReadURLFile

End Sub

Private Sub Command3_Click()
    Dim s As String, i, j As Integer
    Dim TestArray() As String
   
    Open App.Path & "\url.txt" For Output As #1
    For i = 1 To ListView1.ListItems.Count
        s = ListView1.ListItems(i).Text
        s = s & "--" & ListView1.ListItems(i).SubItems(1)
        s = s & "--" & ListView1.ListItems(i).SubItems(2)
        Print #1, s
    Next
    Close #1
   
End Sub

Private Sub Command4_Click()
ListviewSort
End Sub

Private Sub Form_Load()
    'Timer1.Interval = 3000
    '动态添加控件
    'Set WebBrowser = Me.Controls.Add("SHELL.EXPLORER.2", "Web1", Me)
    'WebBrowser.Visible = True
    'WebBrowser.Move 200, 200, 5000, 5000
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    Call RemveCtrl
End Sub

Private Sub ListView1_DblClick()
   
    If ListView1.SelectedItem.Text = "√" Then
    ListView1.SelectedItem.Text = " "
    Else
    ListView1.SelectedItem.Text = "√"
    End If
   
End Sub

Private Sub Timer1_Timer()
End Sub

Private Sub ReadURLFile()
  '  Dim X
  '  X = ListView1.ListItems.Count + 1

    Dim s As String, i, j As Integer
    Dim TestArray() As String
   
    Open App.Path & "\url.txt" For Input As #1
    i = 1
    j = 1
    While Not EOF(1)
        Line Input #1, s
       
        TestArray = Split(s, "--")

        'If i <= ListView1.ListItems.Count Then
        ListView1.ListItems.Add , , TestArray(i - 1)
        ListView1.ListItems(j).SubItems(1) = TestArray(i)
        ListView1.ListItems(j).SubItems(2) = TestArray(i + 1)
        i = 1
        j = j + 1
        'End If
    Wend
    Close #1
End Sub

Sub ListviewSort()
    ListView1.SortKey = ListView1.ColumnHeaders.Item.Index - 1
   
    If ListView1.SortOrder = lvwAscending Then
    ListView1.SortOrder = lvwDescending
    Else
    ListView1.SortOrder = lvwAscending
    End If
   
    ListView1.Sorted = True
    '数值排序
    LVSortK ListView1, ListView1.SortKey, lvNumber, ListView1.SortOrder
   
    '日期排序：
    LVSortK ListView1, ListView1.SortKey, lvDate, ListView1.SortOrder
End Sub