xpcmdbutton.ctl

人事管理系统vb版,用于一般中小企业

VERSION 5.00
Begin VB.UserControl xpcmdButton 
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000005&
   ClientHeight    =   825
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1680
   DefaultCancel   =   -1  'True
   FillStyle       =   0  'Solid
   ScaleHeight     =   55
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   112
   ToolboxBitmap   =   "xpcmdbutton.ctx":0000
   Begin VB.Timer HoverTimer 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   480
      Top             =   360
   End
End
Attribute VB_Name = "xpcmdButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'mouse over effects
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

'draw and set rectangular area of the control
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long

'draw by pixel or by line
Private Declare Function CreateSolidBrush Lib "Gdi32" (ByVal crColor As Long) As Long
Private Declare Function SetPixel Lib "Gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "Gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "Gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreatePen Lib "Gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Const PS_SOLID As Long = 0

'select and delete created objects
Private Declare Function DeleteObject Lib "Gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "Gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

'create regions of pixels and remove them to make the control transparent
Private Declare Function CreateRectRgn Lib "Gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "Gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Const RGN_DIFF As Long = 4

'set text color and draw it to the control
Private Declare Function GetTextColor Lib "Gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "Gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

Private Const DT_CALCRECT As Long = &H400
Private Const DT_WORDBREAK As Long = &H10
Private Const DT_CENTER As Long = &H1

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Public Event Click()
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event MouseOver()
Public Event MouseOut()

Private rc As RECT
Private w As Long, h As Long
Private rgMain As Long, rgn1 As Long
Private isOver As Boolean
Private flgHover As Integer
Private flgFocus As Boolean
Private LastButton As Integer
Private LastKey As Integer
Private R As Long, l As Long, t As Long, b As Long
Private mEnabled As Boolean
Private mCaption As String
Private mForeHover As OLE_COLOR

Private Sub DrawButton()
Dim pt As POINTAPI, Pen As Long, hPen As Long

  With UserControl
    'left top corner
    hPen = CreatePen(PS_SOLID, 1, RGB(122, 149, 168))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l, t + 1, pt
    LineTo .hdc, l + 2, t
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    hPen = CreatePen(PS_SOLID, 1, RGB(37, 87, 131))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 2, t, pt
    LineTo .hdc, l, t + 2
    SelectObject .hdc, Pen
    DeleteObject hPen
    SetPixel .hdc, l, t + 2, RGB(37, 87, 131)
    SetPixel .hdc, l + 1, t + 2, RGB(191, 206, 220)
    SetPixel .hdc, l + 2, t + 1, RGB(192, 207, 221)
    
    'top line
    hPen = CreatePen(PS_SOLID, 1, RGB(0, 60, 116))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 3, t, pt
    LineTo .hdc, R - 2, t
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    'right top corner
    hPen = CreatePen(PS_SOLID, 1, RGB(37, 87, 131))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, R - 2, t, pt
    LineTo .hdc, R + 1, t + 3
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    hPen = CreatePen(PS_SOLID, 1, RGB(122, 149, 168))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, R - 1, t, pt
    LineTo .hdc, R, t + 2
    SetPixel .hdc, R, t + 1, RGB(122, 149, 168)
    SetPixel .hdc, R - 2, t + 1, RGB(213, 223, 232)
    SetPixel .hdc, R - 1, t + 2, RGB(191, 206, 219)
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    'right line
    hPen = CreatePen(PS_SOLID, 1, RGB(0, 60, 116))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, R, t + 3, pt
    LineTo .hdc, R, b - 3
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    'right bottom corner
    hPen = CreatePen(PS_SOLID, 1, RGB(37, 87, 131))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, R, b - 3, pt
    LineTo .hdc, R - 3, b
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    hPen = CreatePen(PS_SOLID, 1, RGB(122, 149, 168))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, R, b - 2, pt
    LineTo .hdc, R - 2, b
    SetPixel .hdc, R - 2, b - 2, RGB(177, 183, 182)
    SetPixel .hdc, R - 1, b - 3, RGB(182, 189, 189)
    SelectObject .hdc, Pen
    DeleteObject hPen
  
    'bottom line
    hPen = CreatePen(PS_SOLID, 1, RGB(0, 60, 116))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 3, b - 1, pt
    LineTo .hdc, R - 2, b - 1
    SelectObject .hdc, Pen
    DeleteObject hPen
  
    'left bottom corner
    hPen = CreatePen(PS_SOLID, 1, RGB(37, 87, 131))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l, b - 3, pt
    LineTo .hdc, l + 3, b
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    hPen = CreatePen(PS_SOLID, 1, RGB(122, 149, 168))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l, b - 2, pt
    LineTo .hdc, l + 2, b
    SetPixel .hdc, l + 1, b - 3, RGB(191, 199, 202)
    SetPixel .hdc, l + 2, b - 2, RGB(163, 174, 180)
    SelectObject .hdc, Pen
    DeleteObject hPen
  
    'left line
    hPen = CreatePen(PS_SOLID, 1, RGB(0, 60, 116))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l, t + 3, pt
    LineTo .hdc, l, b - 3
    SelectObject .hdc, Pen
    DeleteObject hPen
    
  End With
