nicecombo.ctl

来自「非常漂亮的VB控件」· CTL 代码 · 共 126 行

VERSION 5.00
Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
Begin VB.UserControl NiceCombo 
   BackStyle       =   0  '透明
   ClientHeight    =   2655
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   2655
   ScaleWidth      =   4800
   Begin VB.PictureBox P 
      Appearance      =   0  'Flat
      BackColor       =   &H000080FF&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   300
      Left            =   1485
      ScaleHeight     =   300
      ScaleWidth      =   270
      TabIndex        =   0
      Top             =   0
      Width           =   270
   End
   Begin PicClip.PictureClip Pc 
      Left            =   2430
      Top             =   720
      _ExtentX        =   1429
      _ExtentY        =   529
      _Version        =   393216
      Cols            =   3
      Picture         =   "NiceCombo.ctx":0000
   End
   Begin VB.ComboBox Combo1 
      Appearance      =   0  'Flat
      Height          =   300
      ItemData        =   "NiceCombo.ctx":0D22
      Left            =   0
      List            =   "NiceCombo.ctx":0D44
      TabIndex        =   1
      Text            =   "Combo1"
      Top             =   0
      Width           =   1750
   End
   Begin VB.Image PD 
      Height          =   300
      Left            =   1080
      Stretch         =   -1  'True
      Top             =   1320
      Width           =   300
   End
   Begin VB.Image PO 
      Height          =   300
      Left            =   720
      Stretch         =   -1  'True
      Top             =   1320
      Width           =   300
   End
   Begin VB.Image PN 
      Height          =   300
      Left            =   360
      Stretch         =   -1  'True
      Top             =   1320
      Width           =   300
   End
End
Attribute VB_Name = "NiceCombo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Private Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Long) As Long

Private Const CB_SHOWDROPDOWN = &H14F

Private Sub P_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    PaintCombos PD ' image on
    ' Automatically drops down the ComboBox
    SendMessage Combo1.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
End Sub

Private Sub P_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    PaintCombos PO ' image over
End Sub

Private Sub P_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    PaintCombos PN ' image off
End Sub

Private Sub Combo1_Click()
    P.Cls
    PaintCombos PO ' image over
End Sub

Private Sub Combo1_LostFocus()
    PaintCombos PN ' Image Off
End Sub

Private Sub PaintCombos(Pict As Image)
    
    ' set the picture
    With P
        .Picture = Pict ' the Image
    End With
    
End Sub

Private Sub UserControl_Initialize()
    PN.Picture = Pc.GraphicCell(0)
    PO.Picture = Pc.GraphicCell(1)
    PD.Picture = Pc.GraphicCell(2)
End Sub

Private Sub UserControl_InitProperties()
    P.Picture = Pc.GraphicCell(0)
End Sub

Private Sub UserControl_Resize()
Combo1.Width = UserControl.Width
UserControl.Height = Combo1.Height
P.Left = UserControl.Width - P.Width: P.Top = 0
P.Height = Combo1.Height
End Sub