It is quite simple to draw directly on either a Userform or the sheet with
the Windows API.
Here is an example of that, which you will have to work out to make your
boat.
This is a project with a Userform, called UserForm1 and a normal module.
The userform has 2 commandbuttons, CommandButton1 and CommandButton2 and
2 option button OptionButton1 and OptionButton2.
This code will go in the userform module:
Option Explicit
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private bPaintUserForm As Boolean
Private Sub CommandButton1_Click()
Dim i As Long
Dim hWnd As Long
Dim siInsideWidth As Single
bPaintUserForm = OptionButton1.Value
If bPaintUserForm Then
Repaint
hWnd = FindWindow(vbNullString, Caption)
Else
hWnd = Application.hWnd
End If
i = 1
siInsideWidth = InsideWidth - 4
SetFixedDrawingParameters hWnd, InsideWidth, InsideHeight
Do While i < siInsideWidth
i = i + 1
DrawLineForm True, _
i, _
0, _
Height - 40, _
10, _
0, _
1, _
vbRed, _
False, _
Me
Sleep 20
Loop
DeletePen
End Sub
Private Sub CommandButton2_Click()
If bPaintUserForm Then
Repaint
Else
Application.ScreenUpdating = True
End If
End Sub
And this code will go into the normal code module:
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private dPointsPerPixel As Single
Private Declare Function DeleteObject _
Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreatePen _
Lib "gdi32" (ByVal nPenStyle As Long, _
ByVal nWidth As Long, _
ByVal crColor As Long) As Long
Private Declare Function SelectObject _
Lib "gdi32" (ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Const PS_SOLID = 0
Private Const PS_DASH = 1
Private Const PS_DASHDOT = 3
Private Const PS_DASHDOTDOT = 4
Private Const PS_DOT = 2
Private gPen As Long
'a point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
Private Const LOGPIXELSX As Long = 88 'pixels/inch in X
Private Const LOGPIXELSY As Long = 90 'pixels/inch in Y
Private Const TWIPSPERINCH As Long = 1440
Private Declare Function GetDC _
Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC _
Lib "user32" (ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps _
Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long) As Long
Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal crColor As Long) As Long
Private Declare Function MoveToEx _
Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
lpPoint As POINTAPI) As Long
Private Declare Function LineTo _
Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long) As Long
Private lFarRight As Long
Private lFarBottom As Long
Private hWnd As Long
Private hDC As Long
Sub LoadForm()
Load UserForm1
UserForm1.Show
End Sub
Sub SetFixedDrawingParameters(hWnd As Long, _
lRightEnd As Long, _
lBottomEnd As Long)
dPointsPerPixel = PointsPerPixel()
lFarRight = lRightEnd / dPointsPerPixel
lFarBottom = lBottomEnd / dPointsPerPixel
hDC = GetDC(hWnd)
End Sub
Sub DrawLineForm(bVertical As Boolean, _
lXVertical As Long, _
lYHorizontal As Long, _
lFromEdge1 As Long, _
lFromEdge2 As Long, _
lPenType As Long, _
lPenWidth As Long, _
ByVal lPenColour As Long, _
bDoRepaint As Boolean, _
Optional frmForm As Object)
Dim pCoord As POINTAPI
Dim lXVerticalNew As Long
Dim lYHorizontalNew As Long
Dim lFromEdge1New As Long
Dim lFromEdge2New As Long
lFromEdge1New = lFromEdge1 / dPointsPerPixel
lFromEdge2New = lFromEdge2 / dPointsPerPixel
lXVerticalNew = lXVertical / dPointsPerPixel
lYHorizontalNew = lYHorizontal / dPointsPerPixel
'this will have to be done in a better way
'-----------------------------------------
If bDoRepaint Then
If frmForm Is Nothing Then
Application.ScreenUpdating = True
Else
frmForm.Repaint
End If
End If
'Create the pen
gPen = CreatePen(lPenType, lPenWidth, lPenColour)
'Select the pen onto the DC, deleting the old one
DeleteObject SelectObject(hDC, gPen)
If bVertical Then
'Move the drawing position
pCoord.X = lXVerticalNew
pCoord.Y = lFromEdge1New
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord
'Draw the line
LineTo hDC, lXVerticalNew, lFarBottom - lFromEdge2New
Else
'Move the drawing position
pCoord.X = lFromEdge1New
pCoord.Y = lYHorizontalNew
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord
'Draw the line
LineTo hDC, lFarRight - lFromEdge2New, lYHorizontalNew
End If
End Sub
Sub DeletePen()
DeleteObject gPen
End Sub
Function PointsPerPixel() As Double
'will give the size of a pixel in points
'this will be the same factor for X and Y
'for the screen, but not always for the printer
'----------------------------------------------
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function
Then just run the Sub LoadForm and start experimenting.
By drawing all diffferent lines and colours you could make it as realistic
as you want.
RBS