home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / hitcou1a / hitcount.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-15  |  7.9 KB  |  217 lines
  1. VERSION 5.00
  2. Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
  3. Begin VB.UserControl HitCounter 
  4.    Appearance      =   0  'Flat
  5.    ClientHeight    =   465
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   4740
  9.    ClipControls    =   0   'False
  10.    ScaleHeight     =   31
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   316
  13.    ToolboxBitmap   =   "HitCounter.ctx":0000
  14.    Begin PicClip.PictureClip PicClip 
  15.       Left            =   0
  16.       Top             =   0
  17.       _ExtentX        =   6615
  18.       _ExtentY        =   661
  19.       _Version        =   327681
  20.       Cols            =   10
  21.       Picture         =   "HitCounter.ctx":0312
  22.    End
  23.    Begin VB.Image Numeral 
  24.       Enabled         =   0   'False
  25.       Height          =   990
  26.       Index           =   0
  27.       Left            =   0
  28.       Top             =   0
  29.       Visible         =   0   'False
  30.       Width           =   540
  31.    End
  32. Attribute VB_Name = "HitCounter"
  33. Attribute VB_GlobalNameSpace = False
  34. Attribute VB_Creatable = True
  35. Attribute VB_PredeclaredId = False
  36. Attribute VB_Exposed = True
  37. Option Explicit
  38. Const CHAR_CNT As Integer = 10
  39. Const TITLE As String = "HitCounter"
  40. Const KEY As String = "Value"
  41. Const D_GRAY As Long = &HC0C0C0
  42. Enum BorderStyles
  43.     None
  44.     Fixed
  45. End Enum
  46. Dim Numerals() As IPictureDisp
  47. Dim HitCnt As Long
  48. Dim Nums As Integer
  49. Dim NumCnt As Integer
  50. Dim NumSpc As Integer
  51. Dim InRunMode As Boolean
  52. Dim Initialized As Boolean
  53. Event Click()
  54. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  55. Event DblClick()
  56. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  57. Event KeyDown(KeyCode As Integer, Shift As Integer)
  58. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  59. Event KeyPress(KeyAscii As Integer)
  60. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  61. Event KeyUp(KeyCode As Integer, Shift As Integer)
  62. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  63. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  64. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  65. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  66. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  67. Public Property Get BorderStyle() As BorderStyles
  68.     BorderStyle = UserControl.BorderStyle
  69. End Property
  70. Property Let BorderStyle(NewStyle As BorderStyles)
  71.     UserControl.BorderStyle = NewStyle
  72.     PropertyChanged "BorderStyle"
  73. End Property
  74. Public Property Get BackColor() As OLE_COLOR
  75. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  76.     BackColor = UserControl.BackColor
  77. End Property
  78. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  79.     UserControl.BackColor = New_BackColor
  80.     PropertyChanged "BackColor"
  81. End Property
  82. Public Property Get Space() As Integer
  83.     Space = NumSpc
  84. End Property
  85. Public Property Let Space(ByVal New_Space As Integer)
  86.     NumSpc = New_Space
  87.     PropertyChanged "Space"
  88.     Display
  89. End Property
  90. Property Get NumeralCount() As Integer
  91.     NumeralCount = Nums
  92. End Property
  93. Property Let NumeralCount(New_NumeralCount As Integer)
  94.     Nums = New_NumeralCount
  95.     PropertyChanged "NumeralCount"
  96.     UserControl_Resize
  97.     Display
  98. End Property
  99. Public Property Get NumeralPicture() As Picture
  100. Attribute NumeralPicture.VB_Description = "Same as the standard Picture property except that it only supports bitmap (.BMP) files."
  101.     Set NumeralPicture = PicClip.Picture
  102. End Property
  103. Public Property Set NumeralPicture(ByVal New_NumeralPicture As Picture)
  104.     Set PicClip.Picture = New_NumeralPicture
  105.     PropertyChanged "NumeralPicture"
  106.     LoadNumerals
  107.     Display
  108. End Property
  109. Private Sub Numeral_Click(Index As Integer)
  110.     RaiseEvent Click
  111. End Sub
  112. Private Sub UserControl_Click()
  113.     RaiseEvent Click
  114. End Sub
  115. Private Sub UserControl_DblClick()
  116.     RaiseEvent DblClick
  117. End Sub
  118. Private Sub UserControl_InitProperties()
  119.     UserControl.BackColor = D_GRAY
  120.     Debug.Print "BorderChanged"
  121.     NumSpc = 2
  122.     Initialized = True
  123. End Sub
  124. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  125.     RaiseEvent KeyDown(KeyCode, Shift)
  126. End Sub
  127. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  128.     RaiseEvent KeyPress(KeyAscii)
  129. End Sub
  130. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  131.     RaiseEvent KeyUp(KeyCode, Shift)
  132. End Sub
  133. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  134.     RaiseEvent MouseDown(Button, Shift, ScaleX(X, ScaleMode, vbContainerPosition), ScaleX(Y, ScaleMode, vbContainerPosition))
  135. End Sub
  136. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  137.     RaiseEvent MouseUp(Button, Shift, ScaleX(X, ScaleMode, vbContainerPosition), ScaleX(Y, ScaleMode, vbContainerPosition))
  138. End Sub
  139. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  140.     UserControl.BackColor = PropBag.ReadProperty("BackColor", D_GRAY)
  141.     UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", None)
  142.     NumSpc = PropBag.ReadProperty("Space", 2)
  143.     Nums = PropBag.ReadProperty("NumeralCount", 0)
  144.     Set Picture = PropBag.ReadProperty("NumeralPicture", Nothing)
  145.     InRunMode = Ambient.UserMode
  146.     LoadNumerals
  147.     Display
  148. End Sub
  149. Private Sub UserControl_Resize()
  150. Dim X As Double, Y As Double
  151.     If Initialized Then
  152.         Initialized = False
  153.         X = PicClip.CellWidth * Len(HitCount) - Len(HitCount) + NumSpc * 2 + 1
  154.         Y = PicClip.CellHeight + NumSpc * 2
  155.         If BorderStyle = Fixed Then X = X + 2: Y = Y + 2
  156.         UserControl.Width = ScaleX(X, ScaleMode, 1)
  157.         UserControl.Height = ScaleX(Y, ScaleMode, 1)
  158.     End If
  159.     Initialized = True
  160. End Sub
  161. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  162.     PropBag.WriteProperty "BackColor", UserControl.BackColor, D_GRAY
  163.     PropBag.WriteProperty "BorderStyle", UserControl.BorderStyle, None
  164.     PropBag.WriteProperty "Space", NumSpc, 2
  165.     PropBag.WriteProperty "NumeralCount", Nums, 0
  166.     PropBag.WriteProperty "NumeralPicture", Picture, Nothing
  167. End Sub
  168. Private Sub LoadNumerals()
  169.     For NumCnt = 0 To CHAR_CNT - 1
  170.         ReDim Preserve Numerals(0 To NumCnt)
  171.         Set Numerals(NumCnt) = PicClip.GraphicCell(NumCnt)
  172.     Next NumCnt
  173. End Sub
  174. Public Sub ResetHits(Optional ResetValue As Long)
  175.     If Not Initialized Then Exit Sub
  176.     HitCnt = ResetValue - 1
  177.     PerformHit
  178.     Display
  179. End Sub
  180. Public Function HitCount() As String
  181. Dim RegHits As Long
  182.     RegHits = Abs(Val(GetSetting(TITLE, Parent.Name & "." & Ambient.DisplayName, KEY, 0)))
  183.     HitCount = Format(RegHits, String(Nums, "0"))
  184. End Function
  185. Public Sub PerformHit()
  186. Dim i As Integer
  187.     If InRunMode Then i = 1
  188.     HitCnt = Val(HitCnt) + i
  189.     SaveSetting TITLE, Parent.Name & "." & Ambient.DisplayName, KEY, HitCnt
  190.     Display
  191. End Sub
  192. Private Sub Display()
  193. Dim CharCnt As Integer
  194. Dim i As Integer, CurNum As Integer
  195. Dim X As Integer
  196.     KillBoxes
  197.     UserControl_Resize
  198.     CharCnt = Len(HitCount)
  199.     X = NumSpc
  200.     For i = 1 To CharCnt
  201.         Load Numeral(i)
  202.         CurNum = Val(Right(Left(HitCount, i), 1))
  203.         Numeral(i).Left = X
  204.         Numeral(i).Top = NumSpc
  205.         Numeral(i).Visible = True
  206.         Numeral(i).Picture = Numerals(CurNum)
  207.         X = X + Numeral(i).Width - 1
  208.     Next i
  209. End Sub
  210. Private Sub KillBoxes()
  211. Dim BoxCount As Integer
  212.     On Error Resume Next
  213.     For BoxCount = CHAR_CNT To 1 Step -1
  214.         Unload Numeral(BoxCount)
  215.     Next BoxCount
  216. End Sub
  217.