Advertisement
6_2008-2009 Files/ File Controls/ Input/ Output #195414

Check for existing Directories/Folders

Check if that directory exists before running the risk of an error and/or data loss. One of the few that really works. No API, no function calls. Existence check and logic included. Incredibly simple.

AI

KI-Zusammenfassung: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Quellcode
original-source
'By Jim Sivage 
'
'ISO Global
'http://www.isoglobal.com
'
'
'Make f$ equal to folder you're testing.
'
f$ = "C:\WINDOWS"
dirFolder = Dir(f$, vbDirectory)
If dirFolder <> "" Then
 strmsg = MsgBox("This folder already exists.", vbCritical):goto optout
End If
'directory exists action here
optout:

<table width="640" border="0" cellspacing="0" cellpadding="10">
 <tr valign="top"> 
 <td width="340"><H2>Introduction</H2>
 <font size="2" face="Arial, Helvetica, sans-serif"><strong>Title:</strong> 
 Core Custom Scrollbar Class <br>
 <br>
 <strong>Description:</strong> This is a fully drawn gdi+ custom scrollbar 
 control class. All of it's drawing methods are overrideable allowing developers 
 to paint it however they choose.<br>
 <br>
 <strong>License:</strong> Free to use and modify as long as header stays 
 in place. If any modifications are made to this assembly users must email 
 changes to author's email address.<br>
 <br>
 <strong>Terms and Conditions For Use, Copy, Distribution and Modification:</strong> 
 THIS CODE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
 AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
 ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER CONTRIBUTORS BE LIABLE 
 FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
 DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 
 OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 
 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 
 OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE 
 USE OF THIS CODE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.<br>
 <br>
 <strong>Date Created:</strong> 7/24/2004<br>
 <strong>Language:</strong> VB.NET<br>
 <strong>Version:</strong> 1.0</font> </td>
 </tr>
</table>
<table width="640" border="0" cellspacing="0" cellpadding="10">
 <tr>
 <td valign="top">
<H2>Tutorial</H2>
 <font size="2" face="Arial, Helvetica, sans-serif">Well let me start off 
 by mentioning why i wrote this class. I wrote this class because i read 
 somewhere that you could <strong>custom draw</strong> the windows scrollbar 
 in .net. Well from that article i tried to capture the<strong> wndproc() 
 </strong>messages for <strong>custom drawing</strong>. But as i soon found 
 out after tweaking the code several times over is that windows paints the 
 scrollbar all over the place in different methods. Making it impossible 
 to <strong>custom draw</strong> due to flickering. I was so mad because 
 i had spent so much time trying to make it work. So i decided to start all 
 over a new. I made my own custom control all from scratch. <br>
 <br>
 All though very time consuming I learned alot of things about the windows 
 scrollbar class and how it works from the links below.<br>
 <br>
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cpref/html/frlrfsystemwindowsformsscrollbarclasstopic.asp<br>
 <br>
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/scrollbars/aboutscrollbars.asp<br>
 <br>
 Scrollbars seem to be one of those things microsoft doesn't like to share 
 with their source code. The articles above stated information about basic 
 knowledge of how to use the scrollbars. They were lacking in depth information 
 about how the scrollbars are calculated. Not only did they forget to explain 
 how they are calculated, but they did not mention how to get size and location 
 information from the thumb, shaft, buttons, etc. This information is not 
 public information because microsoft doesn't want you fooling around with 
 it.<br>
 <br>
 In my tutorial below, I will explain everything you want to know about 
 scrollbars and more. Besides that you will learn how to make a fully custom drawn 
 control with event mapping.</font> 
 <H2>Part 1 - Drawing your Fake Controls</H2>
 <font size="2" face="Arial, Helvetica, sans-serif">Lets jump right into 
 it. To make a custom control you start off by inheriting the <strong>System.Windows.Forms.UserControl 
 </strong>class. This class holds all the basic properties for your control. 
 It's kinda like a basic starter template control for all you newbies 
 out there. :) I started off building my control making the fun stuff first, 
 the <font color="#FF0000"><strong>GRAPHIC DESIGN OF IT ALL</strong></font>! 
 <br>
 <br>
 There are two ways to design a custom control. One way is by using other 
 prebuilt ms controls to make a <strong>Composite </strong>control. This 
 is very effective way to get the job done fast. Although it is very fast 
 to create, it may be very slow on load time and eat up alot of resources. 
 Besides that there are many things to the engine that can go wrong considering 
 you are using other controls. You also cannot fix errors in prebuilt controls, 
 and you are limited to their design and functionality. <br>
 <br>
 The second way is design by <strong>custom draw</strong>. This type of design 
 takes forever, hehe. Although the benefits are outstanding. To custom draw 
 in .net you must import the <strong>System.Drawing</strong> classes. These 
 classes give you full drawing capabilities inside your control. Custom drawing 
 is called <strong>GDI+</strong> in .net. You can draw everything from circles, 
 rectangles, fonts, lines, etc. <br>
 <br>
 For my scrollbar class i decided to pick the second way of design by drawing 
 everything. My first method <strong>Draw()</strong> starts off by defining 
 my sizes and locations of where i want everything to be. Keep in mind that 
 none of the drawings are really controls. You have to keep track of all 
 of their information like <strong>height</strong>, <strong>width</strong>, 
 <strong>top</strong>, <strong>left</strong> and <strong>name</strong>. To 
 do this, the best way is to create a class that stores all of the information 
 and makes an array out of it. Below is the simple way to make this type 
 class.</font>
 <PRE lang=vbnet>Public Class ControlInfo
