home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 7_2009-2012.ISO / data / zips / Rocker_Swi217825412010.psc / HorzToggleSwitch.ctl < prev    next >
Text File  |  2010-03-25  |  13KB  |  411 lines
  1. VERSION 5.00
  2. Begin VB.UserControl HorzToggleSwitch 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   3945
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4635
  8.    Picture         =   "HorzToggleSwitch.ctx":0000
  9.    ScaleHeight     =   3945
  10.    ScaleWidth      =   4635
  11.    ToolboxBitmap   =   "HorzToggleSwitch.ctx":05B9
  12.    Begin VB.PictureBox p6 
  13.       Appearance      =   0  'Flat
  14.       AutoSize        =   -1  'True
  15.       BackColor       =   &H80000005&
  16.       BorderStyle     =   0  'None
  17.       ForeColor       =   &H80000008&
  18.       Height          =   270
  19.       Left            =   3255
  20.       Picture         =   "HorzToggleSwitch.ctx":08CB
  21.       ScaleHeight     =   18
  22.       ScaleMode       =   3  'Pixel
  23.       ScaleWidth      =   34
  24.       TabIndex        =   5
  25.       Top             =   2895
  26.       Width           =   510
  27.    End
  28.    Begin VB.PictureBox p5 
  29.       Appearance      =   0  'Flat
  30.       AutoSize        =   -1  'True
  31.       BackColor       =   &H80000005&
  32.       BorderStyle     =   0  'None
  33.       ForeColor       =   &H80000008&
  34.       Height          =   270
  35.       Left            =   3240
  36.       Picture         =   "HorzToggleSwitch.ctx":0D1B
  37.       ScaleHeight     =   18
  38.       ScaleMode       =   3  'Pixel
  39.       ScaleWidth      =   34
  40.       TabIndex        =   4
  41.       Top             =   2550
  42.       Width           =   510
  43.    End
  44.    Begin VB.PictureBox p4 
  45.       Appearance      =   0  'Flat
  46.       AutoSize        =   -1  'True
  47.       BackColor       =   &H80000005&
  48.       BorderStyle     =   0  'None
  49.       ForeColor       =   &H80000008&
  50.       Height          =   375
  51.       Left            =   2205
  52.       Picture         =   "HorzToggleSwitch.ctx":117F
  53.       ScaleHeight     =   25
  54.       ScaleMode       =   3  'Pixel
  55.       ScaleWidth      =   46
  56.       TabIndex        =   3
  57.       Top             =   2955
  58.       Width           =   690
  59.    End
  60.    Begin VB.PictureBox p3 
  61.       Appearance      =   0  'Flat
  62.       AutoSize        =   -1  'True
  63.       BackColor       =   &H80000005&
  64.       BorderStyle     =   0  'None
  65.       ForeColor       =   &H80000008&
  66.       Height          =   375
  67.       Left            =   2205
  68.       Picture         =   "HorzToggleSwitch.ctx":167F
  69.       ScaleHeight     =   25
  70.       ScaleMode       =   3  'Pixel
  71.       ScaleWidth      =   46
  72.       TabIndex        =   2
  73.       Top             =   2535
  74.       Width           =   690
  75.    End
  76.    Begin VB.PictureBox p2 
  77.       Appearance      =   0  'Flat
  78.       AutoSize        =   -1  'True
  79.       BackColor       =   &H80000005&
  80.       BorderStyle     =   0  'None
  81.       ForeColor       =   &H80000008&
  82.       Height          =   480
  83.       Left            =   825
  84.       Picture         =   "HorzToggleSwitch.ctx":1B65
  85.       ScaleHeight     =   32
  86.       ScaleMode       =   3  'Pixel
  87.       ScaleWidth      =   59
  88.       TabIndex        =   1
  89.       Top             =   3030
  90.       Width           =   885
  91.    End
  92.    Begin VB.PictureBox p1 
  93.       Appearance      =   0  'Flat
  94.       AutoSize        =   -1  'True
  95.       BackColor       =   &H80000005&
  96.       BorderStyle     =   0  'None
  97.       ForeColor       =   &H80000008&
  98.       Height          =   480
  99.       Left            =   825
  100.       Picture         =   "HorzToggleSwitch.ctx":2146
  101.       ScaleHeight     =   32
  102.       ScaleMode       =   3  'Pixel
  103.       ScaleWidth      =   59
  104.       TabIndex        =   0
  105.       Top             =   2505
  106.       Width           =   885
  107.    End
  108. End
  109. Attribute VB_Name = "HorzToggleSwitch"
  110. Attribute VB_GlobalNameSpace = False
  111. Attribute VB_Creatable = True
  112. Attribute VB_PredeclaredId = False
  113. Attribute VB_Exposed = False
  114. Option Explicit
  115. 'by Ken Foster April 2010
  116. 'Please use and abuse
  117. 'Copyrights = none
  118.  
  119. Public Enum hSize
  120.     Small = 0
  121.     Med = 1
  122.     Tiny = 2
  123. End Enum
  124. #If False Then 'Trick preserves Case of Enums when typing in IDE
  125. Private Small, Med, Tiny
  126. #End If
  127.  
  128. Public Enum hStyle
  129.     Momentary = 0
  130.     Toggle = 1
  131. End Enum
  132. #If False Then 'Trick preserves Case of Enums when typing in IDE
  133. Private Momentary, Toggle
  134. #End If
  135.  
  136. Private bButton                    As Integer
  137. Private sShift                     As Integer
  138. Private posX                       As Single
  139. Private posY                       As Single
  140.  
  141. Public Event Click()
  142. Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  143. Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  144. Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  145. Private Const m_def_ButState       As Boolean = False
  146. Private Const m_def_ButSize        As Integer = 1
  147. Private Const m_def_ButStyle       As Integer = 0
  148. Private Const m_def_LED            As Boolean = False
  149. Private Const m_def_Enabled   As Boolean = True
  150.  
  151. Private m_ButState                 As Boolean
  152. Private m_ButSize                  As Integer
  153. Private m_ButStyle                 As hStyle
  154. Private m_LED                      As Boolean
  155. Private m_Enabled               As Boolean
  156.     
  157. Private Sub UserControl_Initialize()
  158.     LED = m_def_LED
  159.     ButSize = m_def_ButSize
  160.     ButStyle = m_def_ButStyle
  161.     ButState = m_def_ButState
  162.     Enabled = m_def_Enabled
  163. End Sub
  164.  
  165. Private Sub UserControl_InitProperties()
  166.     m_LED = m_def_LED
  167.     m_ButSize = m_def_ButSize
  168.     m_ButStyle = m_def_ButStyle
  169.     m_ButState = m_def_ButState
  170.     m_Enabled = m_def_Enabled
  171. End Sub
  172.    
  173. Private Sub UserControl_Resize()
  174.     With UserControl
  175.     Select Case m_ButSize
  176.         Case 0    'small
  177.                 .Picture = p3.Picture
  178.                 .Width = p3.Width
  179.                 .Height = p3.Height
  180.         Case 1    'med
  181.                 .Picture = p1.Picture
  182.                 .Width = p1.Width
  183.                 .Height = p1.Height
  184.         Case 2   'tiny
  185.                 .Picture = p5.Picture
  186.                 .Width = p5.Width
  187.                 .Height = p5.Height
  188.     End Select
  189.     End With
  190. End Sub
  191.     
  192. Private Sub UserControl_MouseDown(Button As Integer, _
  193.     Shift As Integer, _
  194.     x As Single, _
  195.     y As Single)
  196.     
  197.     If m_ButStyle = Toggle Then    '----------------------------toggle
  198.     m_ButState = Not m_ButState   'toggle on/off
  199.     DrawButton
  200.     Else      '-------------------------------------------------momentary
  201.     Select Case m_ButSize
  202.         Case 0    'small
  203.             UserControl.Picture = p4.Picture
  204.         Case 1    'med
  205.             UserControl.Picture = p2.Picture
  206.         Case 2   'tiny
  207.             UserControl.Picture = p6.Picture
  208.     End Select
  209. End If
  210. RaiseEvent Click
  211. RaiseEvent MouseDown(Button, Shift, x, y)
  212. End Sub
  213.     
  214. Private Sub UserControl_MouseMove(Button As Integer, _
  215.     Shift As Integer, _
  216.     x As Single, _
  217.     y As Single)
  218.     
  219.     RaiseEvent MouseMove(Button, Shift, x, y)
  220. End Sub
  221.    
  222. Private Sub UserControl_MouseUp(Button As Integer, _
  223.     Shift As Integer, _
  224.     x As Single, _
  225.     y As Single)
  226.     
  227.     RaiseEvent MouseUp(Button, Shift, x, y)
  228.     'if style is toggle the exit
  229.     If m_ButStyle = Toggle Then
  230.         Exit Sub
  231.     End If
  232.     Select Case m_ButSize    'if style is momentary
  233.         Case 0    'small
  234.             UserControl.Picture = p3.Picture
  235.         Case 1    'med
  236.             UserControl.Picture = p1.Picture
  237.         Case 2    'tiny
  238.             UserControl.Picture = p5.Picture
  239.     End Select
  240. End Sub
  241.  
  242. Private Sub UserControl_Click()
  243.     If m_ButStyle = Toggle Then
  244.         RaiseEvent Click
  245.     End If
  246. End Sub
  247.     
  248. Private Sub UserControl_DblClick()
  249.     UserControl_MouseDown bButton, sShift, posX, posY
  250. End Sub
  251.     
  252. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  253.     With PropBag
  254.         ButSize = .ReadProperty("ButSize", m_def_ButSize)
  255.         ButState = .ReadProperty("ButState", m_def_ButState)
  256.         ButStyle = .ReadProperty("ButStyle", m_def_ButStyle)
  257.         LED = .ReadProperty("LED", m_def_LED)
  258.         Enabled = .ReadProperty("Enabled", m_def_Enabled)
  259.     End With
  260. End Sub
  261.     
  262. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  263.     With PropBag
  264.         .WriteProperty "ButSize", m_ButSize, m_def_ButSize
  265.         .WriteProperty "ButState", m_ButState, m_def_ButState
  266.         .WriteProperty "ButStyle", m_ButStyle, m_def_ButStyle
  267.         .WriteProperty "LED", m_LED, m_def_LED
  268.         .WriteProperty "Enabled", m_Enabled, m_def_Enabled
  269.     End With
  270. End Sub
  271.         
  272. Private Sub DrawButton()
  273.     With UserControl
  274.     'style equals momentary
  275.     If m_ButStyle = Momentary Then
  276.         Select Case m_ButSize
  277.             Case 0    'small
  278.                 .Picture = p3.Picture
  279.             Case 1    'med
  280.                 .Picture = p1.Picture
  281.             Case 2   'tiny
  282.                 .Picture = p5.Picture
  283.         End Select
  284.     Else
  285.         'style equals toggle
  286.         If m_ButState Then    'LED = green
  287.         Select Case m_ButSize
  288.             Case 0    'small
  289.                 .Picture = p4.Picture
  290.                 If m_LED Then
  291.                     UserControl.Line (130, 35)-(250, 35), vbGreen
  292.                     UserControl.Line (130, 50)-(250, 50), vbGreen
  293.                 End If
  294.             Case 1    'med
  295.                 UserControl.Picture = p2.Picture
  296.                 If m_LED Then
  297.                     UserControl.Line (150, 50)-(350, 50), vbGreen
  298.                     UserControl.Line (150, 65)-(350, 65), vbGreen
  299.                 End If
  300.             Case 2    'tiny
  301.                 UserControl.Picture = p6.Picture
  302.                 If m_LED Then
  303.                     UserControl.Line (80, 20)-(200, 20), vbGreen
  304.                     UserControl.Line (80, 35)-(200, 35), vbGreen
  305.                 End If
  306.         End Select
  307.         Else                         'LED = dark green
  308.         Select Case m_ButSize
  309.             Case 0    'small
  310.                 .Picture = p3.Picture
  311.                 If m_LED Then
  312.                     UserControl.Line (130, 35)-(250, 35), &H6C00&
  313.                     UserControl.Line (130, 50)-(250, 50), &H6C00&
  314.                 End If
  315.             Case 1    'med
  316.                 .Picture = p1.Picture
  317.                 If m_LED Then
  318.                     UserControl.Line (150, 50)-(350, 50), &H6C00&
  319.                     UserControl.Line (150, 65)-(350, 65), &H6C00&
  320.                 End If
  321.             Case 2    'tiny
  322.                 .Picture = p5.Picture
  323.                 If m_LED Then
  324.                     UserControl.Line (80, 20)-(200, 20), &H6C00&
  325.                     UserControl.Line (80, 35)-(200, 35), &H6C00&
  326.                 End If
  327.         End Select
  328.     End If
  329. End If
  330. End With
  331. End Sub
  332.  
  333. Public Property Get ButSize() As hSize
  334.     ButSize = m_ButSize
  335. End Property
  336.  
  337. Public Property Let ButSize(ByVal NewButSize As hSize)
  338.     
  339.     m_ButSize = NewButSize
  340.     With UserControl
  341.     Select Case m_ButSize
  342.         Case 0    'small
  343.                 .Picture = p3.Picture
  344.                 .Width = p3.Width
  345.                 .Height = p3.Height
  346.         Case 1    'med
  347.                 .Picture = p1.Picture
  348.                 .Width = p1.Width
  349.                 .Height = p1.Height
  350.         Case 2   'tiny
  351.                 .Picture = p5.Picture
  352.                 .Width = p5.Width
  353.                 .Height = p5.Height
  354.     End Select
  355.     End With
  356.     PropertyChanged "ButSize"
  357. End Property
  358.  
  359. Public Property Get ButState() As Boolean
  360. Attribute ButState.VB_Description = "Effective only in Toggle mode"
  361.     ButState = m_ButState
  362. End Property
  363.  
  364. Public Property Let ButState(ByVal NewButState As Boolean)
  365.     
  366.     m_ButState = NewButState
  367.     PropertyChanged "ButState"
  368.     DrawButton
  369. End Property
  370.  
  371. Public Property Get ButStyle() As hStyle
  372.     ButStyle = m_ButStyle
  373. End Property
  374.  
  375. Public Property Let ButStyle(ByVal NewButStyle As hStyle)
  376.     
  377.     m_ButStyle = NewButStyle
  378.     'in momentary style always set to false
  379.     If m_ButStyle = Momentary Then
  380.         m_ButState = False
  381.     End If
  382.     PropertyChanged "ButStyle"
  383.     DrawButton
  384. End Property
  385.  
  386. Public Property Get Enabled() As Boolean
  387.     Enabled = m_Enabled
  388. End Property
  389.  
  390. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  391.     m_Enabled = New_Enabled
  392.     UserControl.Enabled = m_Enabled
  393.     PropertyChanged "Enabled"
  394. End Property
  395.  
  396. Public Property Get LED() As Boolean
  397. Attribute LED.VB_Description = "Effective only in Toggle mode"
  398.     LED = m_LED
  399. End Property
  400.  
  401. Public Property Let LED(ByVal NewLED As Boolean)
  402.     
  403.     m_LED = NewLED
  404.     If m_ButStyle = Momentary Then
  405.         m_LED = False
  406.     End If
  407.     PropertyChanged "LED"
  408.     DrawButton
  409. End Property
  410.  
  411.