home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Quiz_Softw2029431162006.psc / ChoiceButton.ctl < prev    next >
Text File  |  2006-11-04  |  7KB  |  178 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ChoiceButton 
  3.    BackStyle       =   0  'Transparent
  4.    ClientHeight    =   345
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   375
  8.    MaskColor       =   &H00000000&
  9.    MousePointer    =   99  'Custom
  10.    ScaleHeight     =   23
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   25
  13. End
  14. Attribute VB_Name = "ChoiceButton"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = True
  17. Attribute VB_PredeclaredId = False
  18. Attribute VB_Exposed = False
  19. Option Explicit
  20.  
  21. Private Const WM_KEYDOWN As Long = &H100
  22.  
  23. Private Type BITMAP         ' The BITMAP structure defines the type, width, height, color format, and bit values of a bitmap.
  24.     bmType As Long          ' Specifies the bitmap type. This member must be zero.
  25.     bmWidth As Long         ' Specifies the width, in pixels, of the bitmap. The width must be greater than zero.
  26.     bmHeight As Long        ' Specifies the height, in pixels, of the bitmap. The height must be greater than zero.
  27.     bmWidthBytes As Long    ' Specifies the number of bytes in each scan line. This value must be divisible by 2,
  28.                             '   because the system assumes that the bit values of a bitmap form an array that is word aligned.
  29.     bmPlanes As Integer     ' Specifies the count of color planes.
  30.     bmBitsPixel As Integer  ' Specifies the number of bits required to indicate the color of a pixel.
  31.     bmBits As Long          ' Pointer to the location of the bit values for the bitmap. The bmBits member must be a long pointer
  32.                             '   to an array of character (1-byte) values.
  33. End Type
  34.  
  35. '  The GetObject function retrieves information for the specified graphics object.
  36. Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  37. '  The PostMessage function places (posts) a message in the message queue associated with the thread that created the specified window and then returns without waiting for the thread to process the message.
  38. ' Messages in a message queue are retrieved by calls to the GetMessage or PeekMessage function.
  39. Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  40.  
  41. Private Const resOffsetButtonUp = 101           ' Button Up
  42. Private Const resOffsetButtonDn = 105           ' Button Down
  43. Private Const resOffsetButtonUpFocus = 109      ' Button Up Focus
  44. Private Const resOffsetButtonDnFocus = 113      ' Button Down Focus
  45. Private Const resMaskButtonUp = 120
  46. Private Const resMaskButtonDn = 121
  47.  
  48. Public Enum SelectionConstant
  49.     cb_A    ' Button A
  50.     cb_B    ' Button B
  51.     cb_C    ' Button C
  52.     cb_D    ' Button D
  53.     cb_E
  54. End Enum
  55.  
  56. Private Type cbProperties
  57.     cbSelection As SelectionConstant
  58.     cbPress As Boolean
  59. End Type
  60.  
  61. Dim IsFocus As Boolean
  62. Dim MyProp As cbProperties
  63. Dim bW As Integer, bH As Integer
  64.  
  65. Event Click()
  66.  
  67. Public Property Get Selection() As SelectionConstant
  68.     Selection = MyProp.cbSelection
  69. End Property
  70.  
  71. Public Property Let Selection(cbSelection As SelectionConstant)
  72.     If cbSelection <> MyProp.cbSelection Then
  73.         MyProp.cbSelection = cbSelection
  74.         PropertyChanged "Selection"
  75.         RedrawButton
  76.     End If
  77. End Property
  78.  
  79. Public Property Get Press() As Boolean
  80.     Press = MyProp.cbPress
  81. End Property
  82.  
  83. Public Property Let Press(cbPress As Boolean)
  84.     If cbPress <> MyProp.cbPress Then
  85.         MyProp.cbPress = cbPress
  86.         PropertyChanged "Press"
  87.         RedrawButton
  88.     End If
  89. End Property
  90.  
  91. Private Sub UserControl_Click()
  92.     Press = Not Press
  93.     RaiseEvent Click
  94. End Sub
  95.  
  96. Private Sub UserControl_ExitFocus()
  97.     Dim TempValue As Integer
  98.     
  99.     If IsFocus Then
  100.         IsFocus = False
  101.         TempValue = IIf(Press, resOffsetButtonDn, resOffsetButtonUp)
  102.         Set UserControl.Picture = LoadResPicture(TempValue + Selection, vbResBitmap)
  103.     End If
  104. End Sub
  105.  
  106. Private Sub UserControl_GotFocus()
  107.     Dim TempValue As Integer
  108.     
  109.     If Not IsFocus Then
  110.         IsFocus = True
  111.         TempValue = IIf(Press, resOffsetButtonDnFocus, resOffsetButtonUpFocus)
  112.         Set UserControl.Picture = LoadResPicture(TempValue + Selection, vbResBitmap)
  113.     End If
  114. End Sub
  115.  
  116. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  117.     Dim cHwnd As Long
  118.     
  119.     cHwnd = UserControl.ContainerHwnd
  120.     
  121.     Select Case KeyCode
  122.     Case Is = vbKeyRight
  123.         KeyCode = 0
  124.         PostMessage cHwnd, WM_KEYDOWN, ByVal &H27, ByVal &H4D0001
  125.     Case Is = vbKeyDown
  126.         KeyCode = 0
  127.         PostMessage cHwnd, WM_KEYDOWN, ByVal &H28, ByVal &H500001
  128.     Case Is = vbKeyLeft
  129.         KeyCode = 0
  130.         PostMessage cHwnd, WM_KEYDOWN, ByVal &H25, ByVal &H4B0001
  131.     Case Is = vbKeyUp
  132.         KeyCode = 0
  133.         PostMessage cHwnd, WM_KEYDOWN, ByVal &H26, ByVal &H480001
  134.     Case vbKeySpace, vbKeyReturn
  135.         UserControl_Click
  136.     End Select
  137. End Sub
  138.  
  139. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  140.     MyProp.cbSelection = PropBag.ReadProperty("Selection", cb_A)
  141.     MyProp.cbPress = PropBag.ReadProperty("Press", False)
  142. End Sub
  143.  
  144. Private Sub UserControl_Resize()
  145.     UserControl.Width = bW * Screen.TwipsPerPixelX
  146.     UserControl.Height = bH * Screen.TwipsPerPixelY
  147. End Sub
  148.  
  149. Private Sub UserControl_Show()
  150.     Dim tBM As BITMAP
  151.     
  152.     RedrawButton
  153.     GetObjectAPI UserControl.Picture.Handle, Len(tBM), tBM
  154.     bW = tBM.bmWidth: bH = tBM.bmHeight
  155.     UserControl.Width = bW * Screen.TwipsPerPixelX
  156.     UserControl.Height = bH * Screen.TwipsPerPixelY
  157.     Set UserControl.MouseIcon = LoadResPicture(101, vbResCursor)
  158. End Sub
  159.  
  160. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  161.     Call PropBag.WriteProperty("Selection", MyProp.cbSelection, cb_A)
  162.     Call PropBag.WriteProperty("Press", MyProp.cbPress, False)
  163. End Sub
  164.  
  165. Private Sub RedrawButton()
  166.     Dim TempValue As Integer
  167.         
  168.     If Not IsFocus Then
  169.         TempValue = IIf(Press, resOffsetButtonDn, resOffsetButtonUp)
  170.     Else
  171.         TempValue = IIf(Press, resOffsetButtonDnFocus, resOffsetButtonUpFocus)
  172.     End If
  173.     
  174.     Set UserControl.Picture = LoadResPicture(TempValue + Selection, vbResBitmap)
  175.     TempValue = IIf(Press, resMaskButtonDn, resMaskButtonUp)
  176.     Set UserControl.MaskPicture = LoadResPicture(TempValue, vbResBitmap)
  177. End Sub
  178.