浏览器

开发平台：
Visual Basic

frmFloatSubFav.frm：源码内容
							VERSION 5.00
Begin VB.Form frmFloatSubFav 
   BorderStyle     =   5  'Sizable ToolWindow
   Caption         =   "Form1"
   ClientHeight    =   4275
   ClientLeft      =   60
   ClientTop       =   300
   ClientWidth     =   2400
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4275
   ScaleWidth      =   2400
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "frmFloatSubFav"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module    : frmFloatSubFav
' DateTime  : 2005-3-28 15:30
' Author    : Lingll
' Purpose   : 收藏夹浮动菜单
'---------------------------------------------------------------------------------------
Option Explicit
'Private WithEvents m_cLvw As cSysListView32
Private WithEvents m_cTvw As cTreeView32
Attribute m_cTvw.VB_VarHelpID = -1
'Private Type FavInfo
'    Title As String
'    Url As String
'End Type
Private m_ifo() As UrlSimpleInfo  ' FavInfo
Public Sub AddButton(nTitle As String, nUrl As String)
'Dim tItem As MSComctlLib.ListItem
'Set tItem = ListView1.ListItems.Add(, , nTitle, , 1)
'tItem.Tag = nUrl
ReDim Preserve m_ifo(0 To UBound(m_ifo) + 1)
With m_ifo(UBound(m_ifo))
    .Title = nTitle
    .Url = nUrl
End With
If Not m_cTvw Is Nothing Then
    m_cTvw.AddItem nTitle, , , 0, 0, 0, UBound(m_ifo)
End If
End Sub
Public Sub Resize()
'Dim tTop&, tBottom&, tLeft&, tRight&
Dim tHeight&, tWidth&
'Dim tHItem&
'Dim tCount&
'tHeight = 0: tWidth = 0
'tHItem = m_cTvw.GetNextNode(TVGN_ROOT, 0)
'While tHItem <> 0
'    tCount = tCount + 1
'    m_cTvw.GetItemRect tHItem, tLeft, tTop, tRight, tBottom
'    tHeight = tHeight + tBottom - tTop
''    Debug.Print tRight, tLeft, tHItem
''    If tWidth < tRight - tLeft Then
''        tWidth = tRight - tLeft
''    End If
'    tHItem = m_cTvw.GetNextNode(TVGN_NEXT, tHItem)
'Wend
tHeight = m_cTvw.itemHeight * m_cTvw.Count
If tHeight > (GetSystemMetrics(SM_CYSCREEN) * 15 - 1500) / Screen.TwipsPerPixelY Then
    tHeight = (GetSystemMetrics(SM_CYSCREEN) * 15 - 1500) / Screen.TwipsPerPixelY
End If
Me.height = tHeight * Screen.TwipsPerPixelY + Me.height - Me.ScaleHeight
'Me.Width = tWidth * Screen.TwipsPerPixelX + Me.Width - Me.ScaleWidth
'Debug.Print "width", tWidth, Me.ScaleWidth / 15, tCount
'Dim tItem As MSComctlLib.ListItem
'Dim tHeight
'For Each tItem In ListView1.ListItems
'    tHeight = tHeight + tItem.Height
'Next tItem
'If tHeight > Screen.Height - 1500 Then
'    tHeight = Screen.Height - 1500
'End If
'
'Me.Height = tHeight + Me.Height - Me.ScaleHeight
End Sub
Private Sub Form_Load()
Dim tIlst As cImageList
Set m_cTvw = CreateCmmCtrl(strCLSID_cTreeView32)   ' New cTreeView32
With m_cTvw
    .Create Me.hWnd, TVS_TRACKSELECT Or TVS_INFOTIP Or TVS_NOHSCROLL Or TVS_FULLROWSELECT, _
    0, 0, Me.ScaleWidth / 15, Me.ScaleHeight / 15, True
    
    Set tIlst = New cImageList
    tIlst.Create 16, 16
    tIlst.AddIcon gODrawMenu.GetImgLstObj().GetIcon(6), True
    tIlst.Share = True
    
    .SetImageList TVSIL_NORMAL, tIlst.hWnd, 0, 0, 0, 0
    
    .BackColor = GetSysColor(COLOR_MENU)
    
End With
ReDim m_ifo(0 To 0)
End Sub
Private Sub Form_Resize()
If Me.Visible Then
    If Not m_cTvw Is Nothing Then
        m_cTvw.Move 0, 0, Me.ScaleWidth / 15, Me.ScaleHeight / 15
        'm_ctvw.SetColumnWidth 0, Me.ScaleWidth / 15
    End If
'    ListView1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
'    ListView1.ColumnHeaders(1).Width = ListView1.Width
End If
End Sub
'
'Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'On Error Resume Next
'Dim tItem As MSComctlLib.ListItem
'Set tItem = ListView1.HitTest(x, y)
'If Not tItem Is Nothing Then
'    Set ListView1.SelectedItem = tItem
'    ListView1.ToolTipText = tItem.Tag
'Else
'    ListView1.SelectedItem.Selected = False
'    ListView1.ToolTipText = ""
'End If
'
'End Sub
'
'Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'Dim tItem As MSComctlLib.ListItem
'If Button = vbLeftButton Then
'    Set tItem = ListView1.HitTest(x, y)
'    If Not tItem Is Nothing Then
'        gMainForm.ClickFavorite tItem.Text, tItem.Tag
'        gMainForm.NewWebbrowser tItem.Tag
'    End If
'End If
'End Sub
Public Sub SetPos()
Dim tpt As POINTAPI
Dim sX As Single, sY As Single
sX = GetSystemMetrics(SM_CXSCREEN) * 15
sY = GetSystemMetrics(SM_CYSCREEN) * 15
Call GetCursorPos(tpt)
If tpt.x * 15 + Me.width > sX Then
    tpt.x = (sX - Me.width) / 15
End If
If tpt.x < 0 Then tpt.x = 0
If tpt.y * 15 + Me.height > sY Then
    tpt.y = (sY - Me.height) / 15
End If
If tpt.y < 0 Then tpt.y = 0
Me.Move tpt.x * 15, tpt.y * 15
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set m_cTvw = Nothing
End Sub
Private Sub m_cTvw_Click(hItem As Long, x As Long, y As Long)
Dim tHItem&
tHItem = m_cTvw.Hittest(x, y)
If tHItem <> 0 Then
    Debug.Print tHItem
    With m_ifo(m_cTvw.GetItemParam(tHItem))
        gMainForm.ClickFavorite .Title, .Url
        gMainForm.NewWebbrowser .Url
    End With
End If
End Sub
Private Sub m_cTvw_SetTip(hItem As Long, vTip As String)
On Error Resume Next
With m_ifo(m_cTvw.GetItemParam(hItem))
    vTip = .Title & vbNewLine & .Url
End With
End Sub

						