This program demonstrates many useful techniques including:

• A shaped form
• Drawing marks and text along an elliptical path
• Drawing text rotated along an elliptical path
• Positioning the form in the lower right corner of the screen
• Drawing the clock hands
• Using Cls to restore a background image
• Using a popup menu
• Letting the user move a form without a title bar

A shaped form

Drawing marks and text along an elliptical path

Drawing text rotated along an elliptical path

Subroutine DrawFace shapes the form and draws marks and text along its elliptical edges. It uses the CreateEllipticRgn API function to make an elliptical region. It then uses SetWindowRgn to restrict the form to that region.

Next it draws tic marks along the form's elliptical edges. If (Cx, Cy) is the center of the form and Rx and Ry are the horizontal and vertical radii of the ellipse, then the following point traces out the ellipse as theta goes from 0 to 2 * Pi.

    X = Cx + Rx * Cos(theta)
    Y = Cy + Ry * Sin(theta)

Next the program calculates the offset from the edge of the form to the edge of the drawing area. This is half the difference between the form's width and its ScaleWidth (the area used by the borders). The program uses the values xoff and yoff to position later drawing.

The routine then draws a small circle in the center of the clock. Later the user can click and drag this circle to move the form.

Now the program increments theta by 1/60th of a circle each pass through its loop to generate tic marks for every minute on the clock face. Every five minutes, the program draws a numeral.

For each numeral, the program calls the CustomFont function to make an appropriately rotated font. The font's escapement (angle of rotation) is 270 degrees off from the angle of the current tic mark. That makes the text stand with its base toward the center of the clock.

The routine finds a point along the tic mark and offsets it opposite the direction the text will be drawn. Thinking in the text's orientation, the program shifts the text left so the text will be centered.

Finally the routine draws the text, restores the original font, and deletes the new font. This is very important to release scarce font resources.

After it has finished drawing everything, the subroutine sets Picture = Image to make the current picture permanent. Now it can draw on top of the clock and call Cls to erase the new drawing, restoring the original clock face with just the tic marks, numerals, and central circle.

Private Const GRAB_RADIUS = 3

' Draw the clock's face without hands.
Private Sub DrawFace()
Dim hrgn As Long
Dim xoff As Single
Dim yoff As Single
Dim cx As Single
Dim cy As Single
Dim theta As Single
Dim dtheta As Single
Dim I As Integer
Dim x1 As Single
Dim y1 As Single
Dim x2 As Single
Dim y2 As Single
Dim txt As String
Dim new_font As Long
Dim old_font As Long

    ' ControlBox = False
    ' ShowInTaskbar = False
    Caption = ""
    BorderStyle = vbBSNone
    AutoRedraw = True
    ScaleMode = vbPixels

    ' Make an elliptical region centered
    ' over the drawing area.
    xoff = (ScaleX(Width, vbTwips, vbPixels) - ScaleWidth) _
        / 2
    yoff = (ScaleY(Height, vbTwips, vbPixels) - _
        ScaleHeight) / 2
    hrgn = CreateEllipticRgn(xoff, yoff, xoff + ScaleWidth _
        + 1, yoff + ScaleHeight + 1)
    SetWindowRgn hwnd, hrgn, False

    ' Draw the clock face.
    cx = (ScaleWidth - 1) / 2
    cy = (ScaleHeight - 1) / 2
    FillStyle = vbFSSolid
    Circle (cx, cy), GRAB_RADIUS
    FillStyle = vbFSTransparent

    ' Draw the tic marks and numerals.
    dtheta = PI / 30
    theta = -10 * dtheta
    For I = 0 To 59
        ' Draw the tic marks.
        x1 = cx + cx * Cos(theta)
        y1 = cy + cy * Sin(theta)
        If I Mod 5 = 0 Then
            ' Label the digit.
            txt = Format$(I \ 5 + 1)

            ' Create a rotated font.
            new_font = CustomFont(16, 0, _
                (3 * PI / 2 - theta) * 1800 / PI, 0, _
                700, False, False, False, _
                "Times New Roman")
            old_font = SelectObject(hdc, new_font)

            ' Draw the text.
            ' Find the point lined up along the tic mark.
            x2 = cx + (cx - 1) * Cos(theta) * 0.95
            y2 = cy + (cy - 1) * Sin(theta) * 0.95

            ' Offset by distance TextWidth/2 rotated
            ' so the text is centered.
            CurrentX = x2 + TextWidth(txt) / 2 * Sin(theta)
            CurrentY = y2 - TextWidth(txt) / 2 * Cos(theta)
            ForeColor = RGB(0, 0, 128)
            Print txt
            ForeColor = vbBlack

            ' Restore the original font and delete the
            ' new font to free resources.
            SelectObject hdc, old_font
            DeleteObject new_font

            x2 = cx + cx * Cos(theta) * 0.9
            y2 = cy + cy * Sin(theta) * 0.9
        Else
            x2 = cx + cx * Cos(theta) * 0.95
            y2 = cy + cy * Sin(theta) * 0.95
        End If
        Line (x1, y1)-(x2, y2)
        theta = theta + dtheta
    Next I

    ' Make the image permanent.
    Picture = Image
End Sub

' Make a customized font and return its handle.
Private Function CustomFont(ByVal hgt As Long, ByVal wid As _
    _
    Long, ByVal escapement As Long, ByVal orientation As _
    Long, ByVal wgt As Long, ByVal is_italic As Long, ByVal _
        _
    is_underscored As Long, ByVal is_striken_out As Long, _
    ByVal face As String) As Long
