home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Video_Capt1933119162005.psc / CAPTURE / ButtonMod.bas next >
BASIC Source File  |  2005-11-14  |  10KB  |  204 lines
  1. Attribute VB_Name = "ButtonMod"
  2. Option Explicit
  3. 'Cteated By Joko Mulyono
  4. 'Email:dantex_765@hotmail.com
  5. Public Type TYPERECT
  6.     Left                             As Long
  7.     Top                              As Long
  8.     Right                            As Long
  9.     Bottom                           As Long
  10. End Type
  11. Public Enum Appearance
  12.     Flat = 0
  13.     HalfRaised = 1
  14.     Raised = 2
  15.     Sunken = 3
  16.     Etched = 4
  17.     Bump = 5
  18.     Line = 6
  19.     Push = 7
  20.     PushDown = 8
  21. End Enum
  22. #If False Then
  23. Private Flat, HalfRaised, Raised, Sunken, Etched, Bump, Line, Push, PushDown
  24. #End If
  25. Private Const BDR_RAISEDOUTER    As Long = &H1
  26. Private Const BDR_SUNKENOUTER    As Long = &H2
  27. Private Const BDR_RAISEDINNER    As Long = &H4
  28. Private Const BDR_SUNKENINNER    As Long = &H8
  29. Private Const EDGE_RAISED        As Double = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
  30. Private Const EDGE_ETCHED        As Double = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
  31. Private Const EDGE_BUMP          As Double = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
  32. Private Const BF_LEFT            As Long = &H1
  33. Private Const BF_TOP             As Long = &H2
  34. Private Const BF_RIGHT           As Long = &H4
  35. Private Const BF_BOTTOM          As Long = &H8
  36. Private Const BF_FLAT            As Long = &H4000
  37. Private Const BF_RECT            As Double = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  38. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, _
  39.                                                 qrc As TYPERECT, _
  40.                                                 ByVal edge As Long, _
  41.                                                 ByVal grfFlags As Long) As Boolean
  42.  
  43. Public Sub PaintControl(picBox As PictureBox, _
  44.                         Tampilan As Appearance, _
  45.                         Optional ByVal prov_BackColor As Long, _
  46.                         Optional ByVal prov_ForeColor As Long, _
  47.                         Optional ByVal sCaption As String, _
  48.                         Optional ByVal PDown As Boolean)
  49.  
  50.  
  51. Dim typRect As TYPERECT
  52. Dim origScaleMode As Integer
  53. On Error Resume Next
  54.     With picBox
  55.         .BorderStyle = 0
  56.         .ScaleMode = vbPixels
  57.         .AutoRedraw = True
  58.         .Cls
  59.         .BackColor = prov_BackColor
  60.         .ForeColor = prov_ForeColor
  61.     End With 'picBox
  62.     With typRect
  63.         .Right = picBox.ScaleWidth
  64.         .Top = picBox.ScaleTop
  65.         .Left = picBox.ScaleLeft     '    .Top = picBox.ScaleWidth
  66.         .Bottom = picBox.ScaleHeight
  67.     End With 'TYPRECT
  68.     Select Case Tampilan 'm_Appearance
  69.     Case 0
  70.         DrawEdge picBox.hdc, typRect, EDGE_BUMP, BF_FLAT ' BF_FLAT
  71.     Case 1 'HalfRaised
  72.         DrawEdge picBox.hdc, typRect, BDR_RAISEDINNER, BF_RECT 'HalfRaised
  73.     Case 2 'Raised
  74.         With picBox
  75.             DrawEdge .hdc, typRect, EDGE_RAISED, BF_RECT
  76.         End With 'picBox
  77.     Case 3 'sunken
  78.         DrawEdge picBox.hdc, typRect, BDR_SUNKENOUTER, BF_RECT
  79.     Case 4 'etched
  80.         DrawEdge picBox.hdc, typRect, EDGE_ETCHED, BF_RECT
  81.     Case 5 'Bump
  82.         DrawEdge picBox.hdc, typRect, EDGE_BUMP, BF_RECT
  83.     Case 7
  84.         xPush picBox
  85.     Case 8
  86.         xPushDown picBox
  87.     End Select
  88.     picBox.ScaleMode = origScaleMode
  89.     If PDown Then
  90.         picBox.CurrentX = ((picBox.ScaleWidth - picBox.TextWidth(sCaption)) / 2) + 1
  91.         picBox.CurrentY = ((picBox.ScaleHeight - picBox.TextHeight(sCaption)) / 2) + 1
  92.     Else 'PDOWN = FALSE/0
  93.         picBox.CurrentX = (picBox.ScaleWidth - picBox.TextWidth(sCaption)) / 2
  94.         picBox.CurrentY = (picBox.ScaleHeight - picBox.TextHeight(sCaption)) / 2
  95.     End If
  96.     picBox.Print sCaption
  97.     If picBox.AutoRedraw Then
  98.         picBox.Refresh
  99.     End If
  100.     On Error GoTo 0
  101.  
  102. End Sub
  103.  
  104. Private Sub xPush(picBox As PictureBox)
  105.  
  106.     With picBox
  107.         'Right
  108.         picBox.Line (picBox.ScaleWidth - 1, picBox.ScaleHeight)-(picBox.ScaleWidth - 1, 0), RGB(170, 175, 179) ' RGB(48, 49, 51)'Right
  109.         picBox.Line (picBox.ScaleWidth - 2, picBox.ScaleHeight - 1)-(picBox.ScaleWidth - 2, 1), RGB(48, 49, 51) ' RGB(48, 49, 51)'Right2
  110.         picBox.Line (picBox.ScaleWidth - 3, picBox.ScaleHeight - 2)-(picBox.ScaleWidth - 3, 2), RGB(87, 91, 93) ' RGB(48, 49, 51)'Right3
  111.         'Left
  112.         picBox.Line (0, 0)-(0, picBox.ScaleHeight), RGB(75, 80, 84)
  113.         'vb3DShadow ' bottomleft ' vbButtonFace 'Left1
  114.         picBox.Line (1, 1)-(1, picBox.ScaleHeight - 1), RGB(48, 49, 51)
  115.         'vb3DShadow ' bottomleft ' vbButtonFace 'left2
  116.         picBox.Line (2, 2)-(2, picBox.ScaleHeight - 2), RGB(203, 206, 208)
  117.         'vb3DShadow ' bottomleft ' vbButtonFace 'left3
  118.         'Bottom
  119.         picBox.Line (0, picBox.ScaleHeight - 1)-(picBox.ScaleWidth - 1, picBox.ScaleHeight - 1), RGB(170, 175, 179)  'Bottom
  120.         picBox.Line (1, picBox.ScaleHeight - 2)-(picBox.ScaleWidth - 2, picBox.ScaleHeight - 2), RGB(48, 49, 51) 'RGB(87, 91, 93)  'Bottom
  121.         picBox.Line (2, picBox.ScaleHeight - 3)-(picBox.ScaleWidth - 3, picBox.ScaleHeight - 3), RGB(87, 91, 93) 'RGB(87, 91, 93)  'Bottom
  122.         'top
  123.         picBox.Line (0, 0)-(picBox.ScaleWidth, 0), RGB(75, 80, 84) 'RGB(87, 91, 93) 'top side
  124.         picBox.Line (1, 1)-(picBox.ScaleWidth - 1, 1), RGB(48, 49, 51) 'RGB(87, 91, 93) 'top side
  125.         picBox.Line (2, 2)-(picBox.ScaleWidth - 2, 2), RGB(203, 206, 208)
  126.         'RGB(87, 91, 93) 'top side
  127.         'Edge top left 1
  128.         picBox.Line (0, 0)-(1, 0), RGB(98, 103, 107)
  129.         'Edge top left 2
  130.         picBox.Line (2, 2)-(2, 1), RGB(234, 235, 236)
  131.         picBox.Line (0, picBox.ScaleHeight - 1)-(0, picBox.ScaleHeight), RGB(129, 134, 138)
  132.         picBox.Line (0, picBox.ScaleHeight - 2)-(0, picBox.ScaleHeight - 1), RGB(109, 114, 118)
  133.         picBox.Line (1, picBox.ScaleHeight - 1)-(2, picBox.ScaleHeight), RGB(141, 146, 150)
  134.         picBox.Line (2, picBox.ScaleHeight - 3)-(2, picBox.ScaleHeight - 2), RGB(135, 140, 144)
  135.         'Edge top Right 1
  136.         picBox.Line (picBox.ScaleWidth - 1, 0)-(picBox.ScaleWidth, 0), RGB(129, 134, 138)
  137.         'Edge top Right 2
  138.         picBox.Line (picBox.ScaleWidth - 2, 0)-(picBox.ScaleWidth - 1, 0), RGB(109, 114, 118)
  139.         picBox.Line (picBox.ScaleWidth - 3, 2)-(picBox.ScaleWidth - 3, 3), RGB(135, 140, 144)
  140.         picBox.Line (picBox.ScaleWidth - 1, 1)-(picBox.ScaleWidth - 1, 2), RGB(141, 146, 150)
  141.         'Edge Bottom right
  142.         picBox.Line (picBox.ScaleWidth - 1, picBox.ScaleHeight)-(picBox.ScaleWidth - 1, picBox.ScaleHeight - 2), RGB(169, 174, 178)
  143.         picBox.Line (picBox.ScaleWidth - 1, picBox.ScaleHeight - 2)-(picBox.ScaleWidth - 1, picBox.ScaleHeight - 3), RGB(181, 186, 190)
  144.         picBox.Line (picBox.ScaleWidth - 2, picBox.ScaleHeight)-(picBox.ScaleWidth - 2, picBox.ScaleHeight - 2), RGB(181, 186, 190)
  145.         picBox.Line (picBox.ScaleWidth - 3, picBox.ScaleHeight - 3)-(picBox.ScaleWidth - 3, picBox.ScaleHeight - 2), RGB(72, 75, 77)
  146.     End With 'PICBOX
  147.  
  148. End Sub
  149.  
  150. Private Sub xPushDown(picBox As PictureBox)
  151.  
  152.     With picBox
  153.         'Right
  154.         picBox.Line (picBox.ScaleWidth - 1, picBox.ScaleHeight)-(picBox.ScaleWidth - 1, 0), RGB(170, 175, 179) ' 'Right
  155.         picBox.Line (picBox.ScaleWidth - 2, picBox.ScaleHeight - 1)-(picBox.ScaleWidth - 2, 1), RGB(48, 49, 51) ' 'Right2
  156.         picBox.Line (picBox.ScaleWidth - 3, picBox.ScaleHeight - 2)-(picBox.ScaleWidth - 3, 2), RGB(203, 206, 208) ' 'Right3
  157.         'Left
  158.         picBox.Line (0, 0)-(0, picBox.ScaleHeight), RGB(75, 80, 84)
  159.         'vb3DShadow ' bottomleft ' vbButtonFace 'Left1
  160.         picBox.Line (1, 1)-(1, picBox.ScaleHeight - 1), RGB(48, 49, 51)
  161.         'vb3DShadow ' bottomleft ' vbButtonFace 'left2
  162.         picBox.Line (2, 2)-(2, picBox.ScaleHeight - 2), RGB(87, 91, 93)
  163.         'vb3DShadow ' bottomleft ' vbButtonFace 'left3
  164.         'Bottom
  165.         picBox.Line (0, picBox.ScaleHeight - 1)-(picBox.ScaleWidth - 1, picBox.ScaleHeight - 1), RGB(170, 175, 179)  'Bottom
  166.         picBox.Line (1, picBox.ScaleHeight - 2)-(picBox.ScaleWidth - 2, picBox.ScaleHeight - 2), RGB(48, 49, 51) 'Bottom
  167.         picBox.Line (2, picBox.ScaleHeight - 3)-(picBox.ScaleWidth - 3, picBox.ScaleHeight - 3), RGB(203, 206, 208) 'Bottom 3
  168.         'top
  169.         picBox.Line (0, 0)-(picBox.ScaleWidth, 0), RGB(75, 80, 84) 'RGB(87, 91, 93) 'top side
  170.         picBox.Line (1, 1)-(picBox.ScaleWidth - 1, 1), RGB(48, 49, 51) 'RGB(87, 91, 93) 'top side
  171.         picBox.Line (2, 2)-(picBox.ScaleWidth - 2, 2), RGB(87, 91, 93)  'RGB(87, 91, 93) 'top side
  172.         'Edge top left 1
  173.         picBox.Line (0, 0)-(1, 0), RGB(98, 103, 107)
  174.         'Edge top left 2
  175.         picBox.Line (2, 2)-(2, 1), RGB(72, 75, 77)
  176.         picBox.Line (0, picBox.ScaleHeight - 1)-(0, picBox.ScaleHeight), RGB(129, 134, 138)
  177.         picBox.Line (0, picBox.ScaleHeight - 2)-(0, picBox.ScaleHeight - 1), RGB(109, 114, 118)
  178.         picBox.Line (1, picBox.ScaleHeight - 1)-(2, picBox.ScaleHeight), RGB(141, 146, 150)
  179.         picBox.Line (2, picBox.ScaleHeight - 3)-(2, picBox.ScaleHeight - 2), RGB(135, 140, 144)
  180.         'Edge top Right 1
  181.         picBox.Line (picBox.ScaleWidth - 1, 0)-(picBox.ScaleWidth, 0), RGB(129, 134, 138)
  182.         'Edge top Right 2
  183.         picBox.Line (picBox.ScaleWidth - 2, 0)-(picBox.ScaleWidth - 1, 0), RGB(109, 114, 118)
  184.         picBox.Line (picBox.ScaleWidth - 3, 2)-(picBox.ScaleWidth - 3, 3), RGB(135, 140, 144)
  185.         picBox.Line (picBox.ScaleWidth - 1, 1)-(picBox.ScaleWidth - 1, 2), RGB(141, 146, 150)
  186.         'Edge Bottom right
  187.         picBox.Line (picBox.ScaleWidth - 1, picBox.ScaleHeight)-(picBox.ScaleWidth - 1, picBox.ScaleHeight - 2), RGB(169, 174, 178)
  188.         picBox.Line (picBox.ScaleWidth - 1, picBox.ScaleHeight - 2)-(picBox.ScaleWidth - 1, picBox.ScaleHeight - 3), RGB(181, 186, 190)
  189.         picBox.Line (picBox.ScaleWidth - 2, picBox.ScaleHeight)-(picBox.ScaleWidth - 2, picBox.ScaleHeight - 2), RGB(181, 186, 190)
  190.         picBox.Line (picBox.ScaleWidth - 3, picBox.ScaleHeight - 3)-(picBox.ScaleWidth - 3, picBox.ScaleHeight - 2), RGB(234, 235, 236) 'RGB(72, 75, 77)
  191.     End With 'PICBOX
  192.  
  193. End Sub
  194. 'Public Sub Sleep(ByVal Seconds As Double)
  195. 'Dim TempTime As Double
  196. 'TempTime = Timer
  197. 'Do While Timer - TempTime < Seconds
  198. 'DoEvents
  199. 'If Timer < TempTime Then
  200. 'TempTime = TempTime - 24# * 3600#
  201. 'End If
  202. 'Loop
  203. 'End Sub
  204.