Eigene ScrollBar für Eigenes ListControl..(Mein Kopf Raucht!)

  • VB.NET

Es gibt 49 Antworten in diesem Thema. Der letzte Beitrag () ist von Baa$.

    So hier zum Letzten Update der ScrollBaas die ich hier Posten werde!

    VerticalScrollBaas ->
    Spoiler anzeigen

    VB.NET-Quellcode

    1. ' ___ ___ ___ ___ _ _ ___ _ _ ___
    2. ' / __|/ __| _ \/ _ \| | | | | _ ) /_\ /_\ / __|
    3. ' \__ \ (__| / (_) | |__| |__| _ \/ _ \ / _ \\__ \
    4. ' |___/\___|_|_\\___/|____|____|___/_/ \_\/_/ \_\___/
    5. ' VerticalScrollBaas v0.0.3 Beta
    6. ' 2021 by Baa$ aka Huchti591
    7. ' Helpers Credits on vb-paradise.de From RodFromGermany & Takafusa
    8. Option Strict On
    9. Imports System.ComponentModel
    10. Imports System.Drawing.Drawing2D
    11. Public Class VerticalScrollBaas
    12. Inherits Control
    13. #Region "Events"
    14. Public Event Scroll()
    15. Public Event ValueChanged(sender As VerticalScrollBaas, value As Integer)
    16. #End Region
    17. Sub New()
    18. SetStyle(ControlStyles.AllPaintingInWmPaint, True)
    19. SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
    20. SetStyle(ControlStyles.ResizeRedraw, True)
    21. SetStyle(ControlStyles.UserPaint, True)
    22. UpdateStyles()
    23. Size = New Size(6, 150)
    24. End Sub
    25. #Region "Deklaration"
    26. #Region "Rectangles"
    27. Private Track As Rectangle
    28. Private Thumb As Rectangle
    29. #End Region
    30. #Region "GraphicParts"
    31. Private ThumbGPath As New GraphicsPath
    32. Private TrackGPath As New GraphicsPath
    33. #End Region
    34. #Region "Integers"
    35. Private ThumbSize As Integer
    36. Private ThumbY As Integer
    37. Private OffSet As Integer
    38. #End Region
    39. #Region "Clicks"
    40. Private TrackClick As Boolean = False
    41. Private ThumbClick As Boolean = False
    42. #End Region
    43. #End Region
    44. #Region "Propertys"
    45. #Region "Main"
    46. Private _Value As Integer
    47. <Category("ScrollBar"), Description("It is used to Obtain or set a value in a ScrollBaas Control that indicates a ScrollBox's current Position.")>
    48. Public Property Value As Integer
    49. Get
    50. Return _Value
    51. End Get
    52. Set(value As Integer)
    53. _Value = value
    54. If _Value >= Maximum Then
    55. _Value = Maximum
    56. ElseIf _Value <= Minimum Then
    57. _Value = Minimum
    58. End If
    59. RaiseEvent ValueChanged(Me, value)
    60. Invalidate()
    61. End Set
    62. End Property
    63. Private _Minimum As Integer = 0
    64. <Category("ScrollBar"), Description("It is used to get or set the Minimum value of the ScrollBaas Control. By Default it is 0.")>
    65. Public Property Minimum As Integer
    66. Get
    67. Return _Minimum
    68. End Get
    69. Set(value As Integer)
    70. _Minimum = value
    71. Invalidate()
    72. End Set
    73. End Property
    74. Private _Maximum As Integer = 100
    75. <Category("ScrollBar"), Description("It is used to set or get the Maximum value of the ScrollBaas Control. The Default is 100.")>
    76. Public Property Maximum As Integer
    77. Get
    78. Return _Maximum
    79. End Get
    80. Set(value As Integer)
    81. _Maximum = value
    82. Invalidate()
    83. End Set
    84. End Property
    85. Private _SmallChange As Integer = 1
    86. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a short Distance.")>
    87. Public Property SmallChange As Integer
    88. Get
    89. Return _SmallChange
    90. End Get
    91. Set(value As Integer)
    92. _SmallChange = value
    93. Invalidate()
    94. End Set
    95. End Property
    96. Private _LargeChange As Integer = 10
    97. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a large Distance.")>
    98. Public Property LargeChange As Integer
    99. Get
    100. Return _LargeChange
    101. End Get
    102. Set(value As Integer)
    103. _LargeChange = value
    104. Invalidate()
    105. End Set
    106. End Property
    107. #End Region
    108. #Region "Style"
    109. Private _TrackColor As Color = Color.FromArgb(180, 216, 216, 216)
    110. <Category("Style"), Description("Change the Color of the Track.")>
    111. Public Property TrackColor As Color
    112. Get
    113. Return _TrackColor
    114. End Get
    115. Set(value As Color)
    116. _TrackColor = value
    117. Invalidate()
    118. End Set
    119. End Property
    120. Private _ThumbColor As Color = Color.FromArgb(180, 216, 216, 31)
    121. <Category("Style"), Description("Change the Color of the Thumb.")>
    122. Public Property ThumbColor As Color
    123. Get
    124. Return _ThumbColor
    125. End Get
    126. Set(value As Color)
    127. _ThumbColor = value
    128. Invalidate()
    129. End Set
    130. End Property
    131. Private _ThumbHoverColor As Color = Color.FromArgb(180, 225, 188, 0)
    132. <Category("Style"), Description("Change the Color of Thumb when the Mouse is on it.")>
    133. Public Property ThumbHoverColor As Color
    134. Get
    135. Return _ThumbHoverColor
    136. End Get
    137. Set(value As Color)
    138. _ThumbHoverColor = value
    139. Invalidate()
    140. End Set
    141. End Property
    142. #End Region
    143. #End Region
    144. #End Region
    145. #Region "Mouse"
    146. Private Enum MouseState
    147. Hover
    148. Click
    149. None
    150. End Enum
    151. Private _MouseState As MouseState = MouseState.None
    152. Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
    153. MyBase.OnMouseMove(e)
    154. If ThumbClick = True Then
    155. If ThumbY < Minimum Then
    156. ThumbY = Minimum
    157. ElseIf ThumbY > Track.Height - ThumbSize Then
    158. ThumbY = Track.Height - ThumbSize
    159. Else
    160. ThumbY = ThumbY + (e.Y - OffSet)
    161. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    162. RaiseEvent Scroll()
    163. End If
    164. End If
    165. If TrackGPath.IsVisible(e.Location) OrElse ThumbGPath.IsVisible(e.Location) Then
    166. _MouseState = MouseState.Hover
    167. End If
    168. OffSet = e.Y
    169. Invalidate()
    170. End Sub
    171. Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
    172. MyBase.OnMouseDown(e)
    173. If e.Button = MouseButtons.Left Then
    174. If ThumbGPath.IsVisible(e.Location) Then
    175. OffSet = e.Y
    176. ThumbClick = True
    177. ElseIf TrackGPath.IsVisible(e.Location) Then
    178. TrackClick = True
    179. End If
    180. End If
    181. Invalidate()
    182. End Sub
    183. Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
    184. MyBase.OnMouseClick(e)
    185. If TrackGPath.IsVisible(e.Location) Then
    186. If e.Y < ThumbY Then 'Über Thumb Click!
    187. ThumbY -= BackPercentage(Track.Height - ThumbSize, LargeChange)
    188. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    189. RaiseEvent Scroll()
    190. ElseIf e.Y > ThumbY + ThumbSize Then 'Unter Thumb Click!
    191. If ThumbY > Track.Height Then
    192. ThumbY = Track.Height - ThumbSize
    193. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    194. RaiseEvent Scroll()
    195. Else
    196. ThumbY += BackPercentage(Track.Height - ThumbSize, LargeChange)
    197. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    198. RaiseEvent Scroll()
    199. End If
    200. End If
    201. End If
    202. Invalidate()
    203. End Sub
    204. Protected Overrides Sub OnMouseWheel(e As MouseEventArgs)
    205. MyBase.OnMouseWheel(e)
    206. Select Case e.Delta
    207. Case Is <= -1 'Runterscrollen
    208. If ThumbY < Minimum Then
    209. ThumbY = Minimum
    210. Else
    211. ThumbY -= BackPercentage(Track.Height - ThumbSize, SmallChange)
    212. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    213. RaiseEvent Scroll()
    214. End If
    215. Case Is >= 1 'Hochscrollen
    216. If ThumbY > Track.Height - ThumbSize Then
    217. ThumbY = Track.Height - ThumbSize
    218. Else
    219. ThumbY += BackPercentage(Track.Height - ThumbSize, SmallChange)
    220. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    221. RaiseEvent Scroll()
    222. End If
    223. End Select
    224. Invalidate()
    225. End Sub
    226. Protected Overrides Sub OnMouseLeave(e As EventArgs)
    227. MyBase.OnMouseLeave(e)
    228. ThumbClick = False
    229. TrackClick = False
    230. _MouseState = MouseState.None
    231. Invalidate()
    232. End Sub
    233. Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
    234. MyBase.OnMouseUp(e)
    235. ThumbClick = False
    236. TrackClick = False
    237. _MouseState = MouseState.None
    238. Invalidate()
    239. End Sub
    240. #End Region
    241. #Region "Keyboard"
    242. Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
    243. MyBase.OnKeyDown(e)
    244. Select Case e.KeyCode
    245. Case Keys.PageUp '- LargeChange
    246. If ThumbY <= Minimum Then
    247. ThumbY = Minimum
    248. Else
    249. ThumbY -= BackPercentage(Track.Height - ThumbSize, LargeChange)
    250. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    251. RaiseEvent Scroll()
    252. End If
    253. Case Keys.PageDown '+ LargeChange
    254. If ThumbY >= Track.Height - ThumbSize Then
    255. ThumbY = Track.Height - ThumbSize
    256. Else
    257. ThumbY += BackPercentage(Track.Height - ThumbSize, LargeChange)
    258. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    259. RaiseEvent Scroll()
    260. End If
    261. Case Keys.Up '- SmallChange
    262. If ThumbY <= Minimum Then
    263. ThumbY = Minimum
    264. Else
    265. ThumbY -= BackPercentage(Track.Height - ThumbSize, SmallChange)
    266. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    267. RaiseEvent Scroll()
    268. End If
    269. Case Keys.Down '+ SmallChange
    270. If ThumbY >= Track.Height - ThumbSize Then
    271. ThumbY = Track.Height - ThumbSize
    272. Else
    273. ThumbY += BackPercentage(Track.Height - ThumbSize, SmallChange)
    274. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    275. RaiseEvent Scroll()
    276. End If
    277. End Select
    278. Invalidate()
    279. End Sub
    280. #End Region
    281. #Region "OnPaint"
    282. Protected Overrides Sub OnPaint(e As PaintEventArgs)
    283. MyBase.OnPaint(e)
    284. ThumbSize = Maximum - Minimum
    285. #Region "GParts"
    286. TrackGPath.Reset()
    287. TrackGPath.AddRectangle(Track)
    288. ThumbGPath.Reset()
    289. ThumbGPath.AddRectangle(Thumb)
    290. #End Region
    291. With e.Graphics
    292. Select Case _MouseState
    293. Case MouseState.None
    294. Size = New Size(6, Height)
    295. Track = New Rectangle(0, 0, 6, Height)
    296. .FillRectangle(New SolidBrush(TrackColor), Track)
    297. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    298. .FillRectangle(New SolidBrush(ThumbColor), Thumb)
    299. Case MouseState.Hover
    300. Size = New Size(12, Height)
    301. Track = New Rectangle(0, 0, 12, Height)
    302. .FillRectangle(New SolidBrush(TrackColor), Track)
    303. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    304. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    305. Case MouseState.Click
    306. Size = New Size(12, Height)
    307. Track = New Rectangle(0, 0, 12, Height)
    308. .FillRectangle(New SolidBrush(TrackColor), Track)
    309. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    310. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    311. End Select
    312. End With
    313. End Sub
    314. #End Region
    315. #Region "ScrollBaas Functions" 'With Integer-Division
    316. Private Function Percentage(Value As Integer, Maximum As Integer) As Integer
    317. Return (Value * _Maximum) \ Maximum
    318. End Function
    319. Private Function BackPercentage(Maximum As Integer, Change As Integer) As Integer
    320. Return (Maximum * _Maximum) \ Change
    321. End Function
    322. #End Region
    323. End Class


    HorizontalScrollBaas ->
    Spoiler anzeigen

    VB.NET-Quellcode

    1. ' ___ ___ ___ ___ _ _ ___ _ _ ___
    2. ' / __|/ __| _ \/ _ \| | | | | _ ) /_\ /_\ / __|
    3. ' \__ \ (__| / (_) | |__| |__| _ \/ _ \ / _ \\__ \
    4. ' |___/\___|_|_\\___/|____|____|___/_/ \_\/_/ \_\___/
    5. ' HorizontalScrollBaas v0.0.3 Beta
    6. ' 2021 by Baa$ aka Huchti591
    7. ' Helpers Credits on vb-paradise.de From RodFromGermany & Takafusa
    8. Option Strict On
    9. Imports System.ComponentModel
    10. Imports System.Drawing.Drawing2D
    11. Public Class HorizontalScrollBaas
    12. Inherits Control
    13. #Region "Events"
    14. Public Event Scroll()
    15. Public Event ValueChanged(sender As HorizontalScrollBaas, value As Integer)
    16. #End Region
    17. Sub New()
    18. SetStyle(ControlStyles.AllPaintingInWmPaint, True)
    19. SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
    20. SetStyle(ControlStyles.ResizeRedraw, True)
    21. SetStyle(ControlStyles.UserPaint, True)
    22. UpdateStyles()
    23. Size = New Size(150, 6)
    24. End Sub
    25. #Region "Deklaration"
    26. #Region "Rectangles"
    27. Private Track As Rectangle
    28. Private Thumb As Rectangle
    29. #End Region
    30. #Region "GraphicParts"
    31. Private ThumbGPath As New GraphicsPath
    32. Private TrackGPath As New GraphicsPath
    33. #End Region
    34. #Region "Integers"
    35. Private ThumbSize As Integer
    36. Private ThumbX As Integer
    37. Private OffSet As Integer
    38. #End Region
    39. #Region "Clicks"
    40. Private TrackClick As Boolean = False
    41. Private ThumbClick As Boolean = False
    42. #End Region
    43. #End Region
    44. #Region "Propertys"
    45. #Region "Main"
    46. Private _Value As Integer
    47. <Category("ScrollBar"), Description("It is used to Obtain or set a value in a ScrollBaas Control that indicates a ScrollBox's current Position.")>
    48. Public Property Value As Integer
    49. Get
    50. Return _Value
    51. End Get
    52. Set(value As Integer)
    53. _Value = value
    54. If _Value >= Maximum Then
    55. _Value = Maximum
    56. ElseIf _Value <= Minimum Then
    57. _Value = Minimum
    58. End If
    59. RaiseEvent ValueChanged(Me, value)
    60. Invalidate()
    61. End Set
    62. End Property
    63. Private _Minimum As Integer = 0
    64. <Category("ScrollBar"), Description("It is used to get or set the Minimum value of the ScrollBaas Control. By Default it is 0.")>
    65. Public Property Minimum As Integer
    66. Get
    67. Return _Minimum
    68. End Get
    69. Set(value As Integer)
    70. _Minimum = value
    71. Invalidate()
    72. End Set
    73. End Property
    74. Private _Maximum As Integer = 100
    75. <Category("ScrollBar"), Description("It is used to set or get the Maximum value of the ScrollBaas Control. The Default is 100.")>
    76. Public Property Maximum As Integer
    77. Get
    78. Return _Maximum
    79. End Get
    80. Set(value As Integer)
    81. _Maximum = value
    82. Invalidate()
    83. End Set
    84. End Property
    85. Private _SmallChange As Integer = 1
    86. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a short Distance.")>
    87. Public Property SmallChange As Integer
    88. Get
    89. Return _SmallChange
    90. End Get
    91. Set(value As Integer)
    92. _SmallChange = value
    93. Invalidate()
    94. End Set
    95. End Property
    96. Private _LargeChange As Integer = 10
    97. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a large Distance.")>
    98. Public Property LargeChange As Integer
    99. Get
    100. Return _LargeChange
    101. End Get
    102. Set(value As Integer)
    103. _LargeChange = value
    104. Invalidate()
    105. End Set
    106. End Property
    107. #End Region
    108. #Region "Style"
    109. Private _TrackColor As Color = Color.FromArgb(180, 216, 216, 216)
    110. <Category("Style"), Description("Change the Color of the Track.")>
    111. Public Property TrackColor As Color
    112. Get
    113. Return _TrackColor
    114. End Get
    115. Set(value As Color)
    116. _TrackColor = value
    117. Invalidate()
    118. End Set
    119. End Property
    120. Private _ThumbColor As Color = Color.FromArgb(180, 216, 216, 31)
    121. <Category("Style"), Description("Change the Color of the Thumb.")>
    122. Public Property ThumbColor As Color
    123. Get
    124. Return _ThumbColor
    125. End Get
    126. Set(value As Color)
    127. _ThumbColor = value
    128. Invalidate()
    129. End Set
    130. End Property
    131. Private _ThumbHoverColor As Color = Color.FromArgb(180, 225, 188, 0)
    132. <Category("Style"), Description("Change the Color of Thumb when the Mouse is on it.")>
    133. Public Property ThumbHoverColor As Color
    134. Get
    135. Return _ThumbHoverColor
    136. End Get
    137. Set(value As Color)
    138. _ThumbHoverColor = value
    139. Invalidate()
    140. End Set
    141. End Property
    142. #End Region
    143. #End Region
    144. #Region "Mouse"
    145. Private Enum MouseState
    146. Hover
    147. Click
    148. None
    149. End Enum
    150. Private _MouseState As MouseState = MouseState.None
    151. Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
    152. MyBase.OnMouseMove(e)
    153. If ThumbClick = True Then
    154. If ThumbX < Minimum Then
    155. ThumbX = Minimum
    156. ElseIf ThumbX > Track.Width - ThumbSize Then
    157. ThumbX = Track.Width - ThumbSize
    158. Else
    159. ThumbX = ThumbX + (e.X - OffSet)
    160. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    161. RaiseEvent Scroll()
    162. End If
    163. End If
    164. If TrackGPath.IsVisible(e.Location) OrElse ThumbGPath.IsVisible(e.Location) Then
    165. _MouseState = MouseState.Hover
    166. End If
    167. OffSet = e.X
    168. Invalidate()
    169. End Sub
    170. Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
    171. MyBase.OnMouseDown(e)
    172. If e.Button = MouseButtons.Left Then
    173. If ThumbGPath.IsVisible(e.Location) Then
    174. OffSet = e.X
    175. ThumbClick = True
    176. ElseIf TrackGPath.IsVisible(e.Location) Then
    177. TrackClick = True
    178. End If
    179. End If
    180. Invalidate()
    181. End Sub
    182. Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
    183. MyBase.OnMouseClick(e)
    184. If TrackGPath.IsVisible(e.Location) Then
    185. If e.X < ThumbX Then 'Über Thumb Click!
    186. ThumbX -= BackPercentage(Track.Width - ThumbSize, LargeChange)
    187. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    188. RaiseEvent Scroll()
    189. ElseIf e.X > ThumbX + ThumbSize Then 'Unter Thumb Click!
    190. If ThumbX > Track.Width Then
    191. ThumbX = Track.Width - ThumbSize
    192. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    193. RaiseEvent Scroll()
    194. Else
    195. ThumbX += BackPercentage(Track.Width - ThumbSize, LargeChange)
    196. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    197. RaiseEvent Scroll()
    198. End If
    199. End If
    200. End If
    201. Invalidate()
    202. End Sub
    203. Protected Overrides Sub OnMouseWheel(e As MouseEventArgs)
    204. MyBase.OnMouseWheel(e)
    205. Select Case e.Delta
    206. Case Is <= -1 'Runterscrollen
    207. If ThumbX < Minimum Then
    208. ThumbX = Minimum
    209. Else
    210. ThumbX -= BackPercentage(Track.Width - ThumbSize, SmallChange)
    211. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    212. RaiseEvent Scroll()
    213. End If
    214. Case Is >= 1 'Hochscrollen
    215. If ThumbX > Track.Width - ThumbSize Then
    216. ThumbX = Track.Width - ThumbSize
    217. Else
    218. ThumbX += BackPercentage(Track.Width - ThumbSize, SmallChange)
    219. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    220. RaiseEvent Scroll()
    221. End If
    222. End Select
    223. Invalidate()
    224. End Sub
    225. Protected Overrides Sub OnMouseLeave(e As EventArgs)
    226. MyBase.OnMouseLeave(e)
    227. ThumbClick = False
    228. TrackClick = False
    229. _MouseState = MouseState.None
    230. Invalidate()
    231. End Sub
    232. Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
    233. MyBase.OnMouseUp(e)
    234. ThumbClick = False
    235. TrackClick = False
    236. _MouseState = MouseState.None
    237. Invalidate()
    238. End Sub
    239. #End Region
    240. #Region "Keyboard"
    241. Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
    242. MyBase.OnKeyDown(e)
    243. Select Case e.KeyCode
    244. Case Keys.PageUp '- LargeChange
    245. If ThumbX <= Minimum Then
    246. ThumbX = Minimum
    247. Else
    248. ThumbX -= BackPercentage(Track.Width - ThumbSize, LargeChange)
    249. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    250. RaiseEvent Scroll()
    251. End If
    252. Case Keys.PageDown '+ LargeChange
    253. If ThumbX >= Track.Width - ThumbSize Then
    254. ThumbX = Track.Width - ThumbSize
    255. Else
    256. ThumbX += BackPercentage(Track.Width - ThumbSize, LargeChange)
    257. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    258. RaiseEvent Scroll()
    259. End If
    260. Case Keys.Up '- SmallChange
    261. If ThumbX <= Minimum Then
    262. ThumbX = Minimum
    263. Else
    264. ThumbX -= BackPercentage(Track.Width - ThumbSize, SmallChange)
    265. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    266. RaiseEvent Scroll()
    267. End If
    268. Case Keys.Down '+ SmallChange
    269. If ThumbX >= Track.Width - ThumbSize Then
    270. ThumbX = Track.Width - ThumbSize
    271. Else
    272. ThumbX += BackPercentage(Track.Width - ThumbSize, SmallChange)
    273. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    274. RaiseEvent Scroll()
    275. End If
    276. End Select
    277. Invalidate()
    278. End Sub
    279. #End Region
    280. #Region "OnPaint"
    281. Protected Overrides Sub OnPaint(e As PaintEventArgs)
    282. MyBase.OnPaint(e)
    283. ThumbSize = Maximum - Minimum
    284. #Region "GParts"
    285. TrackGPath.Reset()
    286. TrackGPath.AddRectangle(Track)
    287. ThumbGPath.Reset()
    288. ThumbGPath.AddRectangle(Thumb)
    289. #End Region
    290. With e.Graphics
    291. Select Case _MouseState
    292. Case MouseState.None
    293. Size = New Size(Width, 6)
    294. Track = New Rectangle(0, 0, Width, 6)
    295. .FillRectangle(New SolidBrush(TrackColor), Track)
    296. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    297. .FillRectangle(New SolidBrush(ThumbColor), Thumb)
    298. Case MouseState.Hover
    299. Size = New Size(Width, 12)
    300. Track = New Rectangle(0, 0, Width, 12)
    301. .FillRectangle(New SolidBrush(TrackColor), Track)
    302. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    303. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    304. Case MouseState.Click
    305. Size = New Size(Width, 12)
    306. Track = New Rectangle(0, 0, Width, 12)
    307. .FillRectangle(New SolidBrush(TrackColor), Track)
    308. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    309. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    310. End Select
    311. End With
    312. End Sub
    313. #End Region
    314. #Region "ScrollBaas Functions" 'With Integer-Division
    315. Private Function Percentage(Value As Integer, Maximum As Integer) As Integer
    316. Return (Value * _Maximum) \ Maximum
    317. End Function
    318. Private Function BackPercentage(Maximum As Integer, Change As Integer) As Integer
    319. Return (Maximum * _Maximum) \ Change
    320. End Function
    321. #End Region
    322. End Class


    Eigentlich hatte ich vor die ScrollBaas noch mit RoundEdges und Transparents zuversehen... Allerdings habe ich mich dazu entschieden eine mehr oder weniger Kleines Framework zuschreiben... Weil es Wesentlich schwieriger für mich ist in den Windows Standart controls mit ScrollBars meine ScrollBaas zu implementieren als eigene Lists&Controls zuschreiben... was auch am besten lösbar für RoundEdges& Transparents etc.. pp ist.. Leider ist mein Laptop Kaputt & ich im moment bei meiner Arbeit hart gefordert aber in Ferner zukunft werde ich denke ich hier irgendwo im Forum ein Framework von mir Publizieren... Damit sage ich in diesem Sinne ein Wundervolles Danke & REINGEHAUEN! Euer Baa$ aka Huchti591
    @Baa$ Ich hab mal ein wenig rumgespielt.
    Danke für die Erwähnung von @Takafusa und mir im Header des Quelltextes.
    ####
    Zunächst habe ich Deine Events auf WinForm-Standard mit ScrollEventArgs umgestellt, das erleichtert einem Nutzer die Umstellung von WinForm- auf Deine Scrollbars.
    Dann hab ich das Default-Event auf das Scroll-Event festgelegt, so dass bei Doppelklick auf das Control dieses Event generiert wird.
    Und dann hab ich beide Controls auf eine Form gezogen und mit Dock unten bzw. rechts angeheftet.
    Die Scroll-Position gebe ich bei Scroll in je einem Label aus.
    So weit so gut.
    ####
    Die Bereiche der Scrollpositionen sind dynamisch abhängig von der Größe der Form, das ist ein NoGo.
    Wenn Du den Thumb nach unten bzw. rechts ziehst und danach die Form verkleinerst, ist der Thuimb verschwunden^, das Klicken auf die Bars gibt merkwürdige Resultate, das ist ein NoGo.
    In diesem Zustand habe ich die Tests beendet.
    Sorry.
    MainForm

    VB.NET-Quellcode

    1. Public Class Form1
    2. Private Sub HorizontalScrollBaas1_Scroll(sender As Object, e As ScrollEventArgs) Handles HorizontalScrollBaas1.Scroll
    3. Label1.Text = "H-Pos = " & e.NewValue.ToString()
    4. End Sub
    5. Private Sub VerticalScrollBaas1_Scroll(sender As Object, e As ScrollEventArgs) Handles VerticalScrollBaas1.Scroll
    6. Label2.Text = "V-Pos = " & e.NewValue.ToString()
    7. End Sub
    8. End Class
    HorizontalScrollBaas

    VB.NET-Quellcode

    1. ' ___ ___ ___ ___ _ _ ___ _ _ ___
    2. ' / __|/ __| _ \/ _ \| | | | | _ ) /_\ /_\ / __|
    3. ' \__ \ (__| / (_) | |__| |__| _ \/ _ \ / _ \\__ \
    4. ' |___/\___|_|_\\___/|____|____|___/_/ \_\/_/ \_\___/
    5. ' HorizontalScrollBaas v0.0.3 Beta
    6. ' 2021 by Baa$ aka Huchti591
    7. ' Helpers Credits on vb-paradise.de From RodFromGermany & Takafusa
    8. Option Strict On
    9. Imports System.ComponentModel
    10. Imports System.Drawing.Drawing2D
    11. <DefaultEvent("Scroll")>
    12. Public Class HorizontalScrollBaas
    13. Inherits Control
    14. #Region "Events"
    15. Public Event Scroll(sender As Object, e As ScrollEventArgs)
    16. Public Event ValueChanged(sender As Object, e As ScrollEventArgs)
    17. #End Region
    18. Sub New()
    19. SetStyle(ControlStyles.AllPaintingInWmPaint, True)
    20. SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
    21. SetStyle(ControlStyles.ResizeRedraw, True)
    22. SetStyle(ControlStyles.UserPaint, True)
    23. UpdateStyles()
    24. Size = New Size(150, 6)
    25. End Sub
    26. #Region "Deklaration"
    27. #Region "Rectangles"
    28. Private Track As Rectangle
    29. Private Thumb As Rectangle
    30. #End Region
    31. #Region "GraphicParts"
    32. Private ThumbGPath As New GraphicsPath
    33. Private TrackGPath As New GraphicsPath
    34. #End Region
    35. #Region "Integers"
    36. Private ThumbSize As Integer
    37. Private ThumbX As Integer
    38. Private OffSet As Integer
    39. #End Region
    40. #Region "Clicks"
    41. Private TrackClick As Boolean = False
    42. Private ThumbClick As Boolean = False
    43. #End Region
    44. #End Region
    45. #Region "Propertys"
    46. #Region "Main"
    47. Private _Value As Integer
    48. <Category("ScrollBar"), Description("It is used to Obtain or set a value in a ScrollBaas Control that indicates a ScrollBox's current Position.")>
    49. Public Property Value As Integer
    50. Get
    51. Return _Value
    52. End Get
    53. Set(value As Integer)
    54. _Value = value
    55. If _Value >= Maximum Then
    56. _Value = Maximum
    57. ElseIf _Value <= Minimum Then
    58. _Value = Minimum
    59. End If
    60. RaiseEvent ValueChanged(Me, New ScrollEventArgs(ScrollEventType.ThumbPosition, _Value))
    61. Invalidate()
    62. End Set
    63. End Property
    64. Private _Minimum As Integer = 0
    65. <Category("ScrollBar"), Description("It is used to get or set the Minimum value of the ScrollBaas Control. By Default it is 0.")>
    66. Public Property Minimum As Integer
    67. Get
    68. Return _Minimum
    69. End Get
    70. Set(value As Integer)
    71. _Minimum = value
    72. Invalidate()
    73. End Set
    74. End Property
    75. Private _Maximum As Integer = 100
    76. <Category("ScrollBar"), Description("It is used to set or get the Maximum value of the ScrollBaas Control. The Default is 100.")>
    77. Public Property Maximum As Integer
    78. Get
    79. Return _Maximum
    80. End Get
    81. Set(value As Integer)
    82. _Maximum = value
    83. Invalidate()
    84. End Set
    85. End Property
    86. Private _SmallChange As Integer = 1
    87. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a short Distance.")>
    88. Public Property SmallChange As Integer
    89. Get
    90. Return _SmallChange
    91. End Get
    92. Set(value As Integer)
    93. _SmallChange = value
    94. Invalidate()
    95. End Set
    96. End Property
    97. Private _LargeChange As Integer = 10
    98. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a large Distance.")>
    99. Public Property LargeChange As Integer
    100. Get
    101. Return _LargeChange
    102. End Get
    103. Set(value As Integer)
    104. _LargeChange = value
    105. Invalidate()
    106. End Set
    107. End Property
    108. #End Region
    109. #Region "Style"
    110. Private _TrackColor As Color = Color.FromArgb(180, 216, 216, 216)
    111. <Category("Style"), Description("Change the Color of the Track.")>
    112. Public Property TrackColor As Color
    113. Get
    114. Return _TrackColor
    115. End Get
    116. Set(value As Color)
    117. _TrackColor = value
    118. Invalidate()
    119. End Set
    120. End Property
    121. Private _ThumbColor As Color = Color.FromArgb(180, 216, 216, 31)
    122. <Category("Style"), Description("Change the Color of the Thumb.")>
    123. Public Property ThumbColor As Color
    124. Get
    125. Return _ThumbColor
    126. End Get
    127. Set(value As Color)
    128. _ThumbColor = value
    129. Invalidate()
    130. End Set
    131. End Property
    132. Private _ThumbHoverColor As Color = Color.FromArgb(180, 225, 188, 0)
    133. <Category("Style"), Description("Change the Color of Thumb when the Mouse is on it.")>
    134. Public Property ThumbHoverColor As Color
    135. Get
    136. Return _ThumbHoverColor
    137. End Get
    138. Set(value As Color)
    139. _ThumbHoverColor = value
    140. Invalidate()
    141. End Set
    142. End Property
    143. #End Region
    144. #End Region
    145. #Region "Mouse"
    146. Private Enum MouseState
    147. Hover
    148. Click
    149. None
    150. End Enum
    151. Private _MouseState As MouseState = MouseState.None
    152. Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
    153. MyBase.OnMouseMove(e)
    154. If ThumbClick Then
    155. Dim typ As ScrollEventType
    156. If ThumbX < Minimum Then
    157. ThumbX = Minimum
    158. typ = ScrollEventType.First
    159. ElseIf ThumbX > Track.Width - ThumbSize Then
    160. ThumbX = Track.Width - ThumbSize
    161. typ = ScrollEventType.Last
    162. Else
    163. ThumbX = ThumbX + (e.X - OffSet)
    164. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    165. typ = ScrollEventType.ThumbPosition
    166. End If
    167. RaiseEvent Scroll(Me, New ScrollEventArgs(typ, ThumbX))
    168. End If
    169. If TrackGPath.IsVisible(e.Location) OrElse ThumbGPath.IsVisible(e.Location) Then
    170. _MouseState = MouseState.Hover
    171. End If
    172. OffSet = e.X
    173. Invalidate()
    174. End Sub
    175. Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
    176. MyBase.OnMouseDown(e)
    177. If e.Button = MouseButtons.Left Then
    178. If ThumbGPath.IsVisible(e.Location) Then
    179. OffSet = e.X
    180. ThumbClick = True
    181. ElseIf TrackGPath.IsVisible(e.Location) Then
    182. TrackClick = True
    183. End If
    184. End If
    185. Invalidate()
    186. End Sub
    187. Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
    188. MyBase.OnMouseClick(e)
    189. If TrackGPath.IsVisible(e.Location) Then
    190. If e.X < ThumbX Then 'Über Thumb Click!
    191. ThumbX -= BackPercentage(Track.Width - ThumbSize, LargeChange)
    192. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    193. ElseIf e.X > ThumbX + ThumbSize Then 'Unter Thumb Click!
    194. If ThumbX > Track.Width Then
    195. ThumbX = Track.Width - ThumbSize
    196. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    197. Else
    198. ThumbX += BackPercentage(Track.Width - ThumbSize, LargeChange)
    199. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    200. End If
    201. End If
    202. RaiseEvent Scroll(Me, New ScrollEventArgs(ScrollEventType.ThumbPosition, ThumbX))
    203. End If
    204. Invalidate()
    205. End Sub
    206. Protected Overrides Sub OnMouseWheel(e As MouseEventArgs)
    207. MyBase.OnMouseWheel(e)
    208. Dim typ As ScrollEventType
    209. Select Case e.Delta
    210. Case Is <= -1 'Runterscrollen
    211. If ThumbX < Minimum Then
    212. ThumbX = Minimum
    213. typ = ScrollEventType.First
    214. Else
    215. ThumbX -= BackPercentage(Track.Width - ThumbSize, SmallChange)
    216. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    217. typ = ScrollEventType.ThumbPosition
    218. End If
    219. Case Is >= 1 'Hochscrollen
    220. If ThumbX > Track.Width - ThumbSize Then
    221. ThumbX = Track.Width - ThumbSize
    222. typ = ScrollEventType.Last
    223. Else
    224. ThumbX += BackPercentage(Track.Width - ThumbSize, SmallChange)
    225. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    226. typ = ScrollEventType.ThumbPosition
    227. End If
    228. End Select
    229. RaiseEvent Scroll(Me, New ScrollEventArgs(typ, ThumbX))
    230. Invalidate()
    231. End Sub
    232. Protected Overrides Sub OnMouseLeave(e As EventArgs)
    233. MyBase.OnMouseLeave(e)
    234. ThumbClick = False
    235. TrackClick = False
    236. _MouseState = MouseState.None
    237. Invalidate()
    238. End Sub
    239. Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
    240. MyBase.OnMouseUp(e)
    241. ThumbClick = False
    242. TrackClick = False
    243. _MouseState = MouseState.None
    244. Invalidate()
    245. End Sub
    246. #End Region
    247. #Region "Keyboard"
    248. Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
    249. MyBase.OnKeyDown(e)
    250. Dim typ As ScrollEventType
    251. Select Case e.KeyCode
    252. Case Keys.PageUp '- LargeChange
    253. If ThumbX <= Minimum Then
    254. ThumbX = Minimum
    255. typ = ScrollEventType.First
    256. Else
    257. ThumbX -= BackPercentage(Track.Width - ThumbSize, LargeChange)
    258. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    259. typ = ScrollEventType.LargeDecrement
    260. End If
    261. Case Keys.PageDown '+ LargeChange
    262. If ThumbX >= Track.Width - ThumbSize Then
    263. ThumbX = Track.Width - ThumbSize
    264. typ = ScrollEventType.Last
    265. Else
    266. ThumbX += BackPercentage(Track.Width - ThumbSize, LargeChange)
    267. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    268. typ = ScrollEventType.LargeIncrement
    269. End If
    270. Case Keys.Up '- SmallChange
    271. If ThumbX <= Minimum Then
    272. ThumbX = Minimum
    273. typ = ScrollEventType.First
    274. Else
    275. ThumbX -= BackPercentage(Track.Width - ThumbSize, SmallChange)
    276. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    277. typ = ScrollEventType.SmallDecrement
    278. End If
    279. Case Keys.Down '+ SmallChange
    280. If ThumbX >= Track.Width - ThumbSize Then
    281. ThumbX = Track.Width - ThumbSize
    282. typ = ScrollEventType.Last
    283. Else
    284. ThumbX += BackPercentage(Track.Width - ThumbSize, SmallChange)
    285. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    286. typ = ScrollEventType.SmallIncrement
    287. End If
    288. End Select
    289. RaiseEvent Scroll(Me, New ScrollEventArgs(typ, ThumbX))
    290. Invalidate()
    291. End Sub
    292. #End Region
    293. #Region "OnPaint"
    294. Protected Overrides Sub OnPaint(e As PaintEventArgs)
    295. MyBase.OnPaint(e)
    296. ThumbSize = Maximum - Minimum
    297. #Region "GParts"
    298. TrackGPath.Reset()
    299. TrackGPath.AddRectangle(Track)
    300. ThumbGPath.Reset()
    301. ThumbGPath.AddRectangle(Thumb)
    302. #End Region
    303. With e.Graphics
    304. Select Case _MouseState
    305. Case MouseState.None
    306. Size = New Size(Width, 6)
    307. Track = New Rectangle(0, 0, Width, 6)
    308. .FillRectangle(New SolidBrush(TrackColor), Track)
    309. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    310. .FillRectangle(New SolidBrush(ThumbColor), Thumb)
    311. Case MouseState.Hover
    312. Size = New Size(Width, 12)
    313. Track = New Rectangle(0, 0, Width, 12)
    314. .FillRectangle(New SolidBrush(TrackColor), Track)
    315. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    316. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    317. Case MouseState.Click
    318. Size = New Size(Width, 12)
    319. Track = New Rectangle(0, 0, Width, 12)
    320. .FillRectangle(New SolidBrush(TrackColor), Track)
    321. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    322. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    323. End Select
    324. End With
    325. End Sub
    326. #End Region
    327. #Region "ScrollBaas Functions" 'With Integer-Division
    328. Private Function Percentage(Value As Integer, Maximum As Integer) As Integer
    329. Return (Value * _Maximum) \ Maximum
    330. End Function
    331. Private Function BackPercentage(Maximum As Integer, Change As Integer) As Integer
    332. Return (Maximum * _Maximum) \ Change
    333. End Function
    334. #End Region
    335. End Class
    VerticalScrollBaas

    VB.NET-Quellcode

    1. ' ___ ___ ___ ___ _ _ ___ _ _ ___
    2. ' / __|/ __| _ \/ _ \| | | | | _ ) /_\ /_\ / __|
    3. ' \__ \ (__| / (_) | |__| |__| _ \/ _ \ / _ \\__ \
    4. ' |___/\___|_|_\\___/|____|____|___/_/ \_\/_/ \_\___/
    5. ' VerticalScrollBaas v0.0.3 Beta
    6. ' 2021 by Baa$ aka Huchti591
    7. ' Helpers Credits on vb-paradise.de From RodFromGermany & Takafusa
    8. Option Strict On
    9. Imports System.ComponentModel
    10. Imports System.Drawing.Drawing2D
    11. <DefaultEvent("Scroll")>
    12. Public Class VerticalScrollBaas
    13. Inherits Control
    14. #Region "Events"
    15. Public Event Scroll(sender As Object, e As ScrollEventArgs)
    16. Public Event ValueChanged(sender As Object, e As ScrollEventArgs)
    17. #End Region
    18. Sub New()
    19. SetStyle(ControlStyles.AllPaintingInWmPaint, True)
    20. SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
    21. SetStyle(ControlStyles.ResizeRedraw, True)
    22. SetStyle(ControlStyles.UserPaint, True)
    23. UpdateStyles()
    24. Size = New Size(6, 150)
    25. End Sub
    26. #Region "Deklaration"
    27. #Region "Rectangles"
    28. Private Track As Rectangle
    29. Private Thumb As Rectangle
    30. #End Region
    31. #Region "GraphicParts"
    32. Private ThumbGPath As New GraphicsPath
    33. Private TrackGPath As New GraphicsPath
    34. #End Region
    35. #Region "Integers"
    36. Private ThumbSize As Integer
    37. Private ThumbY As Integer
    38. Private OffSet As Integer
    39. #End Region
    40. #Region "Clicks"
    41. Private TrackClick As Boolean = False
    42. Private ThumbClick As Boolean = False
    43. #End Region
    44. #End Region
    45. #Region "Propertys"
    46. #Region "Main"
    47. Private _Value As Integer
    48. <Category("ScrollBar"), Description("It is used to Obtain or set a value in a ScrollBaas Control that indicates a ScrollBox's current Position.")>
    49. Public Property Value As Integer
    50. Get
    51. Return _Value
    52. End Get
    53. Set(value As Integer)
    54. _Value = value
    55. If _Value >= Maximum Then
    56. _Value = Maximum
    57. ElseIf _Value <= Minimum Then
    58. _Value = Minimum
    59. End If
    60. RaiseEvent ValueChanged(Me, New ScrollEventArgs(ScrollEventType.ThumbPosition, _Value))
    61. Invalidate()
    62. End Set
    63. End Property
    64. Private _Minimum As Integer = 0
    65. <Category("ScrollBar"), Description("It is used to get or set the Minimum value of the ScrollBaas Control. By Default it is 0.")>
    66. Public Property Minimum As Integer
    67. Get
    68. Return _Minimum
    69. End Get
    70. Set(value As Integer)
    71. _Minimum = value
    72. Invalidate()
    73. End Set
    74. End Property
    75. Private _Maximum As Integer = 100
    76. <Category("ScrollBar"), Description("It is used to set or get the Maximum value of the ScrollBaas Control. The Default is 100.")>
    77. Public Property Maximum As Integer
    78. Get
    79. Return _Maximum
    80. End Get
    81. Set(value As Integer)
    82. _Maximum = value
    83. Invalidate()
    84. End Set
    85. End Property
    86. Private _SmallChange As Integer = 1
    87. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a short Distance.")>
    88. Public Property SmallChange As Integer
    89. Get
    90. Return _SmallChange
    91. End Get
    92. Set(value As Integer)
    93. _SmallChange = value
    94. Invalidate()
    95. End Set
    96. End Property
    97. Private _LargeChange As Integer = 10
    98. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a large Distance.")>
    99. Public Property LargeChange As Integer
    100. Get
    101. Return _LargeChange
    102. End Get
    103. Set(value As Integer)
    104. _LargeChange = value
    105. Invalidate()
    106. End Set
    107. End Property
    108. #End Region
    109. #Region "Style"
    110. Private _TrackColor As Color = Color.FromArgb(180, 216, 216, 216)
    111. <Category("Style"), Description("Change the Color of the Track.")>
    112. Public Property TrackColor As Color
    113. Get
    114. Return _TrackColor
    115. End Get
    116. Set(value As Color)
    117. _TrackColor = value
    118. Invalidate()
    119. End Set
    120. End Property
    121. Private _ThumbColor As Color = Color.FromArgb(180, 216, 216, 31)
    122. <Category("Style"), Description("Change the Color of the Thumb.")>
    123. Public Property ThumbColor As Color
    124. Get
    125. Return _ThumbColor
    126. End Get
    127. Set(value As Color)
    128. _ThumbColor = value
    129. Invalidate()
    130. End Set
    131. End Property
    132. Private _ThumbHoverColor As Color = Color.FromArgb(180, 225, 188, 0)
    133. <Category("Style"), Description("Change the Color of Thumb when the Mouse is on it.")>
    134. Public Property ThumbHoverColor As Color
    135. Get
    136. Return _ThumbHoverColor
    137. End Get
    138. Set(value As Color)
    139. _ThumbHoverColor = value
    140. Invalidate()
    141. End Set
    142. End Property
    143. #End Region
    144. #End Region
    145. #Region "Mouse"
    146. Private Enum MouseState
    147. Hover
    148. Click
    149. None
    150. End Enum
    151. Private _MouseState As MouseState = MouseState.None
    152. Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
    153. MyBase.OnMouseMove(e)
    154. If ThumbClick Then
    155. Dim typ As ScrollEventType
    156. If ThumbY < Minimum Then
    157. ThumbY = Minimum
    158. typ = ScrollEventType.First
    159. ElseIf ThumbY > Track.Height - ThumbSize Then
    160. ThumbY = Track.Height - ThumbSize
    161. typ = ScrollEventType.Last
    162. Else
    163. ThumbY = ThumbY + (e.Y - OffSet)
    164. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    165. typ = ScrollEventType.ThumbPosition
    166. End If
    167. RaiseEvent Scroll(Me, New ScrollEventArgs(typ, ThumbY))
    168. End If
    169. If TrackGPath.IsVisible(e.Location) OrElse ThumbGPath.IsVisible(e.Location) Then
    170. _MouseState = MouseState.Hover
    171. End If
    172. OffSet = e.Y
    173. Invalidate()
    174. End Sub
    175. Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
    176. MyBase.OnMouseDown(e)
    177. If e.Button = MouseButtons.Left Then
    178. If ThumbGPath.IsVisible(e.Location) Then
    179. OffSet = e.Y
    180. ThumbClick = True
    181. ElseIf TrackGPath.IsVisible(e.Location) Then
    182. TrackClick = True
    183. End If
    184. End If
    185. Invalidate()
    186. End Sub
    187. Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
    188. MyBase.OnMouseClick(e)
    189. If TrackGPath.IsVisible(e.Location) Then
    190. If e.Y < ThumbY Then 'Über Thumb Click!
    191. ThumbY -= BackPercentage(Track.Height - ThumbSize, LargeChange)
    192. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    193. ElseIf e.Y > ThumbY + ThumbSize Then 'Unter Thumb Click!
    194. If ThumbY > Track.Height Then
    195. ThumbY = Track.Height - ThumbSize
    196. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    197. Else
    198. ThumbY += BackPercentage(Track.Height - ThumbSize, LargeChange)
    199. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    200. End If
    201. End If
    202. RaiseEvent Scroll(Me, New ScrollEventArgs(ScrollEventType.ThumbPosition, ThumbY))
    203. End If
    204. Invalidate()
    205. End Sub
    206. Protected Overrides Sub OnMouseWheel(e As MouseEventArgs)
    207. MyBase.OnMouseWheel(e)
    208. Dim typ As ScrollEventType
    209. Select Case e.Delta
    210. Case Is <= -1 'Runterscrollen
    211. If ThumbY < Minimum Then
    212. ThumbY = Minimum
    213. typ = ScrollEventType.First
    214. Else
    215. ThumbY -= BackPercentage(Track.Height - ThumbSize, SmallChange)
    216. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    217. typ = ScrollEventType.ThumbPosition
    218. End If
    219. Case Is >= 1 'Hochscrollen
    220. If ThumbY > Track.Height - ThumbSize Then
    221. ThumbY = Track.Height - ThumbSize
    222. typ = ScrollEventType.Last
    223. Else
    224. ThumbY += BackPercentage(Track.Height - ThumbSize, SmallChange)
    225. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    226. typ = ScrollEventType.ThumbPosition
    227. End If
    228. End Select
    229. RaiseEvent Scroll(Me, New ScrollEventArgs(typ, ThumbY))
    230. Invalidate()
    231. End Sub
    232. Protected Overrides Sub OnMouseLeave(e As EventArgs)
    233. MyBase.OnMouseLeave(e)
    234. ThumbClick = False
    235. TrackClick = False
    236. _MouseState = MouseState.None
    237. Invalidate()
    238. End Sub
    239. Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
    240. MyBase.OnMouseUp(e)
    241. ThumbClick = False
    242. TrackClick = False
    243. _MouseState = MouseState.None
    244. Invalidate()
    245. End Sub
    246. #End Region
    247. #Region "Keyboard"
    248. Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
    249. MyBase.OnKeyDown(e)
    250. Dim typ As ScrollEventType
    251. Select Case e.KeyCode
    252. Case Keys.PageUp '- LargeChange
    253. If ThumbY <= Minimum Then
    254. ThumbY = Minimum
    255. typ = ScrollEventType.First
    256. Else
    257. ThumbY -= BackPercentage(Track.Height - ThumbSize, LargeChange)
    258. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    259. typ = ScrollEventType.LargeDecrement
    260. End If
    261. Case Keys.PageDown '+ LargeChange
    262. If ThumbY >= Track.Height - ThumbSize Then
    263. ThumbY = Track.Height - ThumbSize
    264. typ = ScrollEventType.Last
    265. Else
    266. ThumbY += BackPercentage(Track.Height - ThumbSize, LargeChange)
    267. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    268. typ = ScrollEventType.LargeIncrement
    269. End If
    270. Case Keys.Up '- SmallChange
    271. If ThumbY <= Minimum Then
    272. ThumbY = Minimum
    273. typ = ScrollEventType.First
    274. Else
    275. ThumbY -= BackPercentage(Track.Height - ThumbSize, SmallChange)
    276. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    277. typ = ScrollEventType.SmallDecrement
    278. End If
    279. Case Keys.Down '+ SmallChange
    280. If ThumbY >= Track.Height - ThumbSize Then
    281. ThumbY = Track.Height - ThumbSize
    282. typ = ScrollEventType.Last
    283. Else
    284. ThumbY += BackPercentage(Track.Height - ThumbSize, SmallChange)
    285. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    286. typ = ScrollEventType.SmallIncrement
    287. End If
    288. End Select
    289. RaiseEvent Scroll(Me, New ScrollEventArgs(typ, ThumbY))
    290. Invalidate()
    291. End Sub
    292. #End Region
    293. #Region "OnPaint"
    294. Protected Overrides Sub OnPaint(e As PaintEventArgs)
    295. MyBase.OnPaint(e)
    296. ThumbSize = Maximum - Minimum
    297. #Region "GParts"
    298. TrackGPath.Reset()
    299. TrackGPath.AddRectangle(Track)
    300. ThumbGPath.Reset()
    301. ThumbGPath.AddRectangle(Thumb)
    302. #End Region
    303. With e.Graphics
    304. Select Case _MouseState
    305. Case MouseState.None
    306. Size = New Size(6, Height)
    307. Track = New Rectangle(0, 0, 6, Height)
    308. .FillRectangle(New SolidBrush(TrackColor), Track)
    309. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    310. .FillRectangle(New SolidBrush(ThumbColor), Thumb)
    311. Case MouseState.Hover
    312. Size = New Size(12, Height)
    313. Track = New Rectangle(0, 0, 12, Height)
    314. .FillRectangle(New SolidBrush(TrackColor), Track)
    315. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    316. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    317. Case MouseState.Click
    318. Size = New Size(12, Height)
    319. Track = New Rectangle(0, 0, 12, Height)
    320. .FillRectangle(New SolidBrush(TrackColor), Track)
    321. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    322. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    323. End Select
    324. End With
    325. End Sub
    326. #End Region
    327. #Region "ScrollBaas Functions" 'With Integer-Division
    328. Private Function Percentage(Value As Integer, Maximum As Integer) As Integer
    329. Return (Value * _Maximum) \ Maximum
    330. End Function
    331. Private Function BackPercentage(Maximum As Integer, Change As Integer) As Integer
    332. Return (Maximum * _Maximum) \ Change
    333. End Function
    334. #End Region
    335. End Class
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    @RodFromGermany
    Das mit den Events sehe ich ein, aber das wäre jetzt bald erst für mich Ausschlag gebend geworden...
    Da ich erstens um die ScrollBars mit Transparents und RoundCorners ein neues BasisControl schreibe... Und dann zum implementieren später in meine ListControls ein ScrollableControl(wo wie du schon einmal meintest das Autoscroll drinnen ist... Und unter anderem die Sichtbarkeiten der V & H Scrollbars bei Clientbereichsübergehung(hoffe habe es Grade richtig im Kopf) unter anderem kommt dort ein kleiner Platzhalter zwischenbeide ScrollBars(unten rechts) hoffe verstehst was ich meine...
    Deine NoGo's schaue ich mir später Mal genau an...

    Was ich gerade nicht verstehe wieso auf die Bars klicken komische Resultate ausgegeben werden sollten war bei meinen Tests nicht der Fall... Aber ich werde mir deine Anmerkungen bei dem entwickeln des Frameworks zuherzen nehmen. Danke dir

    PS.. bekommste du die NoGo's auch wenn du die Events lässt wie sie waren??

    Doppel PS.. hehe ich sehe einen Fehler gerade noch das das garnicht die Source war die ich eigentlich vorhatte zu Publizieren. Hehe das es dir nicht aufgefallen ist wundert mich etwas sehe es gerade durchs überfliegen... In den ScrollBaas sind ich Mouse Leave und Mouse Up beide drin... Eigentlich hatte ich das auch schon geändert gehabt... Hehe naja egal ist ja noch im Beta da darf das noch ❗

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Baa$“ ()

    @Baa$ Merkwürdige Klick-Effekte:
    Form mit 2 ScrollBaas.
    Ziehe ich die eine, komme ich von { 0 ... 328 }.
    Klicke ich mehrfach in die Mitte der Bar, komme ich
    Position = 0: { 0 ... 3280 }
    Position = 328: { 328 ... -2952 }
    NoGo.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!


    häää, also bei mir läuft es auch wenn ich form kleiner und wieder großmache auch mit deinen events.. was haste den dort gebastelt??? xD

    ah doch ich weiss was du meinst wenn man die form maximiert und dann wieder kleiner macht... sind die (Thumbs) ausserhalb... okay ich verstehe danke dir... ist glaube ich kein großes ding das zu fixen bis heute abend habe ich es ausgemertzt!
    ps.. bei mir bleibt das value aber auf 100 und geht nicht drüber.. nur thumb ist ausserhalb..

    wieder mal doppel ps. hä ich sehe gerade das beim click auf track(scrollbar) der wirklich unwillkürlich hopst.. das hatte ich eigentlich schon alles gefixxt hab echt eine falsche source gepostet ändere ich im laufe des nachmittags!

    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „Baa$“ ()

    Neu

    so habe jetzt die v0.0.4 Beta fertig
    Könnt sie ja mal abchecken und mich über Bugs informieren... ich versuche sie dann schnellst möglich zu fixen... :D :P

    VerticalScrollBaas v.0.0.4 Beta
    Spoiler anzeigen

    VB.NET-Quellcode

    1. ' ___ ___ ___ ___ _ _ ___ _ _ ___
    2. ' / __|/ __| _ \/ _ \| | | | | _ ) /_\ /_\ / __|
    3. ' \__ \ (__| / (_) | |__| |__| _ \/ _ \ / _ \\__ \
    4. ' |___/\___|_|_\\___/|____|____|___/_/ \_\/_/ \_\___/
    5. ' VerticalScrollBaas v0.0.4 Beta
    6. ' 2021 by Baa$ aka Huchti591
    7. ' Helpers Credits on vb-paradise.de From RodFromGermany & Takafusa
    8. Option Strict On
    9. Imports System.ComponentModel
    10. Imports System.Drawing.Drawing2D
    11. <DefaultEvent("Scroll")>
    12. Public Class VerticalScrollBaas
    13. Inherits Control
    14. #Region "Events"
    15. Public Event Scroll()
    16. Public Event ValueChanged(sender As Object, e As ScrollEventArgs)
    17. #End Region
    18. Sub New()
    19. SetStyle(ControlStyles.AllPaintingInWmPaint, True)
    20. SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
    21. SetStyle(ControlStyles.ResizeRedraw, True)
    22. SetStyle(ControlStyles.UserPaint, True)
    23. UpdateStyles()
    24. DoubleBuffered = True
    25. ResizeRedraw = True
    26. Size = New Size(6, 150)
    27. End Sub
    28. #Region "Deklaration"
    29. #Region "Rectangles"
    30. Private Track As Rectangle
    31. Private Thumb As Rectangle
    32. #End Region
    33. #Region "GraphicParts"
    34. Private ThumbGPath As New GraphicsPath
    35. Private TrackGPath As New GraphicsPath
    36. #End Region
    37. #Region "Integers"
    38. Private ThumbSize As Integer
    39. Private ThumbY As Integer
    40. Private OffSet As Integer
    41. #End Region
    42. #Region "Clicks"
    43. Private TrackClick As Boolean = False
    44. Private ThumbClick As Boolean = False
    45. #End Region
    46. #End Region
    47. #Region "Propertys"
    48. #Region "Main"
    49. Private _Value As Integer
    50. <Category("ScrollBar"), Description("It is used to Obtain or set a value in a ScrollBaas Control that indicates a ScrollBox's current Position.")>
    51. Public Property Value As Integer
    52. Get
    53. Return _Value
    54. End Get
    55. Set(value As Integer)
    56. _Value = value
    57. If _Value >= Maximum Then
    58. _Value = Maximum
    59. ElseIf _Value <= Minimum Then
    60. _Value = Minimum
    61. End If
    62. RaiseEvent ValueChanged(Me, New ScrollEventArgs(ScrollEventType.ThumbPosition, _Value))
    63. Invalidate()
    64. End Set
    65. End Property
    66. Private _Minimum As Integer = 0
    67. <Category("ScrollBar"), Description("It is used to get or set the Minimum value of the ScrollBaas Control. By Default it is 0.")>
    68. Public Property Minimum As Integer
    69. Get
    70. Return _Minimum
    71. End Get
    72. Set(value As Integer)
    73. _Minimum = value
    74. Invalidate()
    75. End Set
    76. End Property
    77. Private _Maximum As Integer = 100
    78. <Category("ScrollBar"), Description("It is used to set or get the Maximum value of the ScrollBaas Control. The Default is 100.")>
    79. Public Property Maximum As Integer
    80. Get
    81. Return _Maximum
    82. End Get
    83. Set(value As Integer)
    84. _Maximum = value
    85. Invalidate()
    86. End Set
    87. End Property
    88. Private _SmallChange As Integer = 1
    89. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a short Distance.")>
    90. Public Property SmallChange As Integer
    91. Get
    92. Return _SmallChange
    93. End Get
    94. Set(value As Integer)
    95. _SmallChange = value
    96. Invalidate()
    97. End Set
    98. End Property
    99. Private _LargeChange As Integer = 10
    100. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a large Distance.")>
    101. Public Property LargeChange As Integer
    102. Get
    103. Return _LargeChange
    104. End Get
    105. Set(value As Integer)
    106. _LargeChange = value
    107. Invalidate()
    108. End Set
    109. End Property
    110. #End Region
    111. #Region "Style"
    112. Private _TrackColor As Color = Color.FromArgb(180, 216, 216, 216)
    113. <Category("Style"), Description("Change the Color of the Track.")>
    114. Public Property TrackColor As Color
    115. Get
    116. Return _TrackColor
    117. End Get
    118. Set(value As Color)
    119. _TrackColor = value
    120. Invalidate()
    121. End Set
    122. End Property
    123. Private _ThumbColor As Color = Color.FromArgb(180, 216, 216, 31)
    124. <Category("Style"), Description("Change the Color of the Thumb.")>
    125. Public Property ThumbColor As Color
    126. Get
    127. Return _ThumbColor
    128. End Get
    129. Set(value As Color)
    130. _ThumbColor = value
    131. Invalidate()
    132. End Set
    133. End Property
    134. Private _ThumbHoverColor As Color = Color.FromArgb(180, 225, 188, 0)
    135. <Category("Style"), Description("Change the Color of Thumb when the Mouse is on it.")>
    136. Public Property ThumbHoverColor As Color
    137. Get
    138. Return _ThumbHoverColor
    139. End Get
    140. Set(value As Color)
    141. _ThumbHoverColor = value
    142. Invalidate()
    143. End Set
    144. End Property
    145. #End Region
    146. #End Region
    147. #Region "Mouse"
    148. Private Enum MouseState
    149. Hover
    150. Click
    151. None
    152. End Enum
    153. Private _MouseState As MouseState = MouseState.None
    154. Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
    155. MyBase.OnMouseMove(e)
    156. If ThumbClick = True Then
    157. If ThumbY < Minimum Then
    158. ThumbY = Minimum
    159. ElseIf ThumbY > Track.Height - ThumbSize Then
    160. ThumbY = Track.Height - ThumbSize
    161. Else
    162. ThumbY = ThumbY + (e.Y - OffSet)
    163. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    164. RaiseEvent Scroll()
    165. End If
    166. End If
    167. If TrackGPath.IsVisible(e.Location) OrElse ThumbGPath.IsVisible(e.Location) Then
    168. _MouseState = MouseState.Hover
    169. End If
    170. OffSet = e.Y
    171. Invalidate()
    172. End Sub
    173. Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
    174. MyBase.OnMouseDown(e)
    175. If e.Button = MouseButtons.Left Then
    176. If ThumbGPath.IsVisible(e.Location) Then
    177. OffSet = e.Y
    178. ThumbClick = True
    179. ElseIf TrackGPath.IsVisible(e.Location) Then
    180. TrackClick = True
    181. End If
    182. End If
    183. Invalidate()
    184. End Sub
    185. Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
    186. MyBase.OnMouseClick(e)
    187. If TrackGPath.IsVisible(e.Location) Then
    188. If e.Y < ThumbY Then 'Über Thumb Click!
    189. ThumbY -= BackPercentage(Track.Height - ThumbSize, LargeChange)
    190. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    191. RaiseEvent Scroll()
    192. ElseIf e.Y > ThumbY + ThumbSize Then 'Unter Thumb Click!
    193. If ThumbY > Track.Height Then
    194. ThumbY = Track.Height - ThumbSize
    195. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    196. RaiseEvent Scroll()
    197. Else
    198. ThumbY += BackPercentage(Track.Height - ThumbSize, LargeChange)
    199. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    200. RaiseEvent Scroll()
    201. End If
    202. End If
    203. End If
    204. Invalidate()
    205. End Sub
    206. Protected Overrides Sub OnMouseWheel(e As MouseEventArgs)
    207. MyBase.OnMouseWheel(e)
    208. Select Case e.Delta
    209. Case Is <= -1 'Runterscrollen
    210. If ThumbY < Minimum Then
    211. ThumbY = Minimum
    212. Else
    213. ThumbY -= BackPercentage(Track.Height - ThumbSize, SmallChange)
    214. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    215. RaiseEvent Scroll()
    216. End If
    217. Case Is >= 1 'Hochscrollen
    218. If ThumbY > Track.Height - ThumbSize Then
    219. ThumbY = Track.Height - ThumbSize
    220. Else
    221. ThumbY += BackPercentage(Track.Height - ThumbSize, SmallChange)
    222. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    223. RaiseEvent Scroll()
    224. End If
    225. End Select
    226. Invalidate()
    227. End Sub
    228. Protected Overrides Sub OnMouseLeave(e As EventArgs)
    229. MyBase.OnMouseLeave(e)
    230. ThumbClick = False
    231. TrackClick = False
    232. _MouseState = MouseState.None
    233. Invalidate()
    234. End Sub
    235. Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
    236. MyBase.OnMouseUp(e)
    237. ThumbClick = False
    238. TrackClick = False
    239. _MouseState = MouseState.None
    240. Invalidate()
    241. End Sub
    242. #End Region
    243. #Region "Keyboard"
    244. Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
    245. MyBase.OnKeyDown(e)
    246. Dim typ As ScrollEventType
    247. Select Case e.KeyCode
    248. Case Keys.PageUp '- LargeChange
    249. If ThumbY <= Minimum Then
    250. ThumbY = Minimum
    251. typ = ScrollEventType.First
    252. Else
    253. ThumbY -= BackPercentage(Track.Height - ThumbSize, LargeChange)
    254. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    255. typ = ScrollEventType.LargeDecrement
    256. End If
    257. Case Keys.PageDown '+ LargeChange
    258. If ThumbY >= Track.Height - ThumbSize Then
    259. ThumbY = Track.Height - ThumbSize
    260. typ = ScrollEventType.Last
    261. Else
    262. ThumbY += BackPercentage(Track.Height - ThumbSize, LargeChange)
    263. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    264. typ = ScrollEventType.LargeIncrement
    265. End If
    266. Case Keys.Up '- SmallChange
    267. If ThumbY <= Minimum Then
    268. ThumbY = Minimum
    269. typ = ScrollEventType.First
    270. Else
    271. ThumbY -= BackPercentage(Track.Height - ThumbSize, SmallChange)
    272. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    273. typ = ScrollEventType.SmallDecrement
    274. End If
    275. Case Keys.Down '+ SmallChange
    276. If ThumbY >= Track.Height - ThumbSize Then
    277. ThumbY = Track.Height - ThumbSize
    278. typ = ScrollEventType.Last
    279. Else
    280. ThumbY += BackPercentage(Track.Height - ThumbSize, SmallChange)
    281. Value = Percentage(ThumbY, Track.Height - ThumbSize)
    282. typ = ScrollEventType.SmallIncrement
    283. End If
    284. End Select
    285. RaiseEvent Scroll()
    286. Invalidate()
    287. End Sub
    288. #End Region
    289. #Region "OnPaint & "
    290. Protected Overrides Sub OnPaint(e As PaintEventArgs)
    291. MyBase.OnPaint(e)
    292. ThumbSize = Maximum - Minimum
    293. #Region "GParts"
    294. TrackGPath.Reset()
    295. TrackGPath.AddRectangle(Track)
    296. ThumbGPath.Reset()
    297. ThumbGPath.AddRectangle(Thumb)
    298. #End Region
    299. With e.Graphics
    300. Select Case _MouseState
    301. Case MouseState.None
    302. Size = New Size(6, Height)
    303. Track = New Rectangle(0, 0, 6, Height)
    304. .FillRectangle(New SolidBrush(TrackColor), Track)
    305. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    306. .FillRectangle(New SolidBrush(ThumbColor), Thumb)
    307. Case MouseState.Hover
    308. Size = New Size(12, Height)
    309. Track = New Rectangle(0, 0, 12, Height)
    310. .FillRectangle(New SolidBrush(TrackColor), Track)
    311. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    312. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    313. Case MouseState.Click
    314. Size = New Size(12, Height)
    315. Track = New Rectangle(0, 0, 12, Height)
    316. .FillRectangle(New SolidBrush(TrackColor), Track)
    317. Thumb = New Rectangle(0, ThumbY, Width, ThumbSize)
    318. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    319. End Select
    320. End With
    321. End Sub
    322. Protected Overrides Sub OnResize(e As EventArgs)
    323. MyBase.OnResize(e)
    324. If ThumbY > Minimum Then
    325. ThumbY = BackPercentage(Height, Value) - ThumbSize
    326. End If
    327. End Sub
    328. #End Region
    329. #Region "ScrollBaas Functions" 'With Integer-Division
    330. Private Function Percentage(Value As Integer, Maximum As Integer) As Integer
    331. Return (Value * _Maximum) \ Maximum
    332. End Function
    333. Private Function BackPercentage(Maximum As Integer, Change As Integer) As Integer
    334. Return (Maximum * Change) \ _Maximum
    335. End Function
    336. #End Region
    337. End Class

    HorizontalScrollBaas v0.0.4 Beta
    Spoiler anzeigen

    VB.NET-Quellcode

    1. ' ___ ___ ___ ___ _ _ ___ _ _ ___
    2. ' / __|/ __| _ \/ _ \| | | | | _ ) /_\ /_\ / __|
    3. ' \__ \ (__| / (_) | |__| |__| _ \/ _ \ / _ \\__ \
    4. ' |___/\___|_|_\\___/|____|____|___/_/ \_\/_/ \_\___/
    5. ' HorizontalScrollBaas v0.0.4 Beta
    6. ' 2021 by Baa$ aka Huchti591
    7. ' Helpers Credits on vb-paradise.de From RodFromGermany & Takafusa
    8. Option Strict On
    9. Imports System.ComponentModel
    10. Imports System.Drawing.Drawing2D
    11. <DefaultEvent("Scroll")>
    12. Public Class HorizontalScrollBaas
    13. Inherits Control
    14. #Region "Events"
    15. Public Event Scroll()
    16. Public Event ValueChanged(sender As Object, e As ScrollEventArgs)
    17. #End Region
    18. Sub New()
    19. SetStyle(ControlStyles.AllPaintingInWmPaint, True)
    20. SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
    21. SetStyle(ControlStyles.ResizeRedraw, True)
    22. SetStyle(ControlStyles.UserPaint, True)
    23. UpdateStyles()
    24. Size = New Size(150, 6)
    25. End Sub
    26. #Region "Deklaration"
    27. #Region "Rectangles"
    28. Private Track As Rectangle
    29. Private Thumb As Rectangle
    30. #End Region
    31. #Region "GraphicParts"
    32. Private ThumbGPath As New GraphicsPath
    33. Private TrackGPath As New GraphicsPath
    34. #End Region
    35. #Region "Integers"
    36. Private ThumbSize As Integer
    37. Private ThumbX As Integer
    38. Private OffSet As Integer
    39. #End Region
    40. #Region "Clicks"
    41. Private TrackClick As Boolean = False
    42. Private ThumbClick As Boolean = False
    43. #End Region
    44. #End Region
    45. #Region "Propertys"
    46. #Region "Main"
    47. Private _Value As Integer
    48. <Category("ScrollBar"), Description("It is used to Obtain or set a value in a ScrollBaas Control that indicates a ScrollBox's current Position.")>
    49. Public Property Value As Integer
    50. Get
    51. Return _Value
    52. End Get
    53. Set(value As Integer)
    54. _Value = value
    55. If _Value >= Maximum Then
    56. _Value = Maximum
    57. ElseIf _Value <= Minimum Then
    58. _Value = Minimum
    59. End If
    60. RaiseEvent ValueChanged(Me, New ScrollEventArgs(ScrollEventType.ThumbPosition, _Value))
    61. Invalidate()
    62. End Set
    63. End Property
    64. Private _Minimum As Integer = 0
    65. <Category("ScrollBar"), Description("It is used to get or set the Minimum value of the ScrollBaas Control. By Default it is 0.")>
    66. Public Property Minimum As Integer
    67. Get
    68. Return _Minimum
    69. End Get
    70. Set(value As Integer)
    71. _Minimum = value
    72. Invalidate()
    73. End Set
    74. End Property
    75. Private _Maximum As Integer = 100
    76. <Category("ScrollBar"), Description("It is used to set or get the Maximum value of the ScrollBaas Control. The Default is 100.")>
    77. Public Property Maximum As Integer
    78. Get
    79. Return _Maximum
    80. End Get
    81. Set(value As Integer)
    82. _Maximum = value
    83. Invalidate()
    84. End Set
    85. End Property
    86. Private _SmallChange As Integer = 1
    87. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a short Distance.")>
    88. Public Property SmallChange As Integer
    89. Get
    90. Return _SmallChange
    91. End Get
    92. Set(value As Integer)
    93. _SmallChange = value
    94. Invalidate()
    95. End Set
    96. End Property
    97. Private _LargeChange As Integer = 10
    98. <Category("ScrollBar"), Description("It is used to Obtain or set a Value that will be added or Subtracted from the Property of the ScrollBaas Control when the ScrollBaas is moved a large Distance.")>
    99. Public Property LargeChange As Integer
    100. Get
    101. Return _LargeChange
    102. End Get
    103. Set(value As Integer)
    104. _LargeChange = value
    105. Invalidate()
    106. End Set
    107. End Property
    108. #End Region
    109. #Region "Style"
    110. Private _TrackColor As Color = Color.FromArgb(180, 216, 216, 216)
    111. <Category("Style"), Description("Change the Color of the Track.")>
    112. Public Property TrackColor As Color
    113. Get
    114. Return _TrackColor
    115. End Get
    116. Set(value As Color)
    117. _TrackColor = value
    118. Invalidate()
    119. End Set
    120. End Property
    121. Private _ThumbColor As Color = Color.FromArgb(180, 216, 216, 31)
    122. <Category("Style"), Description("Change the Color of the Thumb.")>
    123. Public Property ThumbColor As Color
    124. Get
    125. Return _ThumbColor
    126. End Get
    127. Set(value As Color)
    128. _ThumbColor = value
    129. Invalidate()
    130. End Set
    131. End Property
    132. Private _ThumbHoverColor As Color = Color.FromArgb(180, 225, 188, 0)
    133. <Category("Style"), Description("Change the Color of Thumb when the Mouse is on it.")>
    134. Public Property ThumbHoverColor As Color
    135. Get
    136. Return _ThumbHoverColor
    137. End Get
    138. Set(value As Color)
    139. _ThumbHoverColor = value
    140. Invalidate()
    141. End Set
    142. End Property
    143. #End Region
    144. #End Region
    145. #Region "Mouse"
    146. Private Enum MouseState
    147. Hover
    148. Click
    149. None
    150. End Enum
    151. Private _MouseState As MouseState = MouseState.None
    152. Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
    153. MyBase.OnMouseMove(e)
    154. If ThumbClick = True Then
    155. If ThumbX < Minimum Then
    156. ThumbX = Minimum
    157. ElseIf ThumbX > Track.Width - ThumbSize Then
    158. ThumbX = Track.Width - ThumbSize
    159. Else
    160. ThumbX = ThumbX + (e.X - OffSet)
    161. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    162. RaiseEvent Scroll()
    163. End If
    164. End If
    165. If TrackGPath.IsVisible(e.Location) OrElse ThumbGPath.IsVisible(e.Location) Then
    166. _MouseState = MouseState.Hover
    167. End If
    168. OffSet = e.X
    169. Invalidate()
    170. End Sub
    171. Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
    172. MyBase.OnMouseDown(e)
    173. If e.Button = MouseButtons.Left Then
    174. If ThumbGPath.IsVisible(e.Location) Then
    175. OffSet = e.X
    176. ThumbClick = True
    177. ElseIf TrackGPath.IsVisible(e.Location) Then
    178. TrackClick = True
    179. End If
    180. End If
    181. Invalidate()
    182. End Sub
    183. Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
    184. MyBase.OnMouseClick(e)
    185. If TrackGPath.IsVisible(e.Location) Then
    186. If e.X > ThumbX Then 'Über Thumb Click!
    187. ThumbX -= BackPercentage(Track.Width - ThumbSize, LargeChange)
    188. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    189. RaiseEvent Scroll()
    190. ElseIf e.X < ThumbX + ThumbSize Then 'Unter Thumb Click!
    191. If ThumbX > Track.Width Then
    192. ThumbX = Track.Width - ThumbSize
    193. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    194. RaiseEvent Scroll()
    195. Else
    196. ThumbX += BackPercentage(Track.Width - ThumbSize, LargeChange)
    197. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    198. RaiseEvent Scroll()
    199. End If
    200. End If
    201. End If
    202. Invalidate()
    203. End Sub
    204. Protected Overrides Sub OnMouseWheel(e As MouseEventArgs)
    205. MyBase.OnMouseWheel(e)
    206. Select Case e.Delta
    207. Case Is <= -1 'Runterscrollen
    208. If ThumbX < Minimum Then
    209. ThumbX = Minimum
    210. Else
    211. ThumbX -= BackPercentage(Track.Width - ThumbSize, SmallChange)
    212. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    213. RaiseEvent Scroll()
    214. End If
    215. Case Is >= 1 'Hochscrollen
    216. If ThumbX > Track.Width - ThumbSize Then
    217. ThumbX = Track.Width - ThumbSize
    218. Else
    219. ThumbX += BackPercentage(Track.Width - ThumbSize, SmallChange)
    220. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    221. RaiseEvent Scroll()
    222. End If
    223. End Select
    224. Invalidate()
    225. End Sub
    226. Protected Overrides Sub OnMouseLeave(e As EventArgs)
    227. MyBase.OnMouseLeave(e)
    228. ThumbClick = False
    229. TrackClick = False
    230. _MouseState = MouseState.None
    231. Invalidate()
    232. End Sub
    233. Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
    234. MyBase.OnMouseUp(e)
    235. ThumbClick = False
    236. TrackClick = False
    237. _MouseState = MouseState.None
    238. Invalidate()
    239. End Sub
    240. #End Region
    241. #Region "Keyboard"
    242. Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
    243. MyBase.OnKeyDown(e)
    244. Select Case e.KeyCode
    245. Case Keys.PageUp '- LargeChange
    246. If ThumbX <= Minimum Then
    247. ThumbX = Minimum
    248. Else
    249. ThumbX -= BackPercentage(Track.Width - ThumbSize, LargeChange)
    250. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    251. RaiseEvent Scroll()
    252. End If
    253. Case Keys.PageDown '+ LargeChange
    254. If ThumbX >= Track.Width - ThumbSize Then
    255. ThumbX = Track.Width - ThumbSize
    256. Else
    257. ThumbX += BackPercentage(Track.Width - ThumbSize, LargeChange)
    258. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    259. RaiseEvent Scroll()
    260. End If
    261. Case Keys.Up '- SmallChange
    262. If ThumbX <= Minimum Then
    263. ThumbX = Minimum
    264. Else
    265. ThumbX -= BackPercentage(Track.Width - ThumbSize, SmallChange)
    266. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    267. RaiseEvent Scroll()
    268. End If
    269. Case Keys.Down '+ SmallChange
    270. If ThumbX >= Track.Width - ThumbSize Then
    271. ThumbX = Track.Width - ThumbSize
    272. Else
    273. ThumbX += BackPercentage(Track.Width - ThumbSize, SmallChange)
    274. Value = Percentage(ThumbX, Track.Width - ThumbSize)
    275. RaiseEvent Scroll()
    276. End If
    277. End Select
    278. Invalidate()
    279. End Sub
    280. #End Region
    281. #Region "OnPaint and OnSizeChange"
    282. Protected Overrides Sub OnPaint(e As PaintEventArgs)
    283. MyBase.OnPaint(e)
    284. ThumbSize = Maximum - Minimum
    285. #Region "GParts"
    286. TrackGPath.Reset()
    287. TrackGPath.AddRectangle(Track)
    288. ThumbGPath.Reset()
    289. ThumbGPath.AddRectangle(Thumb)
    290. #End Region
    291. With e.Graphics
    292. Select Case _MouseState
    293. Case MouseState.None
    294. Size = New Size(Width, 6)
    295. Track = New Rectangle(0, 0, Width, 6)
    296. .FillRectangle(New SolidBrush(TrackColor), Track)
    297. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    298. .FillRectangle(New SolidBrush(ThumbColor), Thumb)
    299. Case MouseState.Hover
    300. Size = New Size(Width, 12)
    301. Track = New Rectangle(0, 0, Width, 12)
    302. .FillRectangle(New SolidBrush(TrackColor), Track)
    303. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    304. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    305. Case MouseState.Click
    306. Size = New Size(Width, 12)
    307. Track = New Rectangle(0, 0, Width, 12)
    308. .FillRectangle(New SolidBrush(TrackColor), Track)
    309. Thumb = New Rectangle(ThumbX, 0, ThumbSize, Height)
    310. .FillRectangle(New SolidBrush(ThumbHoverColor), Thumb)
    311. End Select
    312. End With
    313. End Sub
    314. Protected Overrides Sub OnSizeChanged(e As EventArgs)
    315. MyBase.OnSizeChanged(e)
    316. If ThumbX > Minimum Then
    317. ThumbX = BackPercentage(Width, Value) - ThumbSize
    318. End If
    319. Invalidate()
    320. End Sub
    321. #End Region
    322. #Region "ScrollBaas Functions" 'With Integer-Division
    323. Private Function Percentage(Value As Integer, Maximum As Integer) As Integer
    324. Return (Value * _Maximum) \ Maximum
    325. End Function
    326. Private Function BackPercentage(Maximum As Integer, Change As Integer) As Integer
    327. Return (Maximum * Change) \ _Maximum
    328. End Function
    329. #End Region
    330. End Class


    ----------------------------------------------------------------------------------------------------------------------------------