newbtn1.ctl

自动升级模块 几各常见的按钮

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "Comctl32.ocx"
Begin VB.UserControl newButton 
   Appearance      =   0  'Flat
   BackColor       =   &H00000000&
   ClientHeight    =   1320
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2085
   ClipBehavior    =   0  '无
   FillStyle       =   0  'Solid
   MaskColor       =   &H000000FF&
   ScaleHeight     =   88
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   139
   Begin ComctlLib.ImageList ImageList1 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   327682
   End
End
Attribute VB_Name = "newButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit

Private m_BtnCaption    As String
Private m_BackColor     As OLE_COLOR
Private m_Picture       As StdPicture

Const m_def_BtnCaption = "Caption"
Const m_def_BackColor = &HFF
Const m_def_Picture = vbNull

Public Event Click()

Private dx As Integer
Private cdx As Double
Private j As Double
Private m_Button    As Integer
Private m_State     As Integer

Public Sub DrawImage(hdc As Long, pic As StdPicture, X, Y, MaskColor As Long)
On Error Resume Next
Dim Img1 As ListImage
    Set Img1 = ImageList1.ListImages.Add(, , pic)
    ImageList1.UseMaskColor = True
    ImageList1.MaskColor = MaskColor
    Img1.draw hdc, X, Y, imlTransparent
    ImageList1.ListImages.Remove Img1.Index
End Sub

Public Property Get BtnCaption() As String
  BtnCaption = m_BtnCaption
End Property

Public Property Let BtnCaption(ByVal New_Caption As String)
  m_BtnCaption = New_Caption
  PropertyChanged "BtnCaption"
  drawAll 1
End Property

Public Property Get picture() As StdPicture
    Set picture = m_Picture
End Property

Public Property Set picture(ByVal New_Picture As StdPicture)
  Set m_Picture = New_Picture
  PropertyChanged "Picture"
End Property

Public Sub Draw3DButton(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, mb As Byte)
On Error Resume Next
 
  Dim shsh As Integer
  Dim ccc As Byte
  
  shsh = UserControl.Height
  If shsh > 1 Then
  
  Dim i As Integer
   Const k = 50
    dx = y2 - y1: cdx = k / dx
    
    If mb = 0 Then
        j = 0
        For i = y1 To y2
            j = j + cdx
            ccc = Int(255 - j) + 1
            DrawLine hdc, RGB(ccc, ccc, ccc), x1, i, x2, i
        Next i
        DrawFrame RGB(255, 255, 255), RGB(235, 235, 235), x1, y1, x2, y2
        DrawSelection 1, x1, y1, x2, y2
                
    ElseIf mb = 1 Then
        j = k
        For i = y1 To y2
            j = j - cdx
            ccc = 255 - Int(j) + 1
            DrawLine hdc, RGB(ccc, ccc, ccc), x1, i, x2, i
        Next i
        DrawFrame RGB(235, 235, 235), RGB(255, 255, 255), x1, y1, x2, y2
    ElseIf mb = 2 Then
        j = 0
        For i = y1 To y2
            j = j + cdx
            ccc = Int(255 - j) + 1
            DrawLine hdc, RGB(230, 230, 230), x1, i, x2, i
        Next i
        
        DrawFrame RGB(255, 255, 255), RGB(235, 235, 235), x1, y1, x2, y2
        DrawSelection 0, x1, y1, x2, y2
    End If
   
    End If
End Sub

Private Sub UserControl_Initialize()

m_BackColor = m_def_BackColor
m_BtnCaption = m_def_BtnCaption

End Sub


Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  m_Button = Button
  'If Not m_Enabled Then Exit Sub
    If Button = 1 Then
        m_State = 2
        drawAll 2
    End If
End Sub


Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim m_enabled As Boolean

m_enabled = True

  If Button <> 1 Then
    If GetCapture <> 0 Then
      If X < 0 Or Y < 0 Or X > ScaleWidth Or Y > ScaleHeight Then
        If m_enabled Then
          m_State = 0
          drawAll 1
          ReleaseCapture
        End If
      End If
    ElseIf m_State = 0 Then
      If m_enabled Then
        m_State = 1
        drawAll 0
        SetCapture UserControl.hwnd
      End If
    End If
  Else
    If X < 0 Or Y < 0 Or X > ScaleWidth Or Y > ScaleHeight Then
      If m_enabled Then
        m_State = 1
        drawAll 1
      End If
    Else
      If m_enabled Then
        m_State = 2
        drawAll 2
      End If
    End If
  End If