#Region "Private Variables"
Private P_X As Integer
Private P_Y As Integer
Private P_H As Integer
Private P_W As Integer
Private P_Name As String
Private P_X2 As Integer
Private P_Y2 As Integer
#End Region
Public Property X() As Integer
Get
Return P_X
End Get
Set(ByVal Value As Integer)
P_X = Value
End Set
End Property
Public Property Y() As Integer
Get
Return P_Y
End Get
Set(ByVal Value As Integer)
P_Y = Value
End Set
End Property
Public Property H() As Integer
Get
Return P_H
End Get
Set(ByVal Value As Integer)
P_H = Value
End Set
End Property
Public Property W() As Integer
Get
Return P_W
End Get
Set(ByVal Value As Integer)
P_W = Value
End Set
End Property
Public Property Name() As String
Get
Return P_Name
End Get
Set(ByVal Value As String)
P_Name = Value
End Set
End Property
Public Property X2() As Integer
Get
Return P_X2
End Get
Set(ByVal Value As Integer)
P_X2 = Value
End Set
End Property
Public Property Y2() As Integer
Get
Return P_Y2
End Get
Set(ByVal Value As Integer)
P_Y2 = Value
End Set
End Property
Public Sub New()
P_X = 0
P_Y = 0
P_H = 0
P_W = 0
P_Name = ""
P_X2 = 0
P_Y2 = 0
End Sub
End Class</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">This class stores all 
 the information for the fake controls. To declare an array of it, to use 
 in our main scrollbar class is very simple. </font><PRE lang=vbnet>Private Info(0) As ControlInfo</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">As you can see it's declared 
 to the size of zero. This is because my <strong>Draw()</strong> method defines 
 it with the proper size and values. Let's get into the actual draw method 
 now.  </font>
 <PRE lang=vbnet>Private Sub Draw()
