home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / School_Man20924211302007.psc / prischo / ctrl_SkinableButton.ctl < prev    next >
Text File  |  2007-11-21  |  9KB  |  265 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ctrl_SkinableButton 
  3.    BackStyle       =   0  'Transparent
  4.    ClientHeight    =   360
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   1290
  8.    ScaleHeight     =   360
  9.    ScaleWidth      =   1290
  10.    Begin VB.PictureBox pic_Button 
  11.       AutoRedraw      =   -1  'True
  12.       AutoSize        =   -1  'True
  13.       BorderStyle     =   0  'None
  14.       Height          =   495
  15.       Left            =   0
  16.       ScaleHeight     =   495
  17.       ScaleWidth      =   1215
  18.       TabIndex        =   1
  19.       Top             =   0
  20.       Width           =   1215
  21.       Begin VB.Label lbl_Caption 
  22.          Alignment       =   2  'Center
  23.          BackStyle       =   0  'Transparent
  24.          Caption         =   "Caption"
  25.          BeginProperty Font 
  26.             Name            =   "Tahoma"
  27.             Size            =   8.25
  28.             Charset         =   0
  29.             Weight          =   700
  30.             Underline       =   0   'False
  31.             Italic          =   0   'False
  32.             Strikethrough   =   0   'False
  33.          EndProperty
  34.          Height          =   195
  35.          Left            =   0
  36.          TabIndex        =   2
  37.          Top             =   0
  38.          Width           =   570
  39.       End
  40.    End
  41.    Begin VB.PictureBox pic_Buttons 
  42.       AutoRedraw      =   -1  'True
  43.       AutoSize        =   -1  'True
  44.       Height          =   495
  45.       Left            =   0
  46.       ScaleHeight     =   435
  47.       ScaleWidth      =   1155
  48.       TabIndex        =   0
  49.       Top             =   480
  50.       Visible         =   0   'False
  51.       Width           =   1215
  52.    End
  53. End
  54. Attribute VB_Name = "ctrl_SkinableButton"
  55. Attribute VB_GlobalNameSpace = False
  56. Attribute VB_Creatable = True
  57. Attribute VB_PredeclaredId = False
  58. Attribute VB_Exposed = False
  59.  
  60. Option Explicit
  61.  
  62. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  63. Private Const SRCCOPY = &HCC0020
  64.  
  65. Const DefCaption = "Caption"
  66. Const DefForeColor = &HFFFFFF
  67. Const DefEnabled = 1
  68.  
  69. Dim v_sSkinPath As String
  70. Dim v_sCaption As String
  71. Dim v_oForeColor As OLE_COLOR
  72. Dim v_bEnabled As Boolean
  73.  
  74. Event Click()
  75. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  76. Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  77. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  78. Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  79. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  80. Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  81. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  82.  
  83. Public Sub LoadSkin()
  84.     Dim v_lRtn As Long
  85.     Dim v_iCenterImgFrequency As Integer
  86.     Dim v_iLoop As Integer
  87.  
  88.     With UserControl
  89.         .pic_Buttons.Picture = LoadPicture(SkinPath & "\img_Buttons.bmp")
  90.         .pic_Button.Width = .Width
  91.         .pic_Button.Height = 360
  92.         
  93.         .pic_Button.Cls
  94.         v_lRtn = BitBlt(.pic_Button.hDC, 0, 0, 15, 24, .pic_Buttons.hDC, 0, 0, SRCCOPY)
  95.         v_iCenterImgFrequency = Abs((.Width / Screen.TwipsPerPixelX) / 15)
  96.         If v_iCenterImgFrequency > 0 Then
  97.             For v_iLoop = 1 To v_iCenterImgFrequency
  98.                 v_lRtn = BitBlt(.pic_Button.hDC, v_iLoop * 15, 0, 15, 24, .pic_Buttons.hDC, 15, 0, SRCCOPY)
  99.             Next v_iLoop
  100.         End If
  101.         v_lRtn = BitBlt(.pic_Button.hDC, (.Width / Screen.TwipsPerPixelX) - 16, 0, 16, 24, .pic_Buttons.hDC, 55, 0, SRCCOPY)
  102.         
  103.         .lbl_Caption.Width = .Width
  104.         .lbl_Caption.Top = 60
  105.     End With
  106. End Sub
  107.  
  108. Public Sub Refresh()
  109.     Dim v_lRtn As Long
  110.     Dim v_iCenterImgFrequency As Integer
  111.     Dim v_iLoop As Integer
  112.  
  113.     With UserControl
  114.         .pic_Button.Width = .Width
  115.         .pic_Button.Height = 360
  116.         
  117.         .pic_Button.Cls
  118.         v_lRtn = BitBlt(.pic_Button.hDC, 0, 0, 15, 24, .pic_Buttons.hDC, 0, 0, SRCCOPY)
  119.         v_iCenterImgFrequency = Abs((.Width / Screen.TwipsPerPixelX) / 15)
  120.         If v_iCenterImgFrequency > 0 Then
  121.             For v_iLoop = 1 To v_iCenterImgFrequency
  122.                 v_lRtn = BitBlt(.pic_Button.hDC, v_iLoop * 15, 0, 15, 24, .pic_Buttons.hDC, 15, 0, SRCCOPY)
  123.             Next v_iLoop
  124.         End If
  125.         v_lRtn = BitBlt(.pic_Button.hDC, (.Width / Screen.TwipsPerPixelX) - 16, 0, 16, 24, .pic_Buttons.hDC, 55, 0, SRCCOPY)
  126.         
  127.         .lbl_Caption.Width = .Width
  128.         .lbl_Caption.Top = 60
  129.         .lbl_Caption.ForeColor = ForeColor
  130.     End With
  131. End Sub
  132.  
  133. Public Property Get SkinPath() As String
  134.     SkinPath = v_sSkinPath
  135. End Property
  136.  
  137. Public Property Let SkinPath(ByVal m_SkinPath As String)
  138.     v_sSkinPath = m_SkinPath
  139.     PropertyChanged "SkinPath"
  140. End Property
  141.  
  142. Public Property Get Caption() As String
  143.     Caption = v_sCaption
  144. End Property
  145.  
  146. Public Property Let Caption(ByVal m_Caption As String)
  147.     v_sCaption = m_Caption
  148.     PropertyChanged "Caption"
  149. End Property
  150.  
  151. Public Property Get ForeColor() As OLE_COLOR
  152.     ForeColor = v_oForeColor
  153. End Property
  154.  
  155. Public Property Let ForeColor(ByVal m_ForeColor As OLE_COLOR)
  156.     v_oForeColor = m_ForeColor
  157.     PropertyChanged "ForeColor"
  158. End Property
  159.  
  160. Public Property Get Enabled() As Boolean
  161.     Enabled = v_bEnabled
  162. End Property
  163.  
  164. Public Property Let Enabled(ByVal m_Enabled As Boolean)
  165.     v_bEnabled = m_Enabled
  166.     PropertyChanged "Enabled"
  167. End Property
  168.  
  169. Private Sub lbl_Caption_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  170.     Dim v_lRtn As Long
  171.     Dim v_iCenterImgFrequency As Integer
  172.     Dim v_iLoop As Integer
  173.  
  174.     If Button = 1 Then
  175.     
  176.     With UserControl
  177.         .pic_Button.Cls
  178.         v_lRtn = BitBlt(.pic_Button.hDC, 0, 0, 15, 24, .pic_Buttons.hDC, 144, 0, SRCCOPY)
  179.         v_iCenterImgFrequency = Abs((.Width / Screen.TwipsPerPixelX) / 15)
  180.         If v_iCenterImgFrequency > 0 Then
  181.             For v_iLoop = 1 To v_iCenterImgFrequency
  182.                 v_lRtn = BitBlt(.pic_Button.hDC, v_iLoop * 15, 0, 15, 24, .pic_Buttons.hDC, 159, 0, SRCCOPY)
  183.             Next v_iLoop
  184.         End If
  185.         v_lRtn = BitBlt(.pic_Button.hDC, (.Width / Screen.TwipsPerPixelX) - 16, 0, 16, 24, .pic_Buttons.hDC, 202, 0, SRCCOPY)
  186.         
  187.         .lbl_Caption.Width = .Width
  188.         .lbl_Caption.Top = 75
  189.         .lbl_Caption.ForeColor = ForeColor
  190.     End With
  191.     
  192.     RaiseEvent MouseDown(Button, Shift, x, y)
  193.     End If
  194. End Sub
  195.  
  196. Private Sub lbl_Caption_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  197.     If Button = 1 Then
  198.         Call pic_Button_MouseMove(Button, Shift, x, y)
  199.         RaiseEvent MouseUp(Button, Shift, x, y)
  200.         RaiseEvent Click
  201.     End If
  202. End Sub
  203.  
  204. Private Sub pic_Button_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  205.     Dim v_lRtn As Long
  206.     Dim v_iCenterImgFrequency As Integer
  207.     Dim v_iLoop As Integer
  208.     
  209.     If Enabled = True Then
  210.     
  211.     With UserControl
  212.         .pic_Button.Cls
  213.         v_lRtn = BitBlt(.pic_Button.hDC, 0, 0, 15, 24, .pic_Buttons.hDC, 72, 0, SRCCOPY)
  214.         v_iCenterImgFrequency = Abs((.Width / Screen.TwipsPerPixelX) / 15)
  215.         If v_iCenterImgFrequency > 0 Then
  216.             For v_iLoop = 1 To v_iCenterImgFrequency
  217.                 v_lRtn = BitBlt(.pic_Button.hDC, v_iLoop * 15, 0, 15, 24, .pic_Buttons.hDC, 83, 0, SRCCOPY)
  218.             Next v_iLoop
  219.         End If
  220.         v_lRtn = BitBlt(.pic_Button.hDC, (.Width / Screen.TwipsPerPixelX) - 16, 0, 16, 24, .pic_Buttons.hDC, 128, 0, SRCCOPY)
  221.         
  222.         .lbl_Caption.Width = .Width
  223.         .lbl_Caption.Top = 75
  224.         .lbl_Caption.ForeColor = ForeColor
  225.     End With
  226.     RaiseEvent MouseMove(Button, Shift, x, y)
  227.     
  228.     End If
  229. End Sub
  230.  
  231. Private Sub UserControl_InitProperties()
  232.     'v_sSkinPath = App.Path & "\Skins\Titanium"
  233.     v_sCaption = DefCaption
  234.     v_oForeColor = DefForeColor
  235. End Sub
  236.  
  237. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  238.     v_sSkinPath = PropBag.ReadProperty("SkinPath", App.Path & "\Skins\Titanium")
  239.     Call LoadSkin
  240.     
  241.     v_sCaption = PropBag.ReadProperty("Caption", DefCaption)
  242.     UserControl.lbl_Caption.Caption = v_sCaption
  243.     
  244.     v_oForeColor = PropBag.ReadProperty("ForeColor", DefForeColor)
  245.     UserControl.lbl_Caption.ForeColor = v_oForeColor
  246.  
  247.     v_bEnabled = PropBag.ReadProperty("Enabled", DefEnabled)
  248.     If v_bEnabled = True Then
  249.         Call Refresh
  250.     Else
  251.         UserControl.lbl_Caption.Enabled = False
  252.     End If
  253. End Sub
  254.  
  255. Private Sub UserControl_Resize()
  256.     Call Refresh
  257. End Sub
  258.  
  259. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  260.     Call PropBag.WriteProperty("SkinPath", v_sSkinPath, App.Path & "\Skins\Titanium")
  261.     Call PropBag.WriteProperty("Caption", v_sCaption, DefCaption)
  262.     Call PropBag.WriteProperty("ForeColor", v_oForeColor, DefForeColor)
  263.     Call PropBag.WriteProperty("Enabled", v_bEnabled, DefEnabled)
  264. End Sub
  265.