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


VERSION 5.00 
Begin VB.UserControl cPwdBox  
   AutoRedraw      =   -1  'True 
   BackColor       =   &H00FFF4E4& 
   ClientHeight    =   3600 
   ClientLeft      =   0 
   ClientTop       =   0 
   ClientWidth     =   4800 
   MousePointer    =   3  'I-Beam 
   ScaleHeight     =   240 
   ScaleMode       =   3  'Pixel 
   ScaleWidth      =   320 
   ToolboxBitmap   =   "cPwdBox.ctx":0000 
   Begin VB.Timer timMouse  
      Enabled         =   0   'False 
      Interval        =   55 
      Left            =   3000 
      Top             =   1440 
   End 
   Begin VB.PictureBox cmdKb  
      BorderStyle     =   0  'None 
      Height          =   240 
      Left            =   75 
      Picture         =   "cPwdBox.ctx":0312 
      ScaleHeight     =   16 
      ScaleMode       =   3  'Pixel 
      ScaleWidth      =   17 
      TabIndex        =   1 
      ToolTipText     =   "" 
      Top             =   75 
      Width           =   255 
   End 
   Begin VB.TextBox txtMain  
      BorderStyle     =   0  'None 
      BeginProperty Font  
         Name            =   "Verdana" 
         Size            =   10.5 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   270 
      IMEMode         =   3  'DISABLE 
      Left            =   375 
      Locked          =   -1  'True 
      TabIndex        =   0 
      Top             =   60 
      Width           =   1935 
   End 
End 
Attribute VB_Name = "cPwdBox" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
 
Option Explicit 
 
Private Asm(63) As Byte 
Private OldProc As Long 
 
Private Const pwdChar = "" 
Private Const BorderColor = &HD1A04E 
Private Const HighLightColor = &HFFE485 
 
Private CapsLock As Boolean 
 
Private Pwd As String, PwdLen As Long 
Private SelPos As Long, Insert As Integer 
Private MouseOver As Boolean 
 
Private fCaps As New frmCapsLock 
Private fKeyb As New frmKeyboard 
 
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() 
 
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
    Select Case uMsg 
        Case WM_RBUTTONUP 
            Exit Function 
        Case WM_MOUSEMOVE 
            If wParam = 1 Then Exit Function 
        Case WM_KEYDOWN 
            If wParam <> 20 Then 
                CapsLock = False 
                ShowCapsLock 
                 
                If wParam = 37 Then 
                    If SelPos > 0 Then SelPos = SelPos - 1: txtMain.SelStart = SelPos 
                    Exit Function 
                End If 
                 
                If wParam = 39 Then 
                    If SelPos < PwdLen Then SelPos = SelPos + 1: txtMain.SelStart = SelPos 
                    Exit Function 
                End If 
            End If 
        Case WM_KEYUP 
            If wParam = 20 Then 
                CheckCaps 
            Else 
                CapsLock = False 
                ShowCapsLock 
            End If 
    End Select 
     
    WindowProc = CallWindowProc(OldProc, hWnd, uMsg, wParam, lParam) 
End Function 
 
Private Sub UserControl_Initialize() 
    Dim Ofs As Long 
    Dim ptr As Long 
     
    Call GetMem4(ObjPtr(Me), VarPtr(ptr)) 
    Call GetMem4(ptr + &H1E9 * 4, VarPtr(ptr)) 
     
    Ofs = VarPtr(Asm(0)) 
    MovL Ofs, &H424448B 
    MovL Ofs, &H8245C8B 
    MovL Ofs, &HC244C8B 
    MovL Ofs, &H1024548B 
    MovB Ofs, &H68 
    MovL Ofs, VarPtr(Asm(59)) 
    MovB Ofs, &H52 
    MovB Ofs, &H51 
    MovB Ofs, &H53 
    MovB Ofs, &H50 
    MovB Ofs, &H68 
    MovL Ofs, ObjPtr(Me) 
    MovB Ofs, &HE8 
    MovL Ofs, ptr - Ofs - 4 
    MovB Ofs, &HA1 
    MovL Ofs, VarPtr(Asm(59)) 
    MovL Ofs, &H10C2 
