www.pudn.com > QQ2009.rar > cChooseComboBox.ctl, change:2009-11-15,size:9089b


VERSION 5.00 
Begin VB.UserControl cChooseComboBox  
   AutoRedraw      =   -1  'True 
   BackColor       =   &H00FFF4E4& 
   ClientHeight    =   3600 
   ClientLeft      =   0 
   ClientTop       =   0 
   ClientWidth     =   4800 
   ScaleHeight     =   240 
   ScaleMode       =   3  'Pixel 
   ScaleWidth      =   320 
   ToolboxBitmap   =   "cChooseComboBox.ctx":0000 
   Begin VB.Timer timMouse  
      Enabled         =   0   'False 
      Interval        =   55 
      Left            =   3480 
      Top             =   2400 
   End 
   Begin VB.TextBox txtMain  
      BorderStyle     =   0  'None 
      BeginProperty Font  
         Name            =   "Verdana" 
         Size            =   9 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   225 
      Left            =   375 
      TabIndex        =   0 
      Top             =   90 
      Width           =   1935 
   End 
   Begin VB.Label cmdDown  
      BackStyle       =   0  'Transparent 
      Height          =   330 
      Left            =   2280 
      TabIndex        =   1 
      Top             =   30 
      Width           =   345 
   End 
   Begin VB.Image imgQQ  
      Height          =   330 
      Left            =   2640 
      Picture         =   "cChooseComboBox.ctx":0312 
      Top             =   2400 
      Visible         =   0   'False 
      Width           =   330 
   End 
   Begin VB.Image imgBorder_C  
      Height          =   30 
      Left            =   2520 
      Picture         =   "cChooseComboBox.ctx":092C 
      Top             =   2640 
      Visible         =   0   'False 
      Width           =   30 
   End 
   Begin VB.Image imgBorder_Left  
      Height          =   15 
      Left            =   2520 
      Picture         =   "cChooseComboBox.ctx":097E 
      Top             =   2520 
      Visible         =   0   'False 
      Width           =   30 
   End 
   Begin VB.Image imgBorder_Top  
      Height          =   30 
      Left            =   2520 
      Picture         =   "cChooseComboBox.ctx":09C8 
      Top             =   2400 
      Visible         =   0   'False 
      Width           =   15 
   End 
   Begin VB.Image imgDown_Down  
      Height          =   330 
      Left            =   2040 
      Picture         =   "cChooseComboBox.ctx":0A12 
      Top             =   2400 
      Visible         =   0   'False 
      Width           =   345 
   End 
   Begin VB.Image imgDown_Over  
      Height          =   330 
      Left            =   1680 
      Picture         =   "cChooseComboBox.ctx":1084 
      Top             =   2400 
      Visible         =   0   'False 
      Width           =   345 
   End 
   Begin VB.Image imgDown_Normal  
      Height          =   330 
      Left            =   1320 
      Picture         =   "cChooseComboBox.ctx":16F6 
      Top             =   2400 
      Visible         =   0   'False 
      Width           =   345 
   End 
End 
Attribute VB_Name = "cChooseComboBox" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
 
Private Const BorderColor = &HD1A04E 
Private Const HighLightColor = &HFFE485 
 
Private MouseOver As Boolean 
Private btnState As Integer 
 
Private TextEmpty As Boolean 
Private PassChangeState As Boolean 
 
Event Click() 
Event DblClick() 
Event KeyDown(KeyCode As Integer, Shift As Integer) 
Event KeyPress(KeyAscii As Integer) 
Event KeyUp(KeyCode As Integer, Shift As Integer) 
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 
Event Change() 
 
Private Sub cmdDown_Click() 
    Dim rc As RECT 
    GetWindowRect hWnd, rc 
     
    Load frmDropDown 
    With frmDropDown 
        .Left = rc.Left * tX 
        .Top = rc.Bottom * tY 
        .Width = (rc.Right - rc.Left) * tX 
        .Height = 200 * tY 
        .ReDrawDrop 
        .Show 
    End With 
End Sub 
 
Private Sub cmdDown_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 
    btnState = 2 
     
    Redraw 
End Sub 
 
Private Sub cmdDown_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
    timMouse.Enabled = True 
     
    Dim lstState As Integer, lstOver As Boolean 
    lstState = btnState 
    lstOver = MouseOver 
     
    If Button = 1 Then btnState = 2 Else btnState = 1 
    MouseOver = True 
     
    If btnState <> lstState Or MouseOver <> lstOver Then Redraw 
End Sub 
 
Private Sub cmdDown_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 
    btnState = 0 
     
    Redraw 
End Sub 
 
