?? mybutton.ctl
字號(hào):
m_TextAlign = m_def_TextAlign
End Sub
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
If KeyCode = vbKeySpace Then
m_SpcDown = True
DrawButton BTN_DOWN
Else
m_SpcDown = False
DrawButton BTN_FOCUS
End If
End Sub
Private Sub UserControl_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
If KeyAscii = vbKeyReturn Then
RaiseEvent Click
End If
End Sub
Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
If KeyCode = 32 And m_SpcDown And m_State = BTN_DOWN Then
m_SpcDown = False
DrawButton BTN_NORMAL
RaiseEvent Click
DrawButton BTN_FOCUS
End If
End Sub
Private Sub UserControl_LostFocus()
m_HasFocus = False
DrawButton BTN_NORMAL
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
If Button = 1 Then m_BtnDown = True
UserControl_MouseMove Button, Shift, X, Y
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If m_SpcDown Then Exit Sub
RaiseEvent MouseMove(Button, Shift, X, Y)
SetCapture hWnd
If PointInControl(X, Y) Then
'if pointer is on control
If m_BtnDown Then
If m_State <> BTN_DOWN Then
DrawButton BTN_DOWN
End If
Else
If m_State <> BTN_HOVER Then
RaiseEvent MouseHover
DrawButton BTN_HOVER
End If
End If
Else
'if pointer is out of control
If m_BtnDown Then
RaiseEvent MouseHover
DrawButton BTN_HOVER
Else
RaiseEvent MouseOut
If m_HasFocus Then
DrawButton BTN_FOCUS
Else
DrawButton BTN_NORMAL
End If
ReleaseCapture
End If
End If
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
m_BtnDown = False
' If m_State <> BTN_NORMAL Then
DrawButton BTN_NORMAL
' End If
RaiseEvent MouseUp(Button, Shift, X, Y)
If Button = vbLeftButton Then
If PointInControl(X, Y) Then RaiseEvent Click
' If m_State <> BTN_FOCUS Then
DrawButton BTN_FOCUS
' End If
End If
End Sub
Private Sub UserControl_Paint()
Me.Refresh
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_SizeCW = PropBag.ReadProperty("SizeCW", m_def_SizeCW)
m_SizeCH = PropBag.ReadProperty("SizeCH", m_def_SizeCH)
m_SkinPictureName = PropBag.ReadProperty("SPN", "")
'Debug.Print "ReadProp SPN:"; m_SkinPictureName
m_Text = PropBag.ReadProperty("Text", m_def_Text)
m_FillWithColor = PropBag.ReadProperty("FillWithColor", m_def_FillWithColor)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
UserControl.AccessKeys = PropBag.ReadProperty("AccessKey", "")
m_TextColorEnabled = PropBag.ReadProperty("TextColorEnabled", m_def_TextColorEnabled)
m_TextColorDisabled = PropBag.ReadProperty("TextColorDisabled", m_def_TextColorDisabled)
Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)
Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
m_DisableHover = PropBag.ReadProperty("DisableHover", m_def_DisableHover)
' m_DownTextDX = PropBag.ReadProperty("DownTextDX", m_def_DownTextDX)
' m_DownTextDY = PropBag.ReadProperty("DownTextDY", m_def_DownTextDY)
m_DisplaceText = PropBag.ReadProperty("DisplaceText", m_def_DisplaceText)
m_DrawFocus = PropBag.ReadProperty("DrawFocus", m_def_DrawFocus)
m_TextColorDisabled2 = PropBag.ReadProperty("TextColorDisabled2", m_def_TextColorDisabled2)
Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
m_PicturePos = PropBag.ReadProperty("PicturePos", m_def_PicturePos)
m_PictureTColor = PropBag.ReadProperty("PictureTColor", m_def_PictureTColor)
m_TextAlign = PropBag.ReadProperty("TextAlign", m_def_TextAlign)
UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
End Sub
Private Sub UserControl_Resize()
Refresh
End Sub
Private Sub UserControl_Show()
SkinPictureName = m_SkinPictureName
' Refresh
End Sub
Private Sub UserControl_Terminate()
Set m_SkinPicture = Nothing
Set m_Picture = Nothing
'Set UserControl = Nothing
'Set Me = Nothing
'Debug.Print "TERMINATE"
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("SizeCW", m_SizeCW, m_def_SizeCW)
Call PropBag.WriteProperty("SizeCH", m_SizeCH, m_def_SizeCH)
'If m_SkinPicture Is Nothing = False Then
Call PropBag.WriteProperty("SPN", m_SkinPictureName, "")
'End If
'Debug.Print "Write :"; m_SkinPictureName
Call PropBag.WriteProperty("Text", m_Text, m_def_Text)
Call PropBag.WriteProperty("FillWithColor", m_FillWithColor, m_def_FillWithColor)
Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
Call PropBag.WriteProperty("AccessKey", UserControl.AccessKeys, "")
Call PropBag.WriteProperty("TextColorEnabled", m_TextColorEnabled, m_def_TextColorEnabled)
Call PropBag.WriteProperty("TextColorDisabled", m_TextColorDisabled, m_def_TextColorDisabled)
Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 0)
Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
Call PropBag.WriteProperty("DisableHover", m_DisableHover, m_def_DisableHover)
Call PropBag.WriteProperty("DisplaceText", m_DisplaceText, m_def_DisplaceText)
Call PropBag.WriteProperty("DrawFocus", m_DrawFocus, m_def_DrawFocus)
Call PropBag.WriteProperty("TextColorDisabled2", m_TextColorDisabled2, m_def_TextColorDisabled2)
Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
Call PropBag.WriteProperty("PicturePos", m_PicturePos, m_def_PicturePos)
Call PropBag.WriteProperty("PictureTColor", m_PictureTColor, m_def_PictureTColor)
Call PropBag.WriteProperty("TextAlign", m_TextAlign, m_def_TextAlign)
Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
End Sub
Private Sub DrawButton(ByVal State As Integer)
If m_DisableHover Then
If State = BTN_HOVER Then Exit Sub
'dont draw hover state if m_DisableHover is true
End If
' Debug.Print "State1 "; State
On Error GoTo UnknownError
Dim PicW As Long
Dim PicH As Long 'width and height of picture
Dim PicX As Long
Dim PicY As Long 'picture pos
Dim DH As Long 'button height
Dim dw As Long 'button width
Dim Align As Long 'text aligment
Dim bDrawText As Boolean ' if picture is in center text is not drawn
bDrawText = True
Align = DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS
Select Case m_TextAlign
Case Is = vbLeftJustify: Align = Align Or DT_LEFT
Case Is = vbRightJustify: Align = Align Or DT_RIGHT
Case Is = vbCenter: Align = Align Or DT_CENTER
End Select
dw = UserControl.ScaleWidth
DH = UserControl.ScaleHeight
m_State = State
'if skin picture is not set then just draw text on control
If m_SkinPicture Is Nothing Then
ClearRect hDC, SetRect(0, 0, dw, DH), TranslateColor(UserControl.BackColor)
DrawText hDC, m_Text, SetRect(0, 0, dw, DH), Align
If UserControl.AutoRedraw = True Then
UserControl.Refresh
End If
Exit Sub
End If
m_SkinPicture.ScaleMode = vbPixels
Dim SrcLeft As Long 'left cordinate of skin in skinpicture
Dim SrcRight As Long 'right -II-
Dim FillColor As Long 'color to fill middle area of button
'used if m_FillWithColor is true
Dim H As Long 'height of skinpicture
Dim W As Long 'width of button skin
H = m_SkinPicture.ScaleHeight
W = m_SkinPicture.ScaleWidth / 5
'Debug.Print H, W
'
SrcLeft = (State - 1) * W
SrcRight = State * W
If m_FillWithColor Then
'get color to fill with from (SrcLeft+m_SizeCW +1 , m_SizeCH+1) on
'skin picture
FillColor = m_SkinPicture.Point(SrcLeft + m_SizeCW + 1, m_SizeCH + 1)
End If
'Exit Sub
ClearRect hDC, SetRect(0, 0, dw, DH), TranslateColor(UserControl.BackColor)
If m_FillWithColor Then
'paint button with fillcolor
'NOTE: it would be nice if there is gradient file
ClearRect hDC, SetRect(m_SizeCW, m_SizeCH, dw - m_SizeCW, DH - m_SizeCH), FillColor
'ABOUT ADDING GRADIENT FILL
'read second color from skin at
'point (srcleft+cw+1, H -m_sizeCH-1)
'may be implemented in MyButton2
Else
'tile skin
TilePicture SetRect(m_SizeCW, m_SizeCH, dw - m_SizeCW, DH - m_SizeCH), _
SetRect(SrcLeft + m_SizeCW, m_SizeCH, SrcRight - m_SizeCW, H - m_SizeCH), _
m_SkinPicture.hDC, False, SRCCOPY
End If
'draws borders
If (m_SizeCH > 0 And m_SizeCW > 0) Then
TilePicture SetRect(m_SizeCW, 0, dw, m_SizeCH), _
SetRect(SrcLeft + m_SizeCW, 0, SrcRight - m_SizeCW, m_SizeCH), _
m_SkinPicture.hDC, False, SRCCOPY
TilePicture SetRect(m_SizeCW, DH - m_SizeCH, dw, DH), _
SetRect(SrcLeft + m_SizeCW, H - m_SizeCH, SrcRight - m_SizeCW, H), _
m_SkinPicture.hDC, False, SRCCOPY
TilePicture SetRect(0, 0, m_SizeCW, DH), _
SetRect(SrcLeft, m_SizeCH, SrcLeft + m_SizeCW, H - m_SizeCH), _
m_SkinPicture.hDC, False, SRCCOPY
TilePicture SetRect(dw - m_SizeCW, m_SizeCH, dw, DH - m_SizeCH), _
SetRect(SrcRight - m_SizeCW, m_SizeCH, SrcRight, H - m_SizeCH), _
m_SkinPicture.hDC, False, SRCCOPY
'draws corners
'NOTE: must chage to transparent blit (done)
TransBlt hDC, 0, 0, m_SizeCW, m_SizeCH, m_SkinPicture.hDC, SrcLeft, 0, &HFF00FF
TransBlt hDC, 0, DH - m_SizeCH, m_SizeCW, m_SizeCH, m_SkinPicture.hDC, SrcLeft, H - m_SizeCH, &HFF00FF
TransBlt hDC, dw - m_SizeCW, 0, m_SizeCW, m_SizeCH, m_SkinPicture.hDC, SrcRight - m_SizeCW, 0, &HFF00FF
TransBlt hDC, dw - m_SizeCW, DH - m_SizeCH, m_SizeCW, m_SizeCH, m_SkinPicture.hDC, SrcRight - m_SizeCW, H - m_SizeCH, &HFF00FF
End If
Dim PColor As Long 'previous color
PColor = UserControl.ForeColor
Dim TextRect As RECT
If State = BTN_DOWN Then
TextRect = SetRect(m_SizeCW + m_DisplaceText, m_SizeCH + m_DisplaceText, dw - m_SizeCW + m_DisplaceText - 3, DH - m_SizeCH + m_DisplaceText)
Else
TextRect = SetRect(m_SizeCW, m_SizeCH, dw - m_SizeCW - 3, DH - m_SizeCH)
End If
If m_Picture Is Nothing Then
If m_State = BTN_DISABLED Then
'draw text only
'dont draw text2 if colors are the same
If m_TextColorDisabled <> m_TextColorDisabled2 Then
UserControl.ForeColor = m_TextColorDisabled2
TextRect = ModifyRect(TextRect, 1, 1, 1, 1)
DrawText hDC, m_Text, TextRect, Align
TextRect = ModifyRect(TextRect, -1, -1, -1, -1)
End If
UserControl.ForeColor = m_TextColorDisabled
DrawText hDC, m_Text, TextRect, Align
Else
'draw text only
UserControl.ForeColor = m_TextColorEnabled
DrawText hDC, m_Text, TextRect, Align
End If
Else
GetBmpSize m_Picture, PicW, PicH
PicY = (DH - PicH) / 2
If m_State = BTN_DOWN Then
PicY = PicY + m_DisplaceText
End If
Select Case m_PicturePos
Case Is = ppLeft
PicX = TextRect.Left + 3
TextRect.Left = PicX + PicW + TextRect.Left
Case Is = ppRight
PicX = TextRect.Right - PicW - 3 + TextRect.Left - m_SizeCW
TextRect.Right = PicX - 3
Case Is = ppTop
PicX = (dw - PicW) / 2 + TextRect.Left - SizeCW
PicY = (DH - PicH - 3 - UserControl.TextHeight("I")) / 2 + TextRect.Top - SizeCH
TextRect.Top = PicY + PicW + 3
TextRect.Bottom = TextRect.Top + UserControl.TextHeight("I") * 1.2
Case Is = ppBottom
TextRect.Top = (DH - PicH - 3 - UserControl.TextHeight("I")) / 2 + TextRect.Top - SizeCH
PicX = (dw - PicW) / 2 + TextRect.Left - SizeCW
TextRect.Bottom = TextRect.Top + UserControl.TextHeight("I") * 1.2
PicY = TextRect.Bottom + 3
Case Is = ppCenter
PicX = (dw - PicW) / 2
If BTN_DOWN Then PicX = PicX + m_DisplaceText
bDrawText = False
End Select
' Debug.Print "State2 "; State
If m_State = BTN_DISABLED Then
'draw text and picture disabled
DrawPictureDisabled m_Picture, PicX, PicY, PicW, PicH
If m_TextColorDisabled <> m_TextColorDisabled2 Then
If bDrawText Then
UserControl.ForeColor = m_TextColorDisabled2
TextRect = ModifyRect(TextRect, 1, 1, 1, 1)
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -