|
VB Helper newsletter
|
Rod Stephens
|
Nov 24, 2001 08:47 PST
|
VB Helper newsletter
Numbers 1 through 4 are all the same program with one routine changed.
The point is, pulling the interesting drawing tasks into a separate
routine lets you write different vesions of the program effortlessly.
Number 5 is simple but useful. I find myself using these routines all
the time.
I also rebuilt the stories pages this week. You can find them at:
http://www.vb-helper.com/stories.html
Have a great week and thanks for subscribing!
Rod
*****************************************************************
View previous newsletters at:
http://www.topica.com/lists/VBHelper
Post questions at:
http://www.topica.com/lists/VBHelperQA
*****************************************************************
Contents:
1. New HowTo: Draw a rubberband line
2. New HowTo: Draw a rubberband rectangle
3. New HowTo: Draw a rubberband ellipse
4. New HowTo: Draw a rubberband star
5. New HowTo: Get and set a file's contents
6. New Links
7. New Story: Dusty Systems
8. Cheap Trick of the Week #10827: DOS to order
----------
1. New HowTo: Draw a rubberband line
http://www.vb-helper.com/howto_rubberband_line.html
http://www.vb-helper.com/HowTo/howto_rubberband_line.zip
Use a form-level variable to indicate whether the program is drawing the
line. In the MouseDown event handler, start drawing in vbInvert mode.
In the MouseMove event handler, if we are drawing then erase the
previous line and draw the new one.
In the MouseUp event handler, stop drawing and make the line permanent.
The DrawShape subroutine separates the drawing from the mouse
interactions so it is easy to change the rubberband shape.
Option Explicit
Private m_Drawing As Boolean
Private m_X1 As Single
Private m_Y1 As Single
Private m_X2 As Single
Private m_Y2 As Single
' Start drawing.
Private Sub picCanvas_MouseDown(Button As Integer, Shift As Integer, X
As Single, Y As Single)
If Button And vbRightButton Then
' It's the right button. Cancel the draw.
If m_Drawing Then
' Erase the previous shape.
DrawShape
' Stop drawing.
m_Drawing = False
picCanvas.DrawMode = vbCopyPen
picCanvas.DrawStyle = vbSolid
End If
Else
' Start drawing.
m_Drawing = True
picCanvas.DrawMode = vbInvert
picCanvas.DrawStyle = vbDot
m_X1 = X
m_Y1 = Y
m_X2 = X
m_Y2 = Y
' Draw the first shape.
DrawShape
End If
End Sub
' Continue drawing.
Private Sub picCanvas_MouseMove(Button As Integer, Shift As Integer, X
As Single, Y As Single)
' Do nothing if we're not drawing.
If Not m_Drawing Then Exit Sub
' Erase the previous shape.
DrawShape
' Save the new point.
m_X2 = X
m_Y2 = Y
' Draw the new shape.
DrawShape
End Sub
' Finish drawing.
Private Sub picCanvas_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
' Do nothing if we're not drawing.
If Not m_Drawing Then Exit Sub
' Erase the previous shape.
DrawShape
' Stop drawing.
m_Drawing = False
picCanvas.DrawMode = vbCopyPen
picCanvas.DrawStyle = vbSolid
' Save the new point.
m_X2 = X
m_Y2 = Y
' Make the shape permanant. This might involve saving coordinates to
a database or something. In this case, it just means redrawing the shape
in non-invert mode.
DrawShape
End Sub
' Draw the shape in the area defined by the points
' (m_X1, m_Y1) and (m_X2, m_Y2).
Private Sub DrawShape()
picCanvas.Line (m_X1, m_Y1)-(m_X2, m_Y2)
End Sub
----------
2. New HowTo: Draw a rubberband rectangle
http://www.vb-helper.com/howto_rubberband_rectangle.html
http://www.vb-helper.com/HowTo/howto_rubberband_rectangle.zip
This is the same as the previous HowTo except it uses the following
DrawShape routine.
' Draw the shape in the area defined by the points
' (m_X1, m_Y1) and (m_X2, m_Y2).
Private Sub DrawShape()
picCanvas.Line (m_X1, m_Y1)-(m_X2, m_Y2), , B
End Sub
----------
3. New HowTo: Draw a rubberband ellipse
http://www.vb-helper.com/howto_rubberband_ellipse.html
http://www.vb-helper.com/HowTo/howto_rubberband_ellipse.zip
This is the same as the previous HowTo except it uses the following
DrawShape routine.
' Draw the shape in the area defined by the points
' (m_X1, m_Y1) and (m_X2, m_Y2).
Private Sub DrawShape()
Dim cx As Single
Dim cy As Single
Dim wid As Single
Dim hgt As Single
Dim radius As Single
Dim aspect As Single
cx = (m_X1 + m_X2) / 2
cy = (m_Y1 + m_Y2) / 2
wid = Abs(m_X1 - m_X2) / 2
hgt = Abs(m_Y1 - m_Y2) / 2
If wid = 0 Or hgt = 0 Then Exit Sub
If wid > hgt Then
radius = wid
Else
radius = hgt
End If
aspect = hgt / wid
picCanvas.Circle (cx, cy), radius, , , , aspect
End Sub
----------
4. New HowTo: Draw a rubberband star
http://www.vb-helper.com/howto_rubberband_star.html
http://www.vb-helper.com/HowTo/howto_rubberband_star.zip
This is the same as the previous HowTo except it uses the following
DrawShape routine.
' Draw the shape in the area defined by the points
' (m_X1, m_Y1) and (m_X2, m_Y2).
Private Sub DrawShape()
Const PI = 3.14159265
Dim cx As Single
Dim cy As Single
Dim wid As Single
Dim hgt As Single
Dim theta As Single
Dim dtheta As Single
Dim i As Integer
cx = (m_X1 + m_X2) / 2
cy = (m_Y1 + m_Y2) / 2
wid = Abs(m_X1 - m_X2) / 2
hgt = Abs(m_Y1 - m_Y2) / 2
If wid = 0 Or hgt = 0 Then Exit Sub
' Calculate and connect the star's points.
theta = 90 * PI / 180
dtheta = 2 * 72 * PI / 180
picCanvas.CurrentX = cx + wid * Cos(theta)
picCanvas.CurrentY = cy - hgt * Sin(theta)
For i = 1 To 5
theta = theta + dtheta
picCanvas.Line -(cx + wid * Cos(theta), cy - hgt * Sin(theta))
Next i
End Sub
----------
5. New HowTo: Get and set a file's contents
http://www.vb-helper.com/howto_get_set_file_contents.html
http://www.vb-helper.com/HowTo/howto_get_set_file_contents.zip
These operations are easy but putting them in simple subroutines makes
them much easier to reuse.
To read the file, open it for input and use the Input statement to grab
the whole file in one operation.
To write the file, open it for output and use Print to write the file's
contents. End the Print statement with a semi-colon to prevent Print
from adding an extra carriage return and line feed after the contents.
' Get the file's contents.
Private Function GetFileContents(ByVal file_name As String) As String
Dim fnum As Integer
' Open the file.
fnum = FreeFile
Open file_name For Input As fnum
' Grab the file's contents.
GetFileContents = Input(LOF(fnum), fnum)
' Close the file.
Close fnum
End Function
' Set the file's contents.
Private Sub SetFileContents(ByVal file_name As String, ByVal contents As
String)
Dim fnum As Integer
' Open the file.
fnum = FreeFile
Open file_name For Output As fnum
' Write the file's contents (without an
' extra trailing vbCrLf).
Print #fnum, contents;
' Close the file.
Close fnum
End Sub
----------
6. New Links
http://www.vb-helper.com/links.html
Japher
http://www.japher.com
An IT development site that connects developers to projects. Possible
full- and part-time jobs and lots of downloads.
Buckets 2.0
http://home.nyc.rr.com/buckets
A game written by Joel Wallman (jwal-@compuserve.com). Here's his
description:
Buckets is a game that does not fit easily into any standard game
category. It is a sorting game in which arrays of colorful objects must
be sorted into two or three buckets based on shared features. Buckets
requires flexible thinking rather than knowledge of trivia. The puzzles
range in difficulty from childish to devilish. Nobody can play just one.
----------
7. New Story: Dusty Systems
http://www.vb-helper.com/stories_days_of_yore.html
This story talks about the older systems an anonymous visitor still
uses. For example, did you know that installing the cheap memory
available today can bring new life to older systems?
----------
8. Cheap Trick of the Week #10827: DOS to order
http://www.vb-helper.com/CheapTrick.htm
Do you find it too cumbersome to navigate in MS-DOS to the directory you
want, especially with those weird truncated filenames?
The solution is to find the folder in Windows first. Use Explorer or My
Computer to go to the folder and select it. Then, while it’s selected,
click on Start and Run, enter command and click OK.
The MS-DOS Prompt window will open exactly at the directory
corresponding to the folder you chose.
Get more than 270 other cheap tricks in WE Compute's "Little Black Book
of Cheap Tricks"
http://www.wannapc.com/cgi-bin/cart.cgi?code=vbhelper&page=product&product=LBBCT
----------
|
|
 |
|