Private Sub timMouse_Timer() 
    Dim rt As RECT, Point As POINTAPI 
 
    GetCursorPos Point 
    GetWindowRect UserControl.hWnd, rt 
 
    If Point.x < rt.Left Or Point.x > rt.Right Or Point.y < rt.Top Or Point.y > rt.Bottom Then 
        timMouse.Enabled = False 
        MouseOver = False 
        btnState = 0 
         
        Redraw 
    End If 
End Sub 
 
Private Sub txtMain_Change() 
    If PassChangeState Then PassChangeState = False: Exit Sub 
    TextEmpty = (Len(txtMain.Text) = 0) 
     
    RaiseEvent Change 
End Sub 
 
Private Sub txtMain_GotFocus() 
    If TextEmpty Then 
        txtMain.ForeColor = &H0 
        PassChangeState = True 
        txtMain.Text = "" 
    Else 
        txtMain.SelStart = 0 
        txtMain.SelLength = Len(txtMain.Text) 
    End If 
End Sub 
 
Private Sub txtMain_LostFocus() 
    If TextEmpty Then 
        txtMain.ForeColor = &H808080 
        PassChangeState = True 
        txtMain.Text = "<请输入帐号>" 
    End If 
End Sub 
 
Private Sub txtMain_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
    RaiseEvent MouseMove(Button, Shift, x, y) 
     
    timMouse.Enabled = True 
     
    Dim lstState As Integer, lstOver As Boolean 
    lstState = btnState 
    lstOver = MouseOver 
     
    btnState = 0 
    MouseOver = True 
     
    If btnState <> lstState Or MouseOver <> lstOver Then Redraw 
End Sub 
 
Private Sub UserControl_Initialize() 
    TextEmpty = True 
End Sub 
 
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
    timMouse.Enabled = True 
     
    Dim lstState As Integer, lstOver As Boolean 
    lstState = btnState 
    lstOver = MouseOver 
     
    btnState = 0 
    MouseOver = True 
     
    If btnState <> lstState Or MouseOver <> lstOver Then Redraw 
End Sub 
 
Private Sub UserControl_Resize() 
    UserControl.Height = 26 * Screen.TwipsPerPixelY 
    txtMain.Width = UserControl.ScaleWidth - 52 
    cmdDown.Left = UserControl.ScaleWidth - 25 
    Redraw 
End Sub 
 
Private Sub Redraw() 
    UserControl.Cls 
 
    If MouseOver Then UserControl.Line (0, 0)-(ScaleWidth - 1, ScaleHeight - 1), HighLightColor, B 
     
    UserControl.Line (1, 1)-(ScaleWidth - 2, ScaleHeight - 2), BorderColor, B 
    UserControl.Line (2, 2)-(ScaleWidth - 3, ScaleHeight - 3), &HFFFFFF, BF 
    UserControl.PaintPicture imgBorder_Top.Picture, 4, 2, ScaleWidth - 29 
    UserControl.PaintPicture imgBorder_Left.Picture, 2, 4, , ScaleHeight - 6 
    UserControl.PaintPicture imgBorder_C.Picture, 2, 2 
    UserControl.PaintPicture imgQQ.Picture, 2, 2 
    If btnState = 0 Then 
        UserControl.PaintPicture imgDown_Normal.Picture, ScaleWidth - 25, 2 
    ElseIf btnState = 1 Then 
        UserControl.PaintPicture imgDown_Over.Picture, ScaleWidth - 25, 2 
    Else 
        UserControl.PaintPicture imgDown_Down.Picture, ScaleWidth - 25, 2 
    End If 
End Sub 
Private Sub txtMain_Click(): RaiseEvent Click: End Sub 
Private Sub txtMain_DblClick(): RaiseEvent DblClick: End Sub 
Private Sub txtMain_KeyDown(KeyCode As Integer, Shift As Integer): RaiseEvent KeyDown(KeyCode, Shift): End Sub 
Private Sub txtMain_KeyPress(KeyAscii As Integer): RaiseEvent KeyPress(KeyAscii): End Sub 
Private Sub txtMain_KeyUp(KeyCode As Integer, Shift As Integer): RaiseEvent KeyUp(KeyCode, Shift): End Sub 
Private Sub txtMain_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single): RaiseEvent MouseDown(Button, Shift, x, y): End Sub 
Private Sub txtMain_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single): RaiseEvent MouseUp(Button, Shift, x, y): End Sub 
 
Public Property Get Text() As String 
Attribute Text.VB_Description = "返回/设置控件中包含的文本。" 
    Text = txtMain.Text 
End Property 
 
Public Property Let Text(ByVal New_Text As String) 
    txtMain.Text() = New_Text 
    PropertyChanged "Text" 
End Property 
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) 
    txtMain.Text = PropBag.ReadProperty("Text", "") 
End Sub 
 
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) 
    Call PropBag.WriteProperty("Text", txtMain.Text, "") 
End Sub