End Sub
Private Sub DrawFocus()
Dim pt As POINTAPI, Pen As Long, hPen As Long
Dim i As Long, ColorR As Long, ColorG As Long, ColorB As Long
  With UserControl
    'top line
    hPen = CreatePen(PS_SOLID, 1, RGB(206, 231, 251))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 2, t + 1, pt
    LineTo .hdc, R - 1, t + 1
    SelectObject .hdc, Pen
    DeleteObject hPen
  
    hPen = CreatePen(PS_SOLID, 1, RGB(188, 212, 246))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 1, t + 2, pt
    LineTo .hdc, R, t + 2
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    'draw gradient
    ColorR = 186
    ColorG = 211
    ColorB = 246
    For i = t + 3 To b - 4 Step 1
      hPen = CreatePen(PS_SOLID, 2, RGB(ColorR, ColorG, ColorB))
      Pen = SelectObject(.hdc, hPen)
      MoveToEx .hdc, l + 2, i, pt
      LineTo .hdc, l + 2, i + 1
      MoveToEx .hdc, R - 1, i, pt
      LineTo .hdc, R - 1, i + 1
      SelectObject .hdc, Pen
      DeleteObject hPen
      If ColorB >= 228 Then
        ColorR = ColorR - 4
        ColorG = ColorG - 3
        ColorB = ColorB - 1
      End If
    Next i
    
    hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 1, b - 3, pt
    LineTo .hdc, R - 1, b - 3
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    SetPixel .hdc, l + 2, b - 2, RGB(77, 125, 193)
    hPen = CreatePen(PS_SOLID, 1, RGB(97, 125, 229))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 3, b - 2, pt
    LineTo .hdc, R - 2, b - 2
    SetPixel .hdc, R - 2, b - 2, RGB(77, 125, 193)
    
    SelectObject .hdc, Pen
    DeleteObject hPen
    
  End With