End Sub 
 
Private Sub MovB(Ofs As Long, ByVal value As Long) 
    Call PutMem1(Ofs, value): Ofs = Ofs + 1 
End Sub 
 
Private Sub MovL(Ofs As Long, ByVal value As Long) 
    Call PutMem4(Ofs, value): Ofs = Ofs + 4 
End Sub 
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) 
    txtMain.MaxLength = PropBag.ReadProperty("MaxLength", 0) 
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &HFFF4E4) 
    Pwd = PropBag.ReadProperty("Password", "") 
    If Len(Pwd) > 0 Then ChangeValue 
     
    Redraw 
     
    If Ambient.UserMode Then Load fCaps 
    If Ambient.UserMode Then OldProc = SetWindowLong(txtMain.hWnd, GWL_WNDPROC, VarPtr(Asm(0))) 
End Sub 
 
Private Sub UserControl_Terminate() 
    On Error Resume Next 
     
    Unload fCaps: Set fCaps = Nothing 
    Unload fKeyb: Set fKeyb = Nothing 
     
    If OldProc Then Call SetWindowLong(txtMain.hWnd, GWL_WNDPROC, OldProc) 
End Sub 
 
Private Sub cmdKb_Click() 
    Dim rt As RECT, sX As Single, sY As Single 
    GetWindowRect UserControl.hWnd, rt 
     
    Load fKeyb: Set fKeyb.ParentBox = Me 
    sX = rt.Left * Screen.TwipsPerPixelX 
    sY = rt.Bottom * Screen.TwipsPerPixelY 
    If sX + fKeyb.Width > Screen.Width Then sX = sX - fKeyb.Width 
    If sY + fKeyb.Height > Screen.Height Then sY = rt.Top * Screen.TwipsPerPixelY - fKeyb.Height 
    If sY < 0 Then sY = 0 
     
    fKeyb.Left = sX: fKeyb.Top = sY 
    fKeyb.Show: fKeyb.SetFocus 
End Sub 
 
Private Sub CheckCaps() 
    CapsLock = GetCapsLockState 
    ShowCapsLock 
End Sub 
 
Private Sub ShowCapsLock() 
    On Error Resume Next 
 
    Dim rt As RECT 
    GetWindowRect UserControl.hWnd, rt 
 
    If CapsLock Then 
        If CL_Shown = False Then 
            fCaps.Left = (3 + rt.Left) * tX 
            fCaps.Top = (13 + rt.Top) * tY 
            fCaps.ShowForm 
        End If 
    Else 
        fCaps.HideForm 
    End If 
End Sub 
 
Private Sub txtMain_GotFocus() 
    CheckCaps 
End Sub 
 
Private Sub txtMain_LostFocus() 
    CapsLock = False: ShowCapsLock 
End Sub 
 
Private Sub cmdKb_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 
    SetHand 
 
    If Button = 1 Then cmdKb.Left = 6: cmdKb.Top = 6 
End Sub 
 
Private Sub cmdKb_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
    SetHand 
 
    If MouseOver <> True Then 
        MouseOver = True 
        timMouse.Enabled = True 
        Redraw 
    End If 
 
    If Button = 1 Then cmdKb.Left = 6: cmdKb.Top = 6 
End Sub 
 
Private Sub cmdKb_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 
    SetHand 
 
    cmdKb.Left = 5: cmdKb.Top = 5: txtMain.SetFocus 
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 
        Redraw 
    End If 
End Sub 
 
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
    If MouseOver <> True Then 
        MouseOver = True 
        timMouse.Enabled = True 
        Redraw 
    End If 
End Sub 
 