'Set value to nothing-----
Me.Value = 0
'-------------------------
'Redim Control list-------
ReDim Info(5)
Info(0) = New ControlInfo
Info(1) = New ControlInfo
Info(2) = New ControlInfo
Info(3) = New ControlInfo
Info(4) = New ControlInfo
Info(5) = New ControlInfo
PageUp = New Timer
PageDown = New Timer
'-------------------------
'Declare Variables--------
Dim x, y, h, w As Integer
PageUp.Enabled = False
PageUp.Interval = 500
PageDown.Enabled = False
PageDown.Interval = 500
'-------------------------
'Main Control--------------------------
x = 0 : y = 0 : h = 0 : w = 0
Info(0).X = x : Info(0).Y = y : Info(0).H = h : _
Info(0).W = w : Info(0).X2 = (x + w) : _ 
Info(0).Y2 = (y + h) : Info(0).Name = "ALL"
'--------------------------------------
'Thumb Control-------------------------
Dim Thumbht As Integer = Get_Thumb_Height()
x = 0 : y = 17 : h = Thumbht : w = Me.Width
Info(1).X = x : Info(1).Y = y : Info(1).H = h : _
Info(1).W = w : Info(1).X2 = (x + w) : _ 
Info(1).Y2 = (y + h) : Info(1).Name = "Thumb"
Draw_Thumb(x, y, w, h, ControlEvents.None)
'--------------------------------------
'Shaft Control Above-------------------
x = 0 : y = 17 : h = 0 : w = Me.Width
Info(2).X = x : Info(2).Y = y : Info(2).H = h : _
Info(2).W = w : Info(2).X2 = (x + w) : _
Info(2).Y2 = (y + h) : Info(2).Name = "Shaft Above"
Draw_Shaft_Above(x, y, w, h, ControlEvents.None)
'--------------------------------------
'Shaft Control Below-------------------
If Thumbht > 0 Then Thumbht += 1
x = 0 : y = 17 + Thumbht : _
h = Me.Height - 34 - Thumbht : w = Me.Width
Info(3).X = x : Info(3).Y = y : Info(3).H = h : _ 
Info(3).W = w : Info(3).X2 = (x + w) : _ 
Info(3).Y2 = (y + h) : Info(3).Name = "Shaft Below"
Draw_Shaft_Below(x, y, w, h, ControlEvents.None)
'--------------------------------------
'Draw Arrow Down---------------------
x = 0 : y = Me.Height - 17 : h = 16 : w = Me.Width
Info(4).X = x : Info(4).Y = y : Info(4).H = h : _ 
Info(4).W = w : Info(4).X2 = (x + w) : _ 
Info(4).Y2 = (y + h) : Info(4).Name = "Arrow Down"
Draw_Arrow_Down(x, y, w, h, ControlEvents.None)
'------------------------------------
'Draw Arrow Up-----------------------
x = 0 : y = 0 : h = 16 : w = Me.Width
Info(5).X = x : Info(5).Y = y : Info(5).H = h : _ 
Info(5).W = w : Info(5).X2 = (x + w) : _
Info(5).Y2 = (y + h) : Info(5).Name = "Arrow Up"
Draw_Arrow_Up(x, y, w, h, ControlEvents.None)
'------------------------------------
End Sub</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">The method above is very simple. 
 We first re-declare the array sizes. We then start making our fake 
 controls.<OL>
