home *** CD-ROM | disk | FTP | other *** search
/ The Best of Windows 95.com 1996 December / WIN95_DEC_1996_2.ISO / htmlmisc / vb5ccein.exe / RCDATA / CABINET / AXButton.ctl < prev    next >
Text File  |  1996-10-25  |  20KB  |  411 lines
  1. VERSION 5.00
  2. Begin VB.UserControl AXButtonCtl 
  3.    CanGetFocus     =   0   'False
  4.    ClientHeight    =   2610
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   3135
  8.    ClipControls    =   0   'False
  9.    ForwardFocus    =   -1  'True
  10.    LockControls    =   -1  'True
  11.    PropertyPages   =   "AXButton.ctx":0000
  12.    ScaleHeight     =   2610
  13.    ScaleWidth      =   3135
  14.    Begin VB.Line lnRight 
  15.       BorderColor     =   &H00808080&
  16.       BorderWidth     =   2
  17.       Visible         =   0   'False
  18.       X1              =   3030
  19.       X2              =   3030
  20.       Y1              =   60
  21.       Y2              =   2520
  22.    End
  23.    Begin VB.Line lnBottom 
  24.       BorderColor     =   &H00808080&
  25.       BorderWidth     =   2
  26.       Visible         =   0   'False
  27.       X1              =   60
  28.       X2              =   3030
  29.       Y1              =   2520
  30.       Y2              =   2520
  31.    End
  32.    Begin VB.Line lnTop 
  33.       BorderColor     =   &H80000014&
  34.       BorderWidth     =   2
  35.       Visible         =   0   'False
  36.       X1              =   60
  37.       X2              =   2970
  38.       Y1              =   60
  39.       Y2              =   60
  40.    End
  41.    Begin VB.Line lnLeft 
  42.       BorderColor     =   &H80000014&
  43.       BorderWidth     =   2
  44.       Visible         =   0   'False
  45.       X1              =   60
  46.       X2              =   60
  47.       Y1              =   60
  48.       Y2              =   2490
  49.    End
  50. End
  51. Attribute VB_Name = "AXButtonCtl"
  52. Attribute VB_GlobalNameSpace = False
  53. Attribute VB_Creatable = True
  54. Attribute VB_PredeclaredId = False
  55. Attribute VB_Exposed = True
  56. Option Explicit
  57. '------------------------------------------------------------------
  58. ' API Declares...
  59. '------------------------------------------------------------------
  60. Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
  61. Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
  62. Private Declare Function ReleaseCapture Lib "user32" () As Long
  63.  
  64. '------------------------------------------------------------------
  65. ' Private Variables...
  66. '------------------------------------------------------------------
  67. Dim MouseDown As Boolean                        ' Flag - set when left button is pressed down
  68. Dim MouseOver As Boolean                        ' Flag - set when mouse pointer is over button
  69. Dim MouseCaptured As Boolean                    ' Flag - set when mouse pointer is captured by button control
  70. Dim ClearURLOnly As Boolean                     '
  71. Dim ClearPictureOnly As Boolean                 '
  72.  
  73. Dim StaticWidth As Long
  74. Dim StaticHeight As Long
  75. Dim gPicture As StdPicture                      ' Global picture property variable
  76. Dim gURLPicture As String                       ' Global URL picture property string variable
  77.  
  78. Const pPICTURE = "Picture"                      ' Picture property name constant
  79. Const pURLPICTURE = "URLPicture"                ' URLPicture property name constant
  80. Const Bdr = 10
  81. Const SND_ASYNC = &H1
  82. Const EVENT_MenuCommand = "MenuCommand"         ' Sound event name for button mousedown event
  83. Const EVENT_MenuPopup = "MenuPopup"             ' Sound event name for button enterover event
  84.  
  85. '------------------------------------------------------------------
  86. ' Private Enum...
  87. '------------------------------------------------------------------
  88. Enum ButtonState
  89.     Up = 0                                      ' Draw button raised up border
  90.     Down = 1                                    ' Draw button sunken down border
  91.     Flat = 2                                    ' Draw button flat - no border
  92. End Enum
  93.  
  94. '------------------------------------------------------------------
  95. ' Container Event Declarations:
  96. '------------------------------------------------------------------
  97. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  98. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  99. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  100. Event Click()
  101.  
  102. '------------------------------------------------------------------
  103. Private Sub UserControl_Click()
  104. '------------------------------------------------------------------
  105.     RaiseEvent Click                            ' Dispatch click event to container.
  106. '------------------------------------------------------------------
  107. End Sub
  108. '------------------------------------------------------------------
  109.  
  110. '------------------------------------------------------------------
  111. Private Sub UserControl_Initialize()
  112. '------------------------------------------------------------------
  113.     StaticWidth = UserControl.Width             ' Get default button size
  114.     StaticHeight = UserControl.Height
  115. '------------------------------------------------------------------
  116. End Sub
  117. '------------------------------------------------------------------
  118.  
  119. '------------------------------------------------------------------
  120. Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
  121. '------------------------------------------------------------------
  122.     On Error GoTo ErrorHandler
  123.     
  124.     If (AsyncProp.PropertyName = pPICTURE) Then ' Picture download is complete
  125.         ClearPictureOnly = True
  126.         Set Picture = AsyncProp.Value           ' Store picture data to property...
  127.     End If
  128. '------------------------------------------------------------------
  129. ErrorHandler:
  130. '------------------------------------------------------------------
  131.     ClearPictureOnly = False
  132. '------------------------------------------------------------------
  133. End Sub
  134. '------------------------------------------------------------------
  135.  
  136. '------------------------------------------------------------------
  137. Private Sub UserControl_InitProperties()
  138. '------------------------------------------------------------------
  139.     SetButtonState Up                                   ' Draw button flat
  140. '------------------------------------------------------------------
  141. End Sub
  142. '------------------------------------------------------------------
  143.  
  144. '------------------------------------------------------------------
  145. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  146. '------------------------------------------------------------------
  147.     If ((Button And vbLeftButton) = vbLeftButton) Then  ' Only do if left mouse button was pressed
  148.         MouseDown = True                                ' Set MouseDown state flag
  149.         SetButtonState Down                             ' Draw button down
  150.         PlaySound EVENT_MenuCommand, 0, SND_ASYNC       ' Play event sound for mousedown...
  151.     End If
  152.     RaiseEvent MouseDown(Button, Shift, X, Y)           ' Dispatch mousedown event to container.
  153. '------------------------------------------------------------------
  154. End Sub
  155. '------------------------------------------------------------------
  156.  
  157. '------------------------------------------------------------------
  158. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  159. '------------------------------------------------------------------
  160.     If ((Button And vbLeftButton) = vbLeftButton) Then  ' Only do if left mouse button was pressed
  161.         MouseDown = False                               ' Clear MouseDown flag
  162.         SetButtonState Up                               ' Draw button up
  163.     End If
  164.     
  165.     MouseCaptured = True                                ' Reset MouseCaptured flag
  166.     SetCapture UserControl.hWnd                         ' ReCapture Mouse, Click seems to disable previous captures...
  167.     RaiseEvent MouseUp(Button, Shift, X, Y)             ' Dispatch mouseup event to container.
  168. '------------------------------------------------------------------
  169. End Sub
  170. '------------------------------------------------------------------
  171.  
  172. '------------------------------------------------------------------
  173. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  174. '------------------------------------------------------------------
  175.     With UserControl
  176.         ' Determine if mouse is currently moving over button.
  177.         MouseOver = (0 <= X) And (X <= .Width) And (0 <= Y) And (Y <= .Height)
  178.         
  179.         ' Determine if left mouse button is down
  180.         MouseDown = ((Button And vbLeftButton) = vbLeftButton)
  181.         
  182.         If MouseOver Then
  183.             If MouseDown Then
  184.                 SetButtonState Down                         ' Draw button down...
  185.             Else
  186.                 SetButtonState Up                           ' Draw button up
  187.             End If
  188.             If Not MouseCaptured Then                       ' Mouse captured
  189.                 PlaySound EVENT_MenuPopup, 0, SND_ASYNC     ' Play mouse move enter event sound
  190.                 SetCapture .hWnd                            ' Capture all mouse movements and send to UserControl
  191.                 MouseCaptured = True                        ' Set MouseCaptured flag
  192.             End If
  193.         Else
  194.             If MouseDown Then
  195.                 SetButtonState Up                           ' Draw button up
  196.             Else
  197.                 SetButtonState Flat                         ' Draw button flat
  198.                 If MouseCaptured Then
  199.                     ReleaseCapture                          ' Release outside capture of mouse button
  200.                     MouseCaptured = False                   ' Turn capture flag off...
  201.                 End If
  202.             End If
  203.         End If
  204.     End With
  205.     RaiseEvent MouseMove(Button, Shift, X, Y)               ' Dispatch mousemove event to container
  206. '------------------------------------------------------------------
  207. End Sub
  208. '------------------------------------------------------------------
  209.  
  210. '------------------------------------------------------------------
  211. Private Sub SetButtonState(State As ButtonState)
  212. '------------------------------------------------------------------
  213.     Select Case State                               ' Determine draw state
  214.     Case Up                                         ' Draw button up
  215.         lnTop.BorderColor = vb3DHighlight           ' Set appropriate color for lines...
  216.         lnLeft.BorderColor = vb3DHighlight
  217.         lnBottom.BorderColor = vb3DShadow
  218.         lnRight.BorderColor = vb3DShadow
  219.     Case Down                                       ' Draw button down
  220.         lnTop.BorderColor = vb3DShadow              ' Set appropriate color for lines...
  221.         lnLeft.BorderColor = vb3DShadow
  222.         lnBottom.BorderColor = vb3DHighlight
  223.         lnRight.BorderColor = vb3DHighlight
  224.     End Select
  225.     
  226.     lnBottom.Visible = (State <> Flat)              ' Show or Hide lines based on state of button
  227.     lnTop.Visible = (State <> Flat)
  228.     lnLeft.Visible = (State <> Flat)
  229.     lnRight.Visible = (State <> Flat)
  230. '------------------------------------------------------------------
  231. End Sub
  232. '------------------------------------------------------------------
  233.  
  234. '------------------------------------------------------------------
  235. Public Property Let URLPicture(Url As String)
  236. Attribute URLPicture.VB_ProcData.VB_Invoke_PropertyPut = ";Misc"
  237. '------------------------------------------------------------------
  238.     If (gURLPicture <> Url) Then                    ' Do only if value has changed...
  239.         ClearPictureOnly = Not ClearURLOnly         ' If Picture property is not being set by the URLPicture _
  240.                                                       property then clear the URLPicture value...
  241.         gURLPicture = Url                           ' Save url string value to global variable
  242.         PropertyChanged pURLPICTURE                 ' Notify property bag of property change
  243.             
  244.         If Not ClearURLOnly Then
  245.             On Error GoTo ErrorHandler              ' Handle Error if URL is unavailable or Invalid...
  246.             If (Url <> "") Then
  247.                 UserControl.AsyncRead Url, vbAsyncTypePicture, pPICTURE ' Begin async download of picture file...
  248.             Else
  249.                 Set Picture = Nothing
  250.             End If
  251.         End If
  252.     End If
  253. '------------------------------------------------------------------
  254. ErrorHandler:
  255. '------------------------------------------------------------------
  256.     ClearPictureOnly = False
  257. '------------------------------------------------------------------
  258. End Property
  259. '------------------------------------------------------------------
  260.  
  261. '------------------------------------------------------------------
  262. Public Property Get URLPicture() As String
  263. '------------------------------------------------------------------
  264.     URLPicture = gURLPicture                        ' Return URL string value
  265. '------------------------------------------------------------------
  266. End Property
  267. '------------------------------------------------------------------
  268.  
  269. '------------------------------------------------------------------
  270. Public Property Set Picture(ByVal Image As Picture)
  271. '------------------------------------------------------------------
  272.     If Not ClearPictureOnly Then
  273.         ClearURLOnly = True                         ' If Picture property is not being set by the URLPicture
  274.         URLPicture = ""                             ' property then clear the URLPicture value...
  275.         ClearURLOnly = False                        ' If Picture property is not being set by the URLPicture
  276.     End If
  277.     
  278.     If (Not Image Is Nothing) Then
  279.         If (Image.Handle = 0) Then Set Image = Nothing
  280.     End If
  281.     Set gPicture = Image                            ' Store image to global variable
  282.     
  283.     With UserControl
  284.         If Not Image Is Nothing Then                ' Check for Null picture value
  285.             StaticWidth = .ScaleX(gPicture.Width, vbHimetric, vbTwips)   ' Save size of bitmap
  286.             StaticHeight = .ScaleY(gPicture.Height, vbHimetric, vbTwips)
  287.         End If
  288.         .Cls                                        ' Clear previous picture image...
  289.     End With
  290.     
  291.     UserControl_Resize                              ' Resize button to fit image
  292.     UserControl_Paint                               ' Refresh image on button...
  293.     PropertyChanged pPICTURE                        ' Notify property bag of property change
  294. '------------------------------------------------------------------
  295. End Property
  296. '------------------------------------------------------------------
  297.  
  298. '------------------------------------------------------------------
  299. Public Property Get Picture() As Picture
  300. Attribute Picture.VB_ProcData.VB_Invoke_Property = "StandardPicture"
  301. '------------------------------------------------------------------
  302.     Set Picture = gPicture                          ' Return value of picture property
  303. '------------------------------------------------------------------
  304. End Property
  305. '------------------------------------------------------------------
  306.  
  307. '------------------------------------------------------------------
  308. Private Sub UserControl_Paint()
  309. '------------------------------------------------------------------
  310.     If (gPicture Is Nothing) Then Exit Sub          ' Don't draw if picture is invalid...
  311.     
  312.     ' Draw picture from property to usercontrol...
  313.     With UserControl
  314.         .PaintPicture gPicture, _
  315.                      .ScaleX(lnLeft.BorderWidth, vbTwips, vbHimetric), _
  316.                      .ScaleY(lnTop.BorderWidth, vbTwips, vbHimetric), _
  317.                      .ScaleX(.Width - (2 * lnLeft.BorderWidth), vbTwips, vbHimetric), _
  318.                      .ScaleY(.Height - (2 * lnTop.BorderWidth), vbTwips, vbHimetric), _
  319.                       0, _
  320.                       0, _
  321.                       gPicture.Width, _
  322.                       gPicture.Height
  323.     End With
  324. '------------------------------------------------------------------
  325. End Sub
  326. '------------------------------------------------------------------
  327.  
  328. '------------------------------------------------------------------
  329. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  330. '------------------------------------------------------------------
  331.     Dim Pic As StdPicture
  332.     Dim Url As String
  333. '------------------------------------------------------------------
  334.     On Error GoTo ErrorHandler                      ' Handler weird host problems
  335.     
  336.     If UserControl.Ambient.UserMode Then            ' Are we hosted in an IDE ???
  337.         SetButtonState Flat                         ' Draw button flat
  338.     Else
  339.         SetButtonState Up                           ' Draw button flat
  340.     End If
  341.     
  342.     ' Read in the properties that have been saved into the PropertyBag...
  343.     With PropBag
  344.         Url = .ReadProperty(pURLPICTURE, "")        ' Read URLPicture property value
  345.         If (Url <> "") Then                         ' If a URL has been entered...
  346.             URLPicture = Url                        ' Attempt to download it now, URL may be unabailable at this time
  347.         Else
  348.             Set Pic = .ReadProperty(pPICTURE, Nothing) ' Read Picture property value
  349.             If Not (Pic Is Nothing) Then            ' URL is not available
  350.                 Set Picture = Pic                   ' Use existing picture (This is used only if URL is empty)
  351.             End If
  352.         End If
  353.     End With
  354. '------------------------------------------------------------------
  355. ErrorHandler:
  356. '------------------------------------------------------------------
  357. ' Just quit nicely...
  358. '------------------------------------------------------------------
  359. End Sub
  360. '------------------------------------------------------------------
  361.  
  362. '------------------------------------------------------------------
  363. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  364. '------------------------------------------------------------------
  365.     On Error GoTo ErrorHandler                      ' Handler weird host problems
  366.     With PropBag
  367.         .WriteProperty pURLPICTURE, gURLPicture     ' Write URLPicture property to propertybag
  368.         .WriteProperty pPICTURE, gPicture           ' Write Picture property to propertybag
  369.     End With
  370. '------------------------------------------------------------------
  371. ErrorHandler:
  372. '------------------------------------------------------------------
  373. ' Just quit nicely...
  374. '------------------------------------------------------------------
  375. End Sub
  376. '------------------------------------------------------------------
  377.  
  378. '------------------------------------------------------------------
  379. Private Sub UserControl_Resize()
  380. '------------------------------------------------------------------
  381.     Dim W As Long, H As Long, L As Long, T As Long
  382. '------------------------------------------------------------------
  383.     L = 1                                           ' Set default left position
  384.     T = 1                                           ' Set default top positon
  385.     With UserControl
  386.         If gPicture Is Nothing Then                 ' If picture is invalid valid
  387.             StaticWidth = .Width                    ' Update static width size
  388.             StaticHeight = .Height                  ' Update static height size
  389.         Else                                        ' Picture is valid...
  390.             .Width = StaticWidth                    ' Fix control size to picture width
  391.             .Height = StaticHeight                  ' ...
  392.         End If
  393.         W = .ScaleWidth - Bdr                       ' Calculate w position for lines
  394.         H = .ScaleHeight - Bdr                      ' Calculate h position for lines
  395.     End With
  396.     With lnLeft
  397.         .X1 = L:    .X2 = L:    .Y1 = T:    .Y2 = H  ' Move lines to new positions
  398.     End With
  399.     With lnRight
  400.         .X1 = W:    .X2 = W:    .Y1 = T:    .Y2 = H
  401.     End With
  402.     With lnTop
  403.         .X1 = L:    .X2 = W:    .Y1 = T:    .Y2 = T
  404.     End With
  405.     With lnBottom
  406.         .X1 = L:    .X2 = W:    .Y1 = H:    .Y2 = H
  407.     End With
  408. '------------------------------------------------------------------
  409. End Sub
  410. '------------------------------------------------------------------
  411.