Private Sub UserControl_Resize() 
    UserControl.Height = 26 * Screen.TwipsPerPixelY 
    txtMain.Width = UserControl.ScaleWidth - 28 
 
    Redraw 
End Sub 
 
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) 
    Call PropBag.WriteProperty("MaxLength", txtMain.MaxLength, 0) 
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &HFFFFFF) 
    Call PropBag.WriteProperty("Password", Pwd, "") 
End Sub 
 
Private Sub txtMain_Click() 
    SelPos = txtMain.SelStart 
 
    RaiseEvent Click 
End Sub 
 
Private Sub txtMain_DblClick() 
    RaiseEvent DblClick 
End Sub 
 
Private Sub txtMain_KeyDown(KeyCode As Integer, Shift As Integer) 
    SelPos = txtMain.SelStart 
    PwdLen = Len(Pwd) 
    Insert = 0 
 
    If KeyCode = 46 Then 
        If SelPos < PwdLen Then 
            Pwd = Left(Pwd, SelPos) & Mid(Pwd, SelPos + 2) 
            ChangeValue 
            KeyCode = 0 
        End If 
    End If 
 
    RaiseEvent KeyDown(KeyCode, Shift) 
End Sub 
 
Private Sub txtMain_KeyPress(KeyAscii As Integer) 
    SelPos = txtMain.SelStart 
    PwdLen = Len(Pwd) 
    Insert = 0 
 
    Select Case KeyAscii 
    Case 8 
        If SelPos > 0 Then 
            Pwd = Left(Pwd, SelPos - 1) & Mid(Pwd, SelPos + 1) 
            Insert = -1 
        End If 
    Case 32 To 126 
        If (txtMain.MaxLength > 0 And PwdLen < txtMain.MaxLength) Or (txtMain.MaxLength = 0) Then 
            Pwd = Left(Pwd, SelPos) & Chr(KeyAscii) & Mid(Pwd, SelPos + 1) 
            Insert = 1 
        End If 
    End Select 
 
    ChangeValue 
    RaiseEvent KeyPress(KeyAscii) 
 
    KeyAscii = 0 
End Sub 
Private Sub txtMain_Change(): RaiseEvent Change: 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 
Private Sub txtMain_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 
    If MouseOver <> True Then 
        MouseOver = True 
        timMouse.Enabled = True 
        Redraw 
    End If 
 
    RaiseEvent MouseMove(Button, Shift, x, y) 
End Sub 
 
Public Property Get Password() As String 
    Password = Pwd 
End Property 
 
Public Property Let Password(ByVal New_Password As String) 
    Pwd = New_Password 
    If Len(Pwd) > 0 Then ChangeValue 
 
    PropertyChanged "Password" 
End Property 
 
Public Property Get MaxLength() As Long 
    MaxLength = txtMain.MaxLength 
End Property 
 
Public Property Let MaxLength(ByVal New_MaxLength As Long) 
    txtMain.MaxLength = New_MaxLength 
    If New_MaxLength > 0 Then 
        If Len(Pwd) > New_MaxLength Then Pwd = Left(Pwd, New_MaxLength) 
    End If 
 
    PropertyChanged "MaxLength" 
End Property 
 
Private Sub ChangeValue() 
    Dim I As Long, s As String, l As Long 
 
    l = txtMain.SelStart 
 
    For I = 1 To Len(Pwd) 
        s = s & pwdChar 
    Next 
 
    txtMain.Text = s 
    txtMain.SelStart = l + Insert 
End Sub 
 
Public Property Get BackColor() As OLE_COLOR 
    BackColor = UserControl.BackColor 
End Property 
 
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR) 
    UserControl.BackColor() = New_BackColor 
 
    PropertyChanged "BackColor" 
End Property 
 
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 
End Sub 
 
Public Sub AddCharAscii(KeyAscii As Integer) 
    txtMain_KeyPress KeyAscii 
End Sub