<LI>Main User Control  
<LI>Thumb Control 
<LI>Shaft Control Above Thumb 
<LI>Shaft Control Below Thumb 
<LI>Scroll Arrow Button Up 
<LI>Scroll Arrow Button Down</LI></OL>
 We then set all of our fake properties, storing them in our <strong>controlinfo</strong> 
 class. Last but not least, each fake control has its own drawing method. 
 All of these drawing methods are <strong>overrideable</strong>, allowing 
 for easy <strong>custom draw</strong>. They also do not leave you in the 
 dark, because they pass several parameters to you. These parameters consist 
 of <strong>location</strong>, <strong>size</strong>, and <strong>event type</strong>. 
 Lets take a look at what one of the drawing methods looks like. This drawing 
 method is <strong>Draw_Arrow_Up()</strong>. It draws the scroll arrow button 
 up.</font>
 <PRE lang=vbnet>Public Overridable Sub Draw_Arrow_Up(ByVal X As Integer, _
ByVal Y As Integer, ByVal W As Integer, ByVal H As Integer, _
ByVal EventOf As ControlEvents)
'Get Control Graphics-----------------
Dim g As Graphics = Me.CreateGraphics
g.SmoothingMode = SmoothingMode.None
'-------------------------------------
Select Case EventOf
Case ControlEvents.None
'Draw Rectangle to start--------------------------------------------
g.FillRectangle(New SolidBrush(Color.White), _
New Rectangle(X, Y, W, H))
g.DrawRectangle(New Pen(Color.Gray), New Rectangle(X, Y, W - 1, H))
'-------------------------------------------------------------------
'Draw Border--------------------------------------------------------
g.DrawLine(New Pen(Color.LightBlue), 3, 2 + Y, W - 4, 2 + Y)
g.DrawLine(New Pen(Color.LightBlue), 2, Y + 3, 2, H + Y - 3)
g.DrawLine(New Pen(Color.LightBlue), 3, Y + H - 2, W - 4, Y + H - 2)
g.DrawLine(New Pen(Color.LightBlue), W - 3, Y + 3, W - 3, H + Y - 3)
'-------------------------------------------------------------------
'Draw Arrow---------------------------------------------------------
g.DrawLine(New Pen(Color.Black), (W \ 2) - 1, (H \ 2) - 2, _
(W \ 2) + 1, (H \ 2) - 2)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 2, (H \ 2) - 1, _
(W \ 2) + 2, (H \ 2) - 1)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 3, (H \ 2), _
(W \ 2) - 1, (H \ 2))
g.DrawLine(New Pen(Color.Black), (W \ 2) + 1, (H \ 2), _
(W \ 2) + 3, (H \ 2))
g.DrawLine(New Pen(Color.Black), (W \ 2) + 2, (H \ 2) + 1, _
(W \ 2) + 4, (H \ 2) + 1)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 4, (H \ 2) + 1, _
(W \ 2) - 2, (H \ 2) + 1)
'-------------------------------------------------------------------
'Reset Settings-----------------------
Info(5).X = X : Info(5).Y = Y : Info(5).H = H : Info(5).W = W : _
Info(5).X2 = (X + W) : Info(5).Y2 = (Y + H) : _
Info(5).Name = "Arrow Up"
'-------------------------------------
Case ControlEvents.OnMouseDown
'Draw Rectangle to start--------------------------------------------
g.FillRectangle(New SolidBrush(Color.LightBlue), _
New Rectangle(X, Y, W, H))
g.DrawRectangle(New Pen(Color.Gray), New Rectangle(X, Y, W - 1, H))
'-------------------------------------------------------------------
'Draw Border--------------------------------------------------------
g.DrawLine(New Pen(Color.Blue), 3, 2 + Y, W - 4, 2 + Y)
g.DrawLine(New Pen(Color.Blue), 2, Y + 3, 2, H + Y - 3)
g.DrawLine(New Pen(Color.Blue), 3, Y + H - 2, W - 4, Y + H - 2)
g.DrawLine(New Pen(Color.Blue), W - 3, Y + 3, W - 3, H + Y - 3)
'-------------------------------------------------------------------
'Draw Arrow---------------------------------------------------------
g.DrawLine(New Pen(Color.Black), (W \ 2) - 1, (H \ 2) - 2, _
(W \ 2) + 1, (H \ 2) - 2)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 2, (H \ 2) - 1, _
(W \ 2) + 2, (H \ 2) - 1)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 3, (H \ 2), _
(W \ 2) - 1, (H \ 2))
g.DrawLine(New Pen(Color.Black), (W \ 2) + 1, (H \ 2), _
(W \ 2) + 3, (H \ 2))
g.DrawLine(New Pen(Color.Black), (W \ 2) + 2, (H \ 2) + 1, _
(W \ 2) + 4, (H \ 2) + 1)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 4, (H \ 2) + 1, _
(W \ 2) - 2, (H \ 2) + 1)
'-------------------------------------------------------------------
'Reset Settings-----------------------
Info(5).X = X : Info(5).Y = Y : Info(5).H = H : Info(5).W = W : _
Info(5).X2 = (X + W) : Info(5).Y2 = (Y + H) : _
Info(5).Name = "Arrow Up"
'-------------------------------------
Case ControlEvents.OnMouseMove
'Draw Rectangle to start--------------------------------------------
g.FillRectangle(New SolidBrush(Color.White), _
New Rectangle(X, Y, W, H))
g.DrawRectangle(New Pen(Color.Gray), New Rectangle(X, Y, W - 1, H))
'-------------------------------------------------------------------
'Draw Border--------------------------------------------------------
g.DrawLine(New Pen(Color.Blue), 3, 2 + Y, W - 4, 2 + Y)
g.DrawLine(New Pen(Color.Blue), 2, Y + 3, 2, H + Y - 3)
g.DrawLine(New Pen(Color.Blue), 3, Y + H - 2, W - 4, Y + H - 2)
g.DrawLine(New Pen(Color.Blue), W - 3, Y + 3, W - 3, H + Y - 3)
'-------------------------------------------------------------------
'Draw Arrow---------------------------------------------------------
g.DrawLine(New Pen(Color.Black), (W \ 2) - 1, (H \ 2) - 2, _
(W \ 2) + 1, (H \ 2) - 2)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 2, (H \ 2) - 1, _
(W \ 2) + 2, (H \ 2) - 1)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 3, (H \ 2), _
(W \ 2) - 1, (H \ 2))
g.DrawLine(New Pen(Color.Black), (W \ 2) + 1, (H \ 2), _
(W \ 2) + 3, (H \ 2))
g.DrawLine(New Pen(Color.Black), (W \ 2) + 2, (H \ 2) + 1, _
(W \ 2) + 4, (H \ 2) + 1)
g.DrawLine(New Pen(Color.Black), (W \ 2) - 4, (H \ 2) + 1, _
(W \ 2) - 2, (H \ 2) + 1)
'-------------------------------------------------------------------
'Reset Settings-----------------------
Info(5).X = X : Info(5).Y = Y : Info(5).H = H : Info(5).W = W : _
Info(5).X2 = (X + W) : Info(5).Y2 = (Y + H) : Info(5).Name = "Arrow Up"
'-------------------------------------
End Select
End Sub</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">For all you people not 
 familiar with drawing with gdi+, I start off by creating a variable to hold 
 my graphics that i am going to paint. I set it's <strong>smoothingmode</strong> 
 to none to get a crisp look. There are many other modes in that enumeration 
 to choose from like highquality, which will try to blend your graphics. 
 Next i use a case statement to figure out which event has occurred, so i 
 can paint my graphics to that event. I use some basics <strong>gdi+</strong> 
 drawing methods like fill rectangle which makes solid rectangles, draw rectangles 
 which makes outlines of rectangles and drawline which makes lines from one 
 point to another. I then finish off by setting all of the fake properties 
 in my <strong>controlinfo</strong> class once again. <em>You may ask why 
 twice?</em> Well that's how we can use this method more than once, from 
 more than one place. The rest of the fake control drawing methods are very 
 similar. They are easy to override if you want to make scrollbars that look 
 fancy, or like xp style or whatever you choose it's up to you.</font><H2>Part 2 - Making Fake Events for Your Fake Controls</H2>
 <font size="2" face="Arial, Helvetica, sans-serif">How to make fake events. 
 Well to start out, the inherited <strong>usercontrol </strong>class lets 
 you override its main events. This will give you a starting point. Knowing 
 what events occurred is half the battle, the hard part is figuring out where 
 the event occurred in relation to the location of your fake control. Since 
 you have stored your fake control properties in your <strong>controlinfo</strong> 
 class, figuring out if the event happened over your fake control is 
 easy. Below is two methods to show you how this is done.</font>
 <PRE lang=vbnet>Private Function CursorPOS() As Integer
