Welcome Guest!
 VB Helper
 Previous Message All Messages Next Message 
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

----------
	
 Previous Message All Messages Next Message 
  Check It Out!

  Topica Channels
 Best of Topica
 Art & Design
 Books, Movies & TV
 Developers
 Food & Drink
 Health & Fitness
 Internet
 Music
 News & Information
 Personal Finance
 Personal Technology
 Small Business
 Software
 Sports
 Travel & Leisure
 Women & Family

  Start Your Own List!
Email lists are great for debating issues or publishing your views.
Start a List Today!

© 2001 Topica Inc. TFMB
Concerned about privacy? Topica is TrustE certified.
See our Privacy Policy.