3D-кнопка - Интерфейс - Интересные решения для программистов - Примеры кода

Интерфейс → 3D-кнопка → Visual Basic

Простой пример, как можно создать свою 3D-кнопку из PictureBox.

' ВНИМАНИЕ: Разместите на форме 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

3d, button, picturebox, vb, visual basic

KOS_MOS

Алексей

19.10.2008

Меню

Подписка на RSS:

Подпишись на RSS-ленту

Поиск

Облако тегов

	Интерфейс → 3D-кнопка → Visual Basic Простой пример, как можно создать свою 3D-кнопку из PictureBox. ' ВНИМАНИЕ: Разместите на форме 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 3d, button, picturebox, vb, visual basic KOS_MOS Алексей 19.10.2008 Ваше имя Ваш E-mail (если хотите отслеживать комментарии) Дoкажи, что ты не робот Текст комментария	Меню CodeIgniter Алгоритмы Базы данных Дата и Время Интернет Интерфейс Мультимедиа ОС и Железо Работа с текстом Разное Технологии Файлы Подписка на RSS: Подпишись на RSS-ленту Поиск Облако тегов .net array asp bash browser charset check class clean convert count create css curl database date delete directory download element email equivalent extension file find form format function get height html http ie image javascript jquery load mysql number page perl php random scriplet send shell size sql string text time url utf8 variable vb visual basic width window xml xslt