Tvoření těchto objektů je velmi jednoduché a spočívá v přidání B nebo BF za vykreslování Line. Jak, to se dozvíte v následujícím kódu:
Dim xa1 As Single
Dim ya1 As Single
Dim barva As Long
Public Sub Squere1(Img As PictureBox, Xa As Single, Ya As Single, Clr As Long)
xa1 = Xa
ya1 = Ya
End Sub
Public Sub Squere2(Img As PictureBox, Xa As Single, Ya As Single, Width As Long, button As Integer, Clr As Long, Shift As Integer)
Img.DrawWidth = Width
If button = 1 Then
Img.AutoRedraw = False
Img.Refresh
If Shift = 1 Then
If Xa < xa1 Then
Xsig = -1
Else
Xsig = 1
End If
If Ya < ya1 Then
Ysig = -1
Else
Ysig = 1
End If
chng = Abs(ya1 - Ya)
Img.Line (xa1, ya1)-(xa1 + chng * Xsig, ya1 + chng * Ysig), Clr, B
Else
Img.Line (xa1, ya1)-(Xa, Ya), Clr, B
End If
Img.AutoRedraw = True
End If
End Sub
Public Sub Squere3(Img As PictureBox, Xa As Single, Ya As Single, Width As Long, button As Integer, Clr As Long, Shift As Integer)
Img.DrawWidth = Width
If button = 1 Then
Img.AutoRedraw = True
If Shift = 1 Then
If Xa < xa1 Then
Xsig = -1
Else
Xsig = 1
End If
If Ya < ya1 Then
Ysig = -1
Else
Ysig = 1
End If
chng = Abs(ya1 - Ya)
Img.Line (xa1, ya1)-(xa1 + chng * Xsig, ya1 + chng * Ysig), Clr, B
Else
Img.Line (xa1, ya1)-(Xa, Ya), Clr, B
End If
Img.Refresh
End If
End Sub
Private Sub Picture1_MouseDown(button As Integer, Shift As Integer, x As Single, y As Single)
Squere1 Picture1, x, y, barva
End Sub
Private Sub Picture1_MouseMove(button As Integer, Shift As Integer, x As Single, y As Single)
Squere2 Picture1, x, y, 3, button, barva, Shift
End Sub
Private Sub Picture1_MouseUp(button As Integer, Shift As Integer, x As Single, y As Single)
Squere3 Picture1, x, y, 3, button, barva, Shift
End Sub
Jak vidíte, kód je jen modifikovaný z minulého dílu tohoto seriálu. Modifikací může být mnoho, například opět zarovnání na mřížku a podobné, ale pro nás bude důležitá modifikace pomocí BF. To znamená, že budeme tvořit plné čtverce či obdélníky.
Dim xa1 As Single
Dim ya1 As Single
Dim barva As Long
Public Sub Squere1(Img As PictureBox, Xa As Single, Ya As Single, Clr As Long)
xa1 = Xa
ya1 = Ya
End Sub
Public Sub Squere2(Img As PictureBox, Xa As Single, Ya As Single, Width As Long, button As Integer, Clr As Long, Shift As Integer)
Img.DrawWidth = Width
If button = 1 Then
Img.AutoRedraw = False
Img.Refresh
If Shift = 1 Then
If Xa < xa1 Then
Xsig = -1
Else
Xsig = 1
End If
If Ya < ya1 Then
Ysig = -1
Else
Ysig = 1
End If
chng = Abs(ya1 - Ya)
Img.Line (xa1, ya1)-(xa1 + chng * Xsig, ya1 + chng * Ysig), Clr, BF
Else
Img.Line (xa1, ya1)-(Xa, Ya), Clr, BF
End If
Img.AutoRedraw = True
End If
End Sub
Public Sub Squere3(Img As PictureBox, Xa As Single, Ya As Single, Width As Long, button As Integer, Clr As Long, Shift As Integer)
Img.DrawWidth = Width
If button = 1 Then
Img.AutoRedraw = True
If Shift = 1 Then
If Xa < xa1 Then
Xsig = -1
Else
Xsig = 1
End If
If Ya < ya1 Then
Ysig = -1
Else
Ysig = 1
End If
chng = Abs(ya1 - Ya)
Img.Line (xa1, ya1)-(xa1 + chng * Xsig, ya1 + chng * Ysig), Clr, BF
Else
Img.Line (xa1, ya1)-(Xa, Ya), Clr, BF
End If
Img.Refresh
End If
End Sub
Private Sub Picture1_MouseDown(button As Integer, Shift As Integer, x As Single, y As Single)
Squere1 Picture1, x, y, barva
End Sub
Private Sub Picture1_MouseMove(button As Integer, Shift As Integer, x As Single, y As Single)
Squere2 Picture1, x, y, 3, button, barva, Shift
End Sub
Private Sub Picture1_MouseUp(button As Integer, Shift As Integer, x As Single, y As Single)
Squere3 Picture1, x, y, 3, button, barva, Shift
End Sub
Kombinací obou kódů se dá dosáhnout ohraničených čtverců či obdelníků.
Dim xa1 As Single
Dim ya1 As Single
Dim barva As Long
Public Sub Squere1(Img As PictureBox, Xa As Single, Ya As Single)
xa1 = Xa
ya1 = Ya
End Sub
Public Sub Squere2(Img As PictureBox, Xa As Single, Ya As Single, Width As Long, button As Integer, Clr As Long, Clr2 As Long, Shift As Integer)
Img.DrawWidth = Width
If button = 1 Then
Img.AutoRedraw = False
Img.Refresh
If Shift = 1 Then
If Xa < xa1 Then
Xsig = -1
Else
Xsig = 1
End If
If Ya < ya1 Then
Ysig = -1
Else
Ysig = 1
End If
chng = Abs(ya1 - Ya)
Img.DrawWidth = 1
Img.Line (xa1, ya1)-(xa1 + chng * Xsig, ya1 + chng * Ysig), Clr, BF
Img.DrawWidth = Width
Img.Line (xa1, ya1)-(xa1 + chng * Xsig, ya1 + chng * Ysig), Clr2, B
Else
Img.DrawWidth = 1
Img.Line (xa1, ya1)-(Xa, Ya), Clr, BF
Img.DrawWidth = Width
Img.Line (xa1, ya1)-(Xa, Ya), Clr2, B
End If
Img.AutoRedraw = True
End If
End Sub
Public Sub Squere3(Img As PictureBox, Xa As Single, Ya As Single, Width As Long, button As Integer, Clr As Long, Clr2 As Long, Shift As Integer)
Img.DrawWidth = Width
If button = 1 Then
Img.AutoRedraw = True
If Shift = 1 Then
If Xa < xa1 Then
Xsig = -1
Else
Xsig = 1
End If
If Ya < ya1 Then
Ysig = -1
Else
Ysig = 1
End If
chng = Abs(ya1 - Ya)
Img.DrawWidth = 1
Img.Line (xa1, ya1)-(xa1 + chng * Xsig, ya1 + chng * Ysig), Clr, BF
Img.DrawWidth = Width
Img.Line (xa1, ya1)-(xa1 + chng * Xsig, ya1 + chng * Ysig), Clr2, B
Else
Img.DrawWidth = 1
Img.Line (xa1, ya1)-(Xa, Ya), Clr, BF
Img.DrawWidth = Width
Img.Line (xa1, ya1)-(Xa, Ya), Clr2, B
End If
Img.Refresh
End If
End Sub
Private Sub Picture1_MouseDown(button As Integer, Shift As Integer, x As Single, y As Single)
Squere1 Picture1, x, y
End Sub
Private Sub Picture1_MouseMove(button As Integer, Shift As Integer, x As Single, y As Single)
Squere2 Picture1, x, y, 3, button, &H0, &HFF, Shift
End Sub
Private Sub Picture1_MouseUp(button As Integer, Shift As Integer, x As Single, y As Single)
Squere3 Picture1, x, y, 3, button, &H0, &HFF, Shift
End Sub
Takto tedy dosáhnete efektu vyplněného čtverce či obdélníku. Více příště (nejspíš zůstaneme u čtverců a obdelníků a podíváme se na to jak vytvořit rozhraní pro nastvení pro uživatele).