' Sätter parameterlängd
Const PARAM_LEN = 10
' Dessa variabler används för att hålla reda på
' när du ritar din bild.
Dim iX As Integer, iY As Integer
Public Function sCurrentColor() As String
'
' Funktionen kontrollerar för att se vilken färgknapp som är
' vald när du ritar, Färgen returneras formatterad som en
' parameter.
Dim i As Integer
Dim sFormatStr As String
For i = 1 To PARAM_LEN
sFormatStr = sFormatStr & "0"
Next i
' Kontrollera alla färgerna för att finna den
' förgen som är markerad.
For i = 0 To picSelColor.UBound
If picSelColor(i).BorderStyle = 1 Then
sCurrentColor = Format(picSelColor(i).BackColor, sFormatStr)
Exit Function
End If
Next i
End Function
Private Sub cmdClear_Click(Index As Integer)
' Rensar bilden
picDraw.Cls
End Sub
Private Sub cmdEnd_Click()
' Avslutar programmet
Unload Me
End Sub
Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' Musen är över ritytan och musknappen är nertryckt.
Dim siX1 As String
Dim siY1 As String
Dim siX2 As String
Dim siY2 As String
Dim sFormatStr As String, sFormatStr2 As String
Dim i As Integer
' Positionerna för vad som skall ritas får längden av PARAM_LEN.
' Är koordinaterna negativa innehåller den "-" i början
For i = 1 To PARAM_LEN
sFormatStr = sFormatStr & "0"
Next i
For i = 1 To PARAM_LEN - 1
sFormatStr2 = sFormatStr2 & "0"
Next i
' Formatterar koordinaterna.
If X >= 0 Then
siX2 = Format(X, sFormatStr)
Else
siX2 = Format(X, sFormatStr2)
End If
If Y >= 0 Then
siY2 = Format(Y, sFormatStr)
Else
siY2 = Format(Y, sFormatStr2)
End If
' Ritar linjen. Eftersom musen just tryckts, så ritar vi
' en linje där du klickade på musknappen.
picDraw.Line (X, Y)-(X, Y), sCurrentColor
' Kom ihåg vart vi var så den nya linjen kan ritas
' och gå dit den tidigare linjen ritades.
iX = X
iY = Y
End Sub
Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim siX1 As String
Dim siY1 As String
Dim siX2 As String
Dim siY2 As String
Dim sFormatStr As String, sFormatStr2 As String
Dim i As Integer
If Button = vbLeftButton Then
' Musknappen trycktes och musen flyttas
' över ritytan.
' Positionerna opå linjen som skall ritas formatteras
For i = 1 To PARAM_LEN
sFormatStr = sFormatStr & "0"
Next i
For i = 1 To PARAM_LEN - 1
sFormatStr2 = sFormatStr2 & "0"
Next i
' Formatterar koordinaterna.
' Nu ritas linjen från föregående position
' till denna. (Se MouseDown händelsen.)
If iX >= 0 Then
siX1 = Format(iX, sFormatStr)
Else
siX1 = Format(iX, sFormatStr2)
End If
If iY >= 0 Then
siY1 = Format(iY, sFormatStr)
Else
siY1 = Format(iY, sFormatStr2)
End If
If X >= 0 Then
siX2 = Format(X, sFormatStr)
Else
siX2 = Format(X, sFormatStr2)
End If
If Y >= 0 Then
siY2 = Format(Y, sFormatStr)
Else
siY2 = Format(Y, sFormatStr2)
End If
' Rita linjen
picDraw.Line (iX, iY)-(X, Y), sCurrentColor
' Kom ihåg vart vi avslutade, så vi kan ansluta
' till den punkten nästa gång.
iX = X
iY = Y
End If
End Sub
Private Sub picSelColor_Click(Index As Integer)
Dim i As Integer
For i = 0 To picSelColor.UBound
picSelColor(i).BorderStyle = 0
Next i
picSelColor(Index).BorderStyle = 1
End Sub