'Get Cursor Location-----------------
Dim CursorLocation As Point = Me.PointToClient(Cursor.Position)
'------------------------------------
'Check to make sure control has something------------------
If UBound(Info) = 0 Then Return 0 : Exit Function
'----------------------------------------------------------
Dim i As Integer = 0
For i = 0 To UBound(Info)
'Check to see if cursor is over area-------------------
If CursorLocation.X >= Info(i).X And CursorLocation.X < _
Info(i).X2 And CursorLocation.Y >= Info(i).Y And _
CursorLocation.Y <= Info(i).Y2 Then
Return i
Exit Function
End If
'------------------------------------------------------
Next
'Return Nothing------
Return 0
'--------------------
End Function
Protected Overrides Sub OnMouseMove(ByVal e As _
System.Windows.Forms.MouseEventArgs)
'Check if thumb moving----------------------------
If ThumbMoving = True Then ThumbMover() : Exit Sub
'-------------------------------------------------
'If Mouse Down = True Then exit this method-------
If MouseDownNow = True Then Exit Sub
'-------------------------------------------------
'Locate which control cursor is located above---
Dim CheckValue As Integer = CursorPOS()
'-----------------------------------------------
'Check to see if mouse is already over location dont redraw--------
If CheckValue = CurrentMouseMove Then
Exit Sub
Else
Select Case CurrentMouseMove
Case 1 : Draw_Thumb(Info(1).X, Info(1).Y, Info(1).W, Info(1).H, _
ControlEvents.None)
Case 4 : Draw_Arrow_Down(Info(4).X, Info(4).Y, Info(4).W, _
Info(4).H, ControlEvents.None)
Case 5 : Draw_Arrow_Up(Info(5).X, Info(5).Y, Info(5).W, _
Info(5).H, ControlEvents.None)
End Select
'Set Current Mouse Move---------
CurrentMouseMove = CheckValue
'-------------------------------
Select Case CheckValue
Case 1 : Draw_Thumb(Info(CheckValue).X, Info(CheckValue).Y, _
Info(CheckValue).W, Info(CheckValue).H, ControlEvents.OnMouseMove)
Case 4 : Draw_Arrow_Down(Info(CheckValue).X, Info(CheckValue).Y, _
Info(CheckValue).W, Info(CheckValue).H, ControlEvents.OnMouseMove)
Case 5 : Draw_Arrow_Up(Info(CheckValue).X, Info(CheckValue).Y, _
Info(CheckValue).W, Info(CheckValue).H, ControlEvents.OnMouseMove)
End Select
End If
'------------------------------------------------------------------
End Sub
</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">The first method <strong>CursorPOS()</strong> 
 checks to see what fake control the event occured over. It then returns 
 its array id. With the id you can then draw the new control and set its 
 new properties. The second method <strong>OnMouseMove()</strong> does this. 
 It finds out if the mouse moved over the fake control, then calls its drawing 
 method to repaint it.</font> <br>
 <H2>Part 3 - Sizing Fake Scrollbar Controls</H2>
 <font size="2" face="Arial, Helvetica, sans-serif">This section is the part that 
 microsoft doesn't want to give away their secrets. They are the calculating 
 methods for sizing the thumb and scrolling range. To calculate the thumb 
 size is very simple.</font>
 <PRE lang=vbnet>Private Function Get_Thumb_Height() As Integer
