| |
Создайте свой 3D-Button |
|
| |
Добавьте элемент PictureBox на форму
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const BDR_RAISEDOUTER = &H1
Const BDR_SUNKENOUTER = &H2
Const BDR_RAISEDINNER = &H4
Const BDR_SUNKENINNER = &H8
Const BDR_OUTER = &H3
Const BDR_INNER = &HC
Const BDR_RAISED = &H5
Const BDR_SUNKEN = &HA
Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Const BF_LEFT = &H1
Const BF_TOP = &H2
Const BF_RIGHT = &H4
Const BF_BOTTOM = &H8
Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Const BF_DIAGONAL = &H10
Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)
Const BF_MIDDLE = &H800 ' Fill in the middle
Const BF_SOFT = &H1000 ' For softer buttons
Const BF_ADJUST = &H2000 ' Calculate the space left over
Const BF_FLAT = &H4000 ' For flat rather than 3D borders
Const BF_MONO = &H8000 ' For monochrome borders
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT,
ByVal edge As Long, ByVal grfFlags As Long) As Boolean
Private Sub Form_Load()
' Always set the ScaleMode to pixels when using API drawing functions.
ScaleMode = vbPixels
With Picture1
' The next line is not required if you put your drawing code in the Paint event.
.AutoRedraw = True
' Set the Backcolor, set the Borderstyle to none, and size the picture box to a more
realistic button size.
.BackColor = vb3DFace
.BorderStyle = 0
.Move 60, 10, 90, 30
' Make sure the picture box uses the pixel ScaleMode, and set the tag of the control to a
caption for later use with DrawControl.
.ScaleMode = vbPixels
.Tag = "3D Button"
End With
' Draw the initial button.
DrawControl Picture1, Picture1.Tag, EDGE_RAISED
End Sub
' When the picture box gets a click event, an etched box is drawn on the upper left corner
of the form.
Private Sub Picture1_Click()
MsgBox "You Pressed the Button"
End Sub
' When the user presses the mouse down on the picture box a sunken edge is drawn to
simulate a depresessed button.
Private Sub Picture1_MouseDown(Button%, Shift%, X!, Y!)
DrawControl Picture1, Picture1.Tag, EDGE_SUNKEN
End Sub
' When the user releases the mouse over the picture box a standard button is drawn.
Private Sub Picture1_MouseUp(Button%, Shift%, X!, Y!)
DrawControl Picture1, Picture1.Tag, EDGE_RAISED
End Sub
' The DrawControl helper function is designed to make it easier to draw a button on a
picture box.
Private Sub DrawControl(picControl As PictureBox, strCaption As String, Optional vntEdge)
Dim r As RECT ' Holds the location of the DrawEdge rectangle.
Dim intOffset% ' Used to shift the caption when the button is pressed.
' If the user doesn't provide a Edge flag, then use a default value.
vntEdge = IIf(IsMissing(vntEdge), EDGE_RAISED, vntEdge)
' Clear the picture control and determine where to draw the new rectangle and caption.
With picControl
.Cls
r.Left = .ScaleLeft
r.Top = .ScaleTop
r.Right = .ScaleWidth
r.Bottom = .ScaleHeight
If vntEdge = EDGE_SUNKEN Then intOffset = 2
.CurrentX = (.ScaleWidth - .TextWidth(strCaption) + intOffset) / 2
.CurrentY = (.ScaleHeight - .TextHeight(strCaption) + intOffset) / 2
End With
' Draw the caption, then draw the rectangle.
Picture1.Print strCaption
DrawEdge picControl.hdc, r, CLng(vntEdge), BF_RECT
' If AutoRedraw is True, then any drawing done by an API call cannot be seen until until
the picture box gets refreshed.
If picControl.AutoRedraw Then picControl.Refresh
End Sub
|
|
| |
|
|
|
|