End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'If Not m_Enabled Then Exit Sub

  If Button = 1 Then
    If X >= 0 And Y >= 0 And X <= ScaleWidth And Y <= ScaleHeight Then
      m_State = 0
      drawAll 1
      RaiseEvent Click
    Else
      m_State = 0
      drawAll 1
    End If
  End If

End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
m_BtnCaption = PropBag.ReadProperty("BtnCaption", m_def_BtnCaption)

Call UserControl_Resize

End Sub

Private Sub UserControl_Resize()

drawAll 1

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
Call PropBag.WriteProperty("BtnCaption", m_BtnCaption, m_def_BtnCaption)

End Sub

Public Sub drawAll(mb As Byte)

AutoRedraw = True
    Cls
    Call Draw3DButton(0, 0, UserControl.ScaleWidth + 1, UserControl.ScaleHeight + 1, mb)
    Call drawPictureAndCaption
AutoRedraw = False

End Sub


Public Sub drawPictureAndCaption()

Const cn = 26.455
Dim ox As Single
Dim oy As Single
Dim nx As Single
Dim ny As Single
Dim dx As Single
Dim dy As Single

    If m_State = 2 Then dx = 2.2: dy = 1.2 Else dx = 0: dy = 0
        ox = UserControl.ScaleWidth / 2 + dx
        oy = UserControl.ScaleHeight / 2 + dy

    If Not m_Picture Is Nothing Then
        Set picture = m_Picture
        nx = Int(ox - (picture.Width / cn) / 2)
        ny = Int(oy - (picture.Height / cn) / 2) - 5
        DrawImage hdc, m_Picture, nx, ny, RGB(255, 255, 255)
    End If
    
    UserControl.ForeColor = RGB(0, 100, 0)
    UserControl.CurrentX = ox - ((TextWidth(m_BtnCaption) / 2)) - 2 '+ dx
    UserControl.CurrentY = (2 * oy) - (TextHeight(m_BtnCaption)) - 2 '+ dx
    UserControl.Print m_BtnCaption

End Sub

Public Sub DrawLine(hdc As Long, color As Long, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer)

Dim pen As Long, old As Long

pen = CreatePen(0 * -2, 0 * -1, color)
old = SelectObject(hdc, pen)

MoveToEx hdc, x1, y1, 0
LineTo hdc, x2, y2
SelectObject hdc, old
DeleteObject pen

End Sub

Public Sub DrawFrame(color1 As Long, color2 As Long, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer)

Dim i As Byte
For i = 0 To 1
 UserControl.Line (x1, y1 + i)-(x2, y1 + i), color1, B
Next
For i = 0 To 2
 UserControl.Line (x1, y2 - i)-(x2, y2 - i), color2, B
Next
For i = 0 To 1
 UserControl.Line (x1 + i, y1)-(x1 + i, y2), color1, B
Next
For i = 0 To 2
 UserControl.Line (x2 - i, y1)-(x2 - i, y2), color2, B
Next

End Sub

Public Sub DrawSelection(mb As Boolean, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer)
Dim i As Byte

If mb Then
         For i = 0 To 0
          UserControl.Line (x1, y1 + i)-(x2, y1 + i), RGB(250, 100 + i * 5, 0), B
         Next
         For i = 0 To 2
          UserControl.Line (x1, y2 - i)-(x2, y2 - i), RGB(250, 100 + i * 5, 0), B
         Next
         For i = 0 To 0
          UserControl.Line (x1 + i, y1)-(x1 + i, y2), RGB(250, 100 + i * 5, 0), B
         Next
         For i = 0 To 2
          UserControl.Line (x2 - i, y1)-(x2 - i, y2), RGB(250, 100 + i * 5, 0), B
         Next
Else
         For i = 0 To 0
          UserControl.Line (x1, y1 + i)-(x2, y1 + i), RGB(50, 100 + i * 5, 0), B
         Next
         For i = 0 To 2
          UserControl.Line (x1, y2 - i)-(x2, y2 - i), RGB(50, 100 + i * 5, 0), B
         Next
         For i = 0 To 0
          UserControl.Line (x1 + i, y1)-(x1 + i, y2), RGB(50, 100 + i * 5, 0), B
         Next
         For i = 0 To 2
          UserControl.Line (x2 - i, y1)-(x2 - i, y2), RGB(50, 100 + i * 5, 0), B
         Next
End If

End Sub