If Me.Maximum = 0 Or LargeChange = 0 Then Return 0 : Exit Function
'Make thumb height based on number of records--------
Dim ThumbHt As Integer = (Me.Height - 35) / (Me.Maximum / Me.LargeChange)
'----------------------------------------------------
'Get the thumb bar height-------------
Select Case ThumbHt
Case Is < 10
Return 10
Case Else
Return ThumbHt
End Select
'-------------------------------------
End Function</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">First we check to make 
 sure properties are set by user in <strong>designmode</strong>. Then we 
 calculate the thumb height. The equation is below: 
 <UL>
 <LI>ThumbHeight = ShaftHeight / (Maximum / LargeChange)</LI>
 </UL>
 Easy you say? Yes seems easy enough. We then need to check to see how big 
 the thumb is. If the thumb is smaller than 10 in height, we wouldn't be 
 able to click on it, so we make sure it is a minimum height of 10. If it 
 is greater than 10 we return it as is.</font><br>
 <br>
 <font size="2" face="Arial, Helvetica, sans-serif">As you can see depending 
 upon the maximum property value the thumb height changes. The next calculation 
 is the thumb sliding up and down the shaft. <strong>LOL Only if "beavis 
 and butthead were here".</strong> The method is<strong>ThumbMover()</strong></font>
 <PRE lang=vbnet>Private Sub ThumbMover()
