VERSION 5.00 Begin VB.Form frmDoodler BorderStyle = 1 'Fixed Single Caption = "Doodler" ClientHeight = 4725 ClientLeft = 45 ClientTop = 615 ClientWidth = 7725 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4725 ScaleWidth = 7725 StartUpPosition = 3 'Windows Default Begin VB.PictureBox picDrawingArea AutoRedraw = -1 'True BackColor = &H00FFFFFF& Height = 4215 Left = 2160 ScaleHeight = 4155 ScaleWidth = 5355 TabIndex = 5 Top = 360 Width = 5415 End Begin VB.ListBox lstColours Height = 1230 Left = 120 TabIndex = 4 Top = 3360 Width = 1935 End Begin VB.CheckBox chkContinuousDrawing Caption = "Continuous Drawing" Height = 255 Left = 120 TabIndex = 2 Top = 2760 Width = 1935 End Begin VB.CommandButton cmdClear Caption = "Clear" Height = 375 Left = 120 TabIndex = 1 Top = 2280 Width = 1935 End Begin VB.Frame fraShape Caption = "Shape" Height = 2055 Left = 120 TabIndex = 0 Top = 120 Width = 1935 Begin VB.OptionButton optShape Caption = "Vertical Line" Height = 255 Index = 3 Left = 240 TabIndex = 10 Top = 1560 Width = 1455 End Begin VB.OptionButton optShape Caption = "Horizontal Line" Height = 255 Index = 2 Left = 240 TabIndex = 9 Top = 1200 Width = 1455 End Begin VB.OptionButton optShape Caption = "Square" Height = 255 Index = 1 Left = 240 TabIndex = 8 Top = 840 Width = 1455 End Begin VB.OptionButton optShape Caption = "Circle" Height = 255 Index = 0 Left = 240 TabIndex = 7 Top = 480 Width = 1455 End End Begin VB.Label Label2 Caption = "Drawing Area" Height = 255 Left = 2160 TabIndex = 6 Top = 120 Width = 1935 End Begin VB.Label Label1 Caption = "Colour" Height = 255 Left = 120 TabIndex = 3 Top = 3120 Width = 1935 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFileOpen Caption = "&Open..." End End Attribute VB_Name = "frmDoodler" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private mlngChosenShape As Long Private Sub cmdClear_Click() picDrawingArea.Cls End Sub Private Sub Form_Load() With lstColours .AddItem "Black" .ItemData(.NewIndex) = RGB(0, 0, 0) .AddItem "Red" .ItemData(.NewIndex) = RGB(255, 0, 0) .AddItem "Green" .ItemData(.NewIndex) = RGB(0, 255, 0) .AddItem "Blue" .ItemData(.NewIndex) = RGB(0, 0, 255) .AddItem "Yellow" .ItemData(.NewIndex) = RGB(255, 255, 0) .AddItem "Cyan" .ItemData(.NewIndex) = RGB(0, 255, 255) .AddItem "Magenta" .ItemData(.NewIndex) = RGB(255, 0, 255) .AddItem "White" .ItemData(.NewIndex) = RGB(255, 255, 255) .ListIndex = 0 End With optShape(0).Value = True End Sub Private Sub optShape_Click(Index As Integer) mlngChosenShape = Index End Sub Private Sub picDrawingArea_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Call mDrawShape(X, Y) End Sub Private Sub picDrawingArea_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton And chkContinuousDrawing = vbChecked Then Call mDrawShape(X, Y) End If End Sub Private Sub mDrawShape(X As Single, Y As Single) Dim lngColour As Long lngColour = lstColours.ItemData(lstColours.ListIndex) Select Case optShape(mlngChosenShape).Caption Case "Circle" picDrawingArea.Circle (X, Y), 300, lngColour Case "Square" picDrawingArea.Line (X - 300, Y - 300)-(X + 300, Y + 300), lngColour, B Case "Horizontal Line" picDrawingArea.Line (X - 300, Y)-(X + 300, Y), lngColour Case "Vertical Line" picDrawingArea.Line (X, Y - 300)-(X, Y + 300), lngColour Case Else MsgBox "Encountered unexpected shape """ & optShape(mlngChosenShape).Caption & """", vbExclamation, "Warning" End Select End Sub