При отпускании кнопки мыши
а. Массив переопределяется на 1 элемент больше
б. координаты новой линии добавляются в массив
Чтобы не загромождать событие MouseMove, добавим отбельную процедуру перерисовки ReDraw(). Так же добавим процедуру добавления новых координат в массив MF() AddNew()
Полный код этой программы:
Dim AnchorX As Integer
Dim AnchorY As Integer
Dim OldX As Integer
Dim OldY As Integer
Dim MF() As Integer
Dim n As Integer ‘счетчик новых записей в массиве
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
AnchorX = X
AnchorY = Y
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Line (AnchorX, AnchorY)-(X, Y)
Call AddNew(AnchorX, AnchorY, X, Y)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button Then
Me.Line (AnchorX, AnchorY)-(OldX, OldY), &H8000000F
Me.Line (AnchorX, AnchorY)-(X, Y)
OldX = X
OldY = Y
ReDraw
End If
End Sub
Public Sub ReDraw()
For i = 1 To n
Me.Line (MF(1, i), MF(2, i))-(MF(3, i), MF(4, i))
Next i
End Sub
Public Sub AddNew(a, b, c, d)
n = n + 1
ReDim Preserve MF(4, n)
MF(1, n) = a
MF(2, n) = b
MF(3, n) = c
MF(4, n) = d
End Sub
Редактор для линий готов.
Теперь более серьезная задача.
Наш редактор может рисовать только одну линию. Сделайте так, чтобы редактор рисовал еще и прямоугольники. Напоминаю, команда рисования прямоугольника такая же как и линии, только после цвета ставится буква “b”:
Me.Line (AnchorX, AnchorY)-(X, Y), , B
Две запятые подряд – пропущен цвет (оставлен черный по умолчанию). Но запятые должны быть, даже если не указан цвет – таков синтаксис оператора.
Для переключения на рисование прямоугольника – сделайте кнопку на панели инструментов. Рисунок на кнопке – прямоугольник. Чтобы не искать такой рисунок, мы его сделаем сами. Для этого используем программу Imagedit. Вы можете ее скопировать себе на дискету. Она находится в каталоге Visual Basic’а.
З
апустите
программу:
Пункт меню File>New…
Выбрать пункт Icon(!)
Затем EGA/VGA 16 color…
Пункт меню Options>Grid (отобразить сетку)
З
алейте
весь рисунок цветом экрана (Screen)
– стандартный сине-зеленый. Это сделает
фон прозрачным для системной палитры
Windows (увидите).Затем черным нарисуйте прямоугольник.
Сохраните. Затем этот рисунок Вы вставите в проект на кнопку панели инструментов.
Далее.
Для того, чтобы указывать редактору, что рисовать – используют установку флага (переменную типа Boolean). Если флаг установлен (true) – рисовать прямоугольник. Сброшен (false) – рисовать прямую. Флаг устанавливается по нажатию кнопки. Кнопка должна иметь свойство оставаться нажатой (tbrCheck) при рисовании квадрата. Затем, для рисования линии, мы ее отжимаем щелчком мыши.
Сделайте это и запустите программу – она должна рисовать так, как надо, но при перерисовке (ReDraw) в прямоугольники вставляет линии. Даже если Вы процедуру перерисовки сделаете зависимой от состояния флага – это не поможет – флаг имеет одно состояние для всей перерисовки. Это будут либо линии, либо прямоугольники.
Чтобы перерисовка была правильной – надо при сохранении координат фигуры в массиве сохранять еще и состояние флага. Затем считывать координаты вместе с флагом.
При сохранении состояния флага в массиве помните, что массив хранит только однотипные элементы – сохранение в массиве типа Integer переменной типа Boolean вызовет ошибку! Поэтому перед записью флага в массив преобразуйте его в число (0 – false или 1 – true )
Программа (сначала самостоятельно)
Dim AnchorX As Integer
Dim AnchorY As Integer
Dim OldX As Integer
Dim OldY As Integer
Dim MF() As Integer
Dim n As Integer
Dim Flag As Boolean
Private Sub Form_Load()
Flag = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
AnchorX = X
AnchorY = Y
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Flag Then
Me.Line (AnchorX, AnchorY)-(X, Y), , B
Else
Me.Line (AnchorX, AnchorY)-(X, Y)
End If
Call AddNew(AnchorX, AnchorY, X, Y, Flag)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button Then
If Flag Then
Me.Line (AnchorX, AnchorY)-(OldX, OldY), &H8000000F, B
Me.Line (AnchorX, AnchorY)-(X, Y), , B
Else
Me.Line (AnchorX, AnchorY)-(OldX, OldY), &H8000000F
Me.Line (AnchorX, AnchorY)-(X, Y)
End If
OldX = X
OldY = Y
ReDraw
End If
End Sub
Public Sub ReDraw()
For i = 1 To n
If MF(5, i) = 1 Then
Me.Line (MF(1, i), MF(2, i))-(MF(3, i), MF(4, i)), , B
Else
Me.Line (MF(1, i), MF(2, i))-(MF(3, i), MF(4, i))
End If
Next i
End Sub
Public Sub AddNew(a, b, c, d, e)
n = n + 1
ReDim Preserve MF(5, n)
MF(1, n) = a
MF(2, n) = b
MF(3, n) = c
MF(4, n) = d
If e Then
MF(5, n) = 1
Else
MF(5, n) = 0
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Flag = Not (Flag)
End Sub