'Get Cursor Location-----------------
Dim e As Point = Me.PointToClient(Cursor.Position)
'------------------------------------
'Get Position relative to where mouse was---------
Dim NewPOS As Integer = e.Y + Info(1).Y - MeterY
'-------------------------------------------------
If NewPOS <= 18 Then
If Info(1).Y <> 17 Then
Draw_Thumb(0, 17, Me.Width, Info(1).H, ControlEvents.OnMouseDown)
Draw_Shaft_Above(0, 0, Me.Width, 0, ControlEvents.None)
Draw_Shaft_Below(0, Info(1).H + 18, Me.Width, Me.Height - 18 - _
17 - Info(1).H, ControlEvents.None)
Me.Value = Me.Minimum
RaiseEvent Scroll()
End If
Exit Sub
End If
If NewPOS >= Me.Height - Info(1).H - 19 Then
If Info(1).Y <> Me.Height - Info(1).H - 18 Then
Draw_Thumb(Info(1).X, Me.Height - Info(1).H - 18, Info(1).W, _
Info(1).H, ControlEvents.OnMouseDown)
Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
ControlEvents.None)
Draw_Shaft_Below(0, 0, Me.Width, 0, ControlEvents.None)
Me.Value = Me.Maximum
RaiseEvent Scroll()
End If
Exit Sub
End If
'Drawing moving Thumb-----------------------------------
Draw_Thumb(Info(1).X, NewPOS, Info(1).W, Info(1).H, _
ControlEvents.OnMouseDown)
Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
ControlEvents.None)
Draw_Shaft_Below(0, NewPOS + Info(1).H + 1, Me.Width, _
Me.Height - 18 - NewPOS - Info(1).H, ControlEvents.None)
MeterY = e.Y
'-------------------------------------------------------
'Make New Value-----------------------------------------
Dim ScrollingArea As Integer = Me.Height - 34 - Info(1).H
Me.Value = (Me.Maximum / ScrollingArea) * ((Info(1).Y - 17) - 1)
'-------------------------------------------------------
'Scroll-------------
RaiseEvent Scroll()
'-------------------
End Sub</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">Well let me break it 
 down for ya. First we get the cursor position. Then we calculate the new 
 position with this equation. 
 <UL>
 <LI>NewPosition = CurrentCursorPosition + ThumbTop - OldCursorPosition</LI>
 </UL>
 This will give us a new position for a moveable thumb. We then check to 
 make sure the thumb is within the shaft. If it is out of range we correct 
 it. If it is in range, we then start the moving process. Ok now to get in 
 depth on the secrets of the windows scrollbar. To keep the scrollbar from 
 flickering we do not paint under the thumb. The shaft is in two pieces. 
 The top shaft and bottom shaft. We draw from the top shaft to the thumb 
 top then we draw the bottom thumb to the bottom shaft. This reduces the 
 drawing flicker to almost nothing. The next equation calculates the new 
 control value. <br>
 <br>
 The equation is:<UL>
<LI>Value = (Maximum / FullShaftSize) * ThumbTop</LI></UL>Seems simple enough! Then last but not least we raise a scroll event.</font><H2>Part 4 - Scrolling Thumb based On Arrow Button Events</H2>
 <font size="2" face="Arial, Helvetica, sans-serif">Ok we start off this 
 section describing how microsoft makes it's arrow buttons work. How it clicks 
 once and moves the thumb one position down, but if you continue holding 
 the arrow button, it speeds up thumb moving. To create this effect i use 
 a timer control. Of course how can you live in a world without time.</font>
 <PRE lang=vbnet>Private Sub Move_ThumbDown()