Const CLIP_LH_ANGLES = 16   ' Needed for tilted fonts.

    CustomFont = CreateFont( _
        hgt, wid, escapement, orientation, wgt, _
        is_italic, is_underscored, is_striken_out, _
        0, 0, CLIP_LH_ANGLES, 0, 0, face)
End Function

Positioning the form in the lower right corner of the screen

Subroutine PositionForm uses the SystemParametersInfo API function to get the screen's work area. This is the screen area excluding the task bar. The routine uses the resulting Right and Bottom values to determine where to position the clock.

' Put the form in the lower right corner.
Private Sub PositionForm()
Dim wa_info As RECT
Dim wa_wid As Single
Dim wa_hgt As Single

    If SystemParametersInfo(SPI_GETWORKAREA, _
        0, wa_info, 0) <> 0 _
    Then
        ' We got the work area bounds.
        ' Center the form in the work area.
        wa_wid = ScaleX(wa_info.Right, vbPixels, vbTwips)
        wa_hgt = ScaleY(wa_info.Bottom, vbPixels, vbTwips)
    Else
        ' We did not get the work area bounds.
        ' Center the form on the whole screen.
        wa_wid = Screen.Width
        wa_hgt = Screen.Height
    End If

    ' Position the form.
    Me.Move wa_wid - Width, wa_hgt - Height
End Sub

Drawing the clock hands

Using Cls to restore a background image

Subroutine DrawHands draws the clock's hands to show the current time. Because subroutine DrawFace set Picture = Image, this routine can use Cls to erase any previously drawn clock hands.

Then the routine gets the current time. For the hours, minutes, and seconds, the program uses the time to calculate the angle at which it should draw the appropriate hand. For example, the angle for the minute hand is 2 * Pi * Minute / 60 off from the straight up position of Pi / 2. This simplifies to:

    -PI / 2 + PI / 30 * Minute

The hour hand is a bit different because we don't want it to point only directly at integer hours. In other words, when it's 6:30 it should point halfway between 6 and 7, not directly at 6. To handle this, the program converts the current time into a Single. This returns a number between 0 and 1 where 0 is 0:00 in the morning, 0.5 is 12:00 noon, and 1 is 12:00 midnight. The program multiplies the result by 4 * Pi so AM and PM values map to the same angle plus or minus 2 * Pi. For example, 8:00 PM maps to the same value as 8:00 AM plus 2 * Pi.

The program uses the angles to make arms of different lengths pointing in the appropriate directions and draws the hands.

' Draw the clock's hands.
Private Sub DrawHands()
Const HOUR_R = 0.3
Const MIN_R = 0.5
Const SEC_R = 0.75

Dim cx As Single
Dim cy As Single
Dim theta As Single
Dim x2 As Single
Dim y2 As Single
Dim time_now As Date

    ' Draw the clock face.
    cx = (ScaleWidth - 1) / 2
    cy = (ScaleHeight - 1) / 2

    ' Clear the previous hands.
    Cls

    ' Draw the hour hand.
    time_now = Time
    theta = -PI / 2 + 4 * PI * (CSng(time_now))
    x2 = cx + cx * Cos(theta) * HOUR_R
    y2 = cy + cy * Sin(theta) * HOUR_R
    DrawWidth = 3
    Line (cx, cy)-(x2, y2)

    ' Draw the minute hand.
    theta = -PI / 2 + PI / 30 * Minute(time_now)
    x2 = cx + cx * Cos(theta) * MIN_R
    y2 = cy + cy * Sin(theta) * MIN_R
    DrawWidth = 2
    Line (cx, cy)-(x2, y2)

    ' Draw the second hand.
    theta = -PI / 2 + PI / 30 * Second(time_now)
    x2 = cx + cx * Cos(theta) * SEC_R
    y2 = cy + cy * Sin(theta) * SEC_R
    DrawWidth = 1
    Line (cx, cy)-(x2, y2)
End Sub

Using a popup menu

Letting the user move a form without a title bar

At design time, make a menu named mnuPopup. Set its Visible property to False and give it whatever submenu items you want. In this example, the single submenu is an Exit command.

When the user clicks on the form, the program calls the OverCenter function to see if the mouse is over the center of the form. If it is near the center, the program calls ReleaseCapture to end the current MouseDown event. It then calls SendMessage to send the form the WM_NCLBUTTONDOWN message as if the user had clicked the form's title bar. This lets the user move the form.

If the mouse is not over the center of the form, the program uses PopupMenu to display the popup menu.

' If the mouse is at the center of the clock, let the user
' move it.
Private Sub Form_MouseDown(Button As Integer, Shift As _
    Integer, X As Single, Y As Single)
    If OverCenter(X, Y) Then
        ' Move the form.
        ReleaseCapture
        SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    ElseIf Button = vbRightButton Then
        ' Display the popup.
        PopupMenu mnuPopup
    End If
End Sub

' Return True if the mouse is near the center of the form.
Private Function OverCenter(ByVal X As Single, ByVal Y As _
    Single) As Boolean
Dim cx As Single
Dim cy As Single
Dim dx As Single
Dim dy As Single

    ' See if the point is close enough to the center.
    cx = (ScaleWidth - 1) / 2
    cy = (ScaleHeight - 1) / 2
    dx = cx - X
    dy = cy - Y
    OverCenter = (dx * dx + dy * dy <= GRAB_RADIUS * _
        GRAB_RADIUS)
End Function