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
'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