Dim NewPos As Integer
If Me.Value < Me.Maximum Then
If Me.Value + Me.SmallChange > Me.Maximum Then
Me.Value = Me.Maximum
Else
Me.Value += Me.SmallChange
End If
If Me.Value = Me.Maximum Then
NewPos = Info(4).Y - Info(1).H - 1
Draw_Thumb(Info(1).X, NewPos, Info(1).W, Info(1).H, _
ControlEvents.None)
Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
ControlEvents.None)
Draw_Shaft_Below(0, NewPos + Info(1).H + 1, Me.Width, _
(Me.Height - 18) - (Info(1).Y + Info(1).H), ControlEvents.None)
'--------------------------------------------------
Else
NewPos = ((Me.Value) / (Me.Maximum)) * _
(Info(4).Y - Info(1).H - 17) + 17
Draw_Thumb(Info(1).X, NewPos, Info(1).W, Info(1).H, _
ControlEvents.None)
Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
ControlEvents.None)
Draw_Shaft_Below(0, NewPos + Info(1).H + 1, Me.Width, _
(Me.Height - 18) - (Info(1).Y + Info(1).H), _
ControlEvents.None)
'--------------------------------------------------
End If
'Scroll-------------
RaiseEvent Scroll()
'-------------------
End If
End Sub
Private Sub PageDown_Tick(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles PageDown.Tick
If ShaftMovingDown = True Then
'Start Moving from Shaft-------
Move_ShaftDown()
'------------------------------
Else
'Start Moving from Thumb------
Move_ThumbDown()
'-----------------------------
End If
'Increase Timer Speed-------
PageDown.Interval = 50
'---------------------------
End Sub
</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">The <strong>PageDown</strong> 
 timer property (enabled) is set to true. It then calls the <strong>Move_ThumbDown()</strong> 
 method. This creates a one click move for the thumb. The timer then increases 
 it's speed which if the mouse is still down, increases the speed of the 
 thumb movement.</font><br>
 <H2>Part 5 - Scrolling Thumb based on Shaft MouseDown Events</H2>
 <font size="2" face="Arial, Helvetica, sans-serif">You just seen in the 
 previous section how to move the thumb by arrow buttons. Now i am going 
 to teach you how to move thumb with <strong>largechange,</strong> by clicking 
 on the shaft. The following method creates this in combination with the 
 previous timer method.</font>
 <PRE lang=vbnet>Private Sub Move_ShaftDown()
Dim NewPos As Integer
If Me.Value < Me.Maximum Then
If Me.Value + Me.LargeChange > Me.Maximum Then
Me.Value = Me.Maximum
Else
Me.Value += Me.LargeChange
End If
If Me.Value = Me.Maximum Then
NewPos = Info(4).Y - Info(1).H - 1
Draw_Thumb(Info(1).X, NewPos, Info(1).W, Info(1).H, _
ControlEvents.OnMouseDown)
Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
ControlEvents.None)
Draw_Shaft_Below(0, NewPos + Info(1).H + 1, Me.Width, _
(Me.Height - 18) - (Info(1).Y + Info(1).H), _
ControlEvents.OnMouseDown)
'--------------------------------------------------
Else
NewPos = ((Me.Value) / (Me.Maximum)) * _
(Info(4).Y - Info(1).H - 17) + 17
Draw_Thumb(Info(1).X, NewPos, Info(1).W, Info(1).H, _
ControlEvents.OnMouseDown)
Draw_Shaft_Above(0, 17, Me.Width, Info(1).Y - 17, _
ControlEvents.None)
Draw_Shaft_Below(0, NewPos + Info(1).H + 1, Me.Width, _
(Me.Height - 18) - (Info(1).Y + Info(1).H), _
ControlEvents.OnMouseDown)
'--------------------------------------------------
End If
RaiseEvent Scroll()
End If
End Sub</PRE>
 <font size="2" face="Arial, Helvetica, sans-serif">The code above starts 
 out by checking to see if the value is below the maximum. If it is, it then 
 highlights the shaft and moves the thumb. It only highlights the shaft half 
 that was clicked on.</font><br>
 <H2>Part 6 - Scrolling Based on Key and Wheel Events</H2>
 <font size="2" face="Arial, Helvetica, sans-serif">The methods below show 
 how to capture the arrow and page keyboard keys, as well as the mouse wheel. 
 To capture the keyboard keys i use the <strong>ProcessDialogKey()</strong> 
 method. To capture the mouse wheel i use the <strong>onMouseWheel()</strong> 
 method.</font>
 <PRE lang=vbnet>Protected Overrides Function ProcessDialogKey(ByVal keyData _
As System.Windows.Forms.Keys) As Boolean
Try
Select Case keyData
Case Keys.Up, Keys.PageUp
If PageUp.Enabled = False Then
Draw_Arrow_Up(Info(5).X, Info(5).Y, Info(5).W, Info(5).H, _
ControlEvents.OnMouseDown)
Move_ThumbUp()
PageUp.Enabled = True
End If
Case Keys.Down, Keys.PageDown
If PageDown.Enabled = False Then
Draw_Arrow_Down(Info(4).X, Info(4).Y, Info(4).W, Info(4).H, _
ControlEvents.OnMouseDown)
Move_ThumbDown()
PageDown.Enabled = True
End If
End Select
Return True
Catch ex As Exception
Return False
End Try
End Function
Protected Overrides Sub OnMouseWheel(ByVal e As _
System.Windows.Forms.MouseEventArgs)
If e.Delta > 0 Then
Move_ThumbUp()
Else
Move_ThumbDown()
End If
End Sub
</PRE><H2>Conclusion</H2>
 <font size="2" face="Arial, Helvetica, sans-serif">Well this concludes my 
 tutorial on scrollbars, i hope you all enjoyed how long it was. ;) If anyone 
 needs any help with understanding this article, don't forget to write. <br>
 <br>
 Also one more thing, I am in the process of making the orientation of the 
 scrollbar. So currently you can only vertical scroll. Sorry! I am also making 
 custom drawing presets for xp style, 3d style, flat style and futuristic 
 style. <br>
 <br>
 <em>"Devon Developers!"</em> VectorX</font></td>
 </tr>
</table>
Originalkommentare (3)
Wiederhergestellt von der Wayback Machine