imlist.ctl

这是用Vb编写的虚拟驱动程序,希望对大家有帮助.

VERSION 5.00
Begin VB.UserControl ImList 
   ClientHeight    =   5895
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6495
   ScaleHeight     =   393
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   433
   ToolboxBitmap   =   "ImList.ctx":0000
   Begin VB.VScrollBar VS 
      CausesValidation=   0   'False
      Height          =   4335
      Left            =   3720
      TabIndex        =   3
      Top             =   0
      Width           =   255
   End
   Begin VB.PictureBox Con 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   4335
      Left            =   0
      ScaleHeight     =   289
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   265
      TabIndex        =   0
      Top             =   0
      Width           =   3975
      Begin VB.Shape Shape1 
         BackColor       =   &H00000000&
         BackStyle       =   1  'Opaque
         DrawMode        =   6  'Mask Pen Not
         Height          =   615
         Left            =   0
         Top             =   840
         Visible         =   0   'False
         Width           =   3615
      End
      Begin VB.Image ImgCon 
         Height          =   615
         Index           =   0
         Left            =   120
         MouseIcon       =   "ImList.ctx":0312
         MousePointer    =   99  'Custom
         Stretch         =   -1  'True
         Top             =   120
         Visible         =   0   'False
         Width           =   615
      End
      Begin VB.Label Titles 
         BackStyle       =   0  'Transparent
         BeginProperty Font 
            Name            =   "MS Serif"
            Size            =   8.25
            Charset         =   178
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   0
         Left            =   840
         TabIndex        =   2
         Top             =   120
         Visible         =   0   'False
         Width           =   2535
      End
      Begin VB.Label Tips 
         BackStyle       =   0  'Transparent
         Caption         =   "Icon Command"
         Height          =   375
         Index           =   0
         Left            =   840
         TabIndex        =   1
         Top             =   360
         Visible         =   0   'False
         Width           =   2535
      End
   End
End
Attribute VB_Name = "ImList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'//////////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////////
'////////Image List Control Created By
'////////Marco Samy Nasif
'////////[e-mail]
'////////////////////////////
'////////For
'////////Technosoft Bar 2003
'////////Technosoft Virtual Drive 2003
'//////////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////////

Event ImageClicked(ByVal Index As Integer)
Event TitleClicked(ByVal Index As Integer)
Event TipClicked(ByVal Index As Integer)
Event GeneralClicked(ByVal Index As Integer)
Event MouseDown(ByVal Index As Integer, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Event MouseMove(ByVal Index As Integer, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Event MouseUp(ByVal Index As Integer, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Default Property Values:
'Const m_def_TitleColor =
'Const m_def_TipColor =
Const m_def_Selected = 0
'Property Variables:
Dim m_TitleColor As OLE_COLOR
Dim m_TipColor As OLE_COLOR
Dim m_TitleFont As Font
Dim m_TipFont As Font
Dim m_Selected As Integer



Private Sub Con_Click()
RaiseEvent GeneralClicked(-1)
End Sub

Private Sub Con_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(-1, Button, Shift, X, Y + Con.Top)
End Sub

Private Sub Con_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(-1, Button, Shift, X, Y + Con.Top)
End Sub

Private Sub Con_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Hell
RaiseEvent MouseUp(-1, Button, Shift, X, Y + Con.Top)
Dim iIndex As Integer
iIndex = Y \ (ImgCon(0).Height + (120 / Screen.TwipsPerPixelY))
Shape1.Top = ImgCon(iIndex + 1).Top
m_Selected = iIndex + 1
PropertyChanged "Selected"
If Shape1.Visible = False Then Shape1.Visible = True
Hell:
End Sub

Private Sub ImgCon_Click(Index As Integer)
Shape1.Top = ImgCon(Index).Top
m_Selected = Index
PropertyChanged "Selected"
If Shape1.Visible = False Then Shape1.Visible = True
RaiseEvent ImageClicked(Index)
RaiseEvent GeneralClicked(Index)
End Sub

Private Sub ImgCon_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Index, Button, Shift, ImgCon(Index).Left + X, ImgCon(Index).Top + Y + Con.Top)
End Sub

Private Sub ImgCon_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Index, Button, Shift, ImgCon(Index).Left + X, ImgCon(Index).Top + Y + Con.Top)
End Sub

Private Sub ImgCon_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Index, Button, Shift, ImgCon(Index).Left + X, ImgCon(Index).Top + Y + Con.Top)
End Sub

Private Sub Tips_Click(Index As Integer)
Shape1.Top = ImgCon(Index).Top
m_Selected = Index
PropertyChanged "Selected"
If Shape1.Visible = False Then Shape1.Visible = True
RaiseEvent TipClicked(Index)
RaiseEvent GeneralClicked(Index)
End Sub

Private Sub Tips_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Index, Button, Shift, Tips(Index).Left + X, Tips(Index).Top + Y + Con.Top)
End Sub

Private Sub Tips_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Index, Button, Shift, Tips(Index).Left + X, Tips(Index).Top + Y + Con.Top)
End Sub

Private Sub Tips_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Index, Button, Shift, Tips(Index).Left + X, Tips(Index).Top + Y + Con.Top)
End Sub

Private Sub Titles_Click(Index As Integer)
Shape1.Top = ImgCon(Index).Top
m_Selected = Index
PropertyChanged "Selected"
If Shape1.Visible = False Then Shape1.Visible = True
RaiseEvent TitleClicked(Index)
RaiseEvent GeneralClicked(Index)
End Sub

Private Sub Titles_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Index, Button, Shift, Titles(Index).Left + X, Titles(Index).Top + Y + Con.Top)
End Sub

Private Sub Titles_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Index, Button, Shift, Titles(Index).Left + X, Titles(Index).Top + Y + Con.Top)
End Sub

Private Sub Titles_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Index, Button, Shift, Titles(Index).Left + X, Titles(Index).Top + Y + Con.Top)
End Sub

Private Sub UserControl_Initialize()
Shape1.Visible = False
ImgCon(0).Top = -ImgCon(0).Height - (120 / Screen.TwipsPerPixelY)
UserControl.BackColor = Con.BackColor
If Count = 0 Then Clear
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
Con.Move 0, 0, Width
VS.Visible = Con.Height > UserControl.ScaleHeight
If VS.Visible = False Then Con.Move 0, 0
Shape1.Width = Width
For I = 0 To Titles.UBound
Titles(I).Width = Width - Titles(I).Left
Tips(I).Width = Titles(I).Width
Next I
Shape1.Width = ScaleWidth
VS.Left = ScaleWidth - VS.Width
VS.Height = ScaleHeight
VS.Min = 0
VS.Max = (Con.Height - UserControl.ScaleHeight)
VS.SmallChange = Int(VS.Max) / 10
VS.LargeChange = Int(VS.Max) / 5
UserControl.BackColor = Con.BackColor
End Sub
Function AddItem(ByVal sTitle As Variant, Optional ByVal sTip As String = "", Optional ByVal ToolTip As String = "", Optional ByVal Index As Integer = -1, Optional sImage As IPictureDisp)
If Count = 150 Then Exit Function
If Not Index = -1 Then
Dim OldTitle As String, OldTip As String, OldToolTip As String, OldPicture As Picture
OldTitle = Titles(Count).Caption
OldTip = Tips(Count).Caption
OldToolTip = Titles(Count).ToolTipText
Set OldPicture = ImgCon(Count).Picture