End Sub
Private Sub DrawHighlight()
Dim pt As POINTAPI, Pen As Long, hPen As Long
Dim i As Long, ColorR As Long, ColorG As Long, ColorB As Long
  With UserControl
    'top line
    hPen = CreatePen(PS_SOLID, 1, RGB(255, 240, 207))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 2, t + 1, pt
    LineTo .hdc, R - 1, t + 1
    SelectObject .hdc, Pen
    DeleteObject hPen
  
    hPen = CreatePen(PS_SOLID, 1, RGB(253, 216, 137))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 1, t + 2, pt
    LineTo .hdc, R, t + 2
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    'draw gradient
    ColorR = 254
    ColorG = 223
    ColorB = 154
    For i = t + 2 To b - 3 Step 1
      hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
      Pen = SelectObject(.hdc, hPen)
      MoveToEx .hdc, l + 1, i, pt
      LineTo .hdc, l + 1, i + 1
      MoveToEx .hdc, R - 1, i, pt
      LineTo .hdc, R - 1, i + 1
      SelectObject .hdc, Pen
      DeleteObject hPen
      If ColorB >= 49 Then
        ColorR = ColorR - 1
        ColorG = ColorG - 3
        ColorB = ColorB - 7
      End If
    Next i
    ColorR = 252
    ColorG = 210
    ColorB = 121
    For i = t + 3 To b - 3 Step 1
      hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
      Pen = SelectObject(.hdc, hPen)
      MoveToEx .hdc, l + 2, i, pt
      LineTo .hdc, l + 2, i + 1
      MoveToEx .hdc, R - 2, i, pt
      LineTo .hdc, R - 2, i + 1
      SelectObject .hdc, Pen
      DeleteObject hPen
      If ColorB >= 57 Then
        ColorR = ColorR - 1
        ColorG = ColorG - 4
        ColorB = ColorB - 8
      End If
    Next i
    
    hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 3, b - 3, pt
    LineTo .hdc, R, b - 3
    SelectObject .hdc, Pen
    DeleteObject hPen
        
    hPen = CreatePen(PS_SOLID, 1, RGB(229, 151, 0))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l + 2, b - 2, pt
    LineTo .hdc, R - 1, b - 2
    SelectObject .hdc, Pen
    DeleteObject hPen
    
  End With
End Sub

Private Sub DrawButtonFace()
Dim pt As POINTAPI, Pen As Long, hPen As Long
Dim i As Long, ColorR As Long, ColorG As Long, ColorB As Long
  
  With UserControl
  
    .AutoRedraw = True
    .Cls
    .ScaleMode = 3
    
    'draw gradient
    ColorR = 255
    ColorG = 255
    ColorB = 253
    
    For i = t + 3 To b - 3 Step 1
      hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
      Pen = SelectObject(.hdc, hPen)
      MoveToEx .hdc, l, i, pt
      LineTo .hdc, R, i
      SelectObject .hdc, Pen
      DeleteObject hPen
      
      If ColorB >= 230 Then
        ColorR = ColorR - 1
        ColorG = ColorG - 1
        ColorB = ColorB - 1
      End If
    Next i
    
    'bottom shadow
    hPen = CreatePen(PS_SOLID, 1, RGB(214, 208, 197))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l, b - 2, pt
    LineTo .hdc, R, b - 2
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    hPen = CreatePen(PS_SOLID, 1, RGB(226, 223, 214))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l, b - 3, pt
    LineTo .hdc, R, b - 3
    SelectObject .hdc, Pen
    DeleteObject hPen
    
    hPen = CreatePen(PS_SOLID, 1, RGB(236, 235, 230))
    Pen = SelectObject(.hdc, hPen)
    MoveToEx .hdc, l, b - 4, pt
    LineTo .hdc, R, b - 4
    SelectObject .hdc, Pen
    DeleteObject hPen
    
  End With
  
End Sub
Private Sub DrawButtonDown()
Dim pt As POINTAPI, Pen As Long, hPen As Long
Dim i As Long, ColorR As Long, ColorG As Long, ColorB As Long
  With UserControl
    .AutoRedraw = True
    .Cls
    .ScaleMode = 3
    'draw gradient
    ColorR = 226
    ColorG = 225
    ColorB = 218
    For i = t + 3 To b - 2 Step 4
      hPen = CreatePen(PS_SOLID, 4, RGB(ColorR, ColorG, ColorB))
      Pen = SelectObject(.hdc, hPen)
      MoveToEx .hdc, l, i, pt
      LineTo .hdc, R, i
      SelectObject .hdc, Pen
      DeleteObject hPen
      If ColorB >= 218 Then
        ColorR = ColorR - 1
        ColorG = ColorG - 1