Examer/ucBtn.ctl at master · max-vb6/Examer · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
VERSION 5.00
Begin VB.UserControl ucBtn
   BackColor       =   &H00FA8C5A&
   ClientHeight    =   855
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1695
   BeginProperty Font
      Name            =   "Î¢ÈíÑÅºÚ"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ScaleHeight     =   855
   ScaleWidth      =   1695
   Tag             =   "0"
   ToolboxBitmap   =   "ucBtn.ctx":0000
   Begin VB.Label lblCap
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Button"
      BeginProperty Font
         Name            =   "Î¢ÈíÑÅºÚ"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00F5F5F5&
      Height          =   300
      Left            =   0
      TabIndex        =   0
      Top             =   240
      Width           =   1530
   End
   Begin VB.Shape shpBrd
      BorderColor     =   &H00D27800&
      Height          =   735
      Left            =   0
      Top             =   0
      Width           =   1575
   End
End
Attribute VB_Name = "ucBtn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Dim IsDft As Boolean
Event Click()

Private Sub lblCap_Click()
    RaiseEvent Click
End Sub

Private Sub lblCap_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    UserControl_MouseDown Button, Shift, X, Y
End Sub

Private Sub lblCap_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    UserControl_MouseUp Button, Shift, X, Y
End Sub

Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_Initialize()
    With UserControl
        If IsDft = False Then
            .BackColor = &HF5F5F5
            shpBrd.BorderColor = &HC0C0C0
            lblCap.ForeColor = &H808080
        Else
            .BackColor = &HFA8C5A
            shpBrd.BorderColor = &HD27800
            lblCap.ForeColor = &HF5F5F5
        End If
    End With
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    UserControl.BackColor = shpBrd.BorderColor
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With UserControl
        If IsDft = False Then
            .BackColor = &HF5F5F5
        Else
            .BackColor = &HFA8C5A
        End If
    End With
End Sub

Private Sub UserControl_Resize()
    shpBrd.Move 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight
    lblCap.Move 0, (UserControl.ScaleHeight - lblCap.Height) / 2, UserControl.ScaleWidth
End Sub

Public Property Get Caption() As String
    Caption = lblCap.Caption
End Property

Public Property Let Caption(ByVal nCap As String)
    PropertyChanged "Caption"
    lblCap.Caption = nCap
End Property

Public Property Get Default() As Boolean
    Default = IsDft
End Property

Public Property Let Default(ByVal nDft As Boolean)
    PropertyChanged "Default"
    IsDft = nDft
    UserControl_Initialize
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    lblCap.Caption = PropBag.ReadProperty("Caption", "Button")
    IsDft = PropBag.ReadProperty("Default", False)
    UserControl_Initialize
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Caption", lblCap.Caption
    PropBag.WriteProperty "Default", IsDft
End Sub