Рисование линий и ещё

[upor]

Уважаемые Гуру Visual Basic Помогите разобраться
Мне надо сделать такую штуку
Делаю щелчок по форме и начинаю вести курсор (клавиша не нажата)
Должна рисоваться линия заданного цвета . Делаю двойной клик Рисование
прекрощается

Воткакя себе это предстовлял
Dim X0 As Single
Dim Y0 As Single


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Устонавливаю начальное значение линии
X0 = X
Y0 = Y

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Вот тут наверно надо записать Что если Клик был то
Line (X0, Y0)-(X, Y), 255
End Sub
'Вот незнаю как это записать
'И вот вторая проблема . Программа в оккурат рисует все линии по
'заданным координатам и получается вместо одной линии практически
сплошное закрашивание а мне нужна одна линия
Потом хотелось бы сделать так чтоб если кликнуть по линии готовой
то чтоб она перекрасилась в другой цвет


Я тутнашол такой вот пример который решает некоторые мои вопросы
но появляются новые

Dim x0 As Single, y0 As Single, DrawFirst As Boolean

Private Sub Form_Load()
DrawMode = vbInvert
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
x0 = X
y0 = Y
DrawFirst = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
' Если кнопка не нажата, то выходим из процедуры
If Button = 0 Then Exit Sub
' Если линия уже была нарисована, то стираем ее
If DrawFirst = False Then
Line (x0, y0)-(CurrentX, CurrentY)
End If
' Рисуем новую линию
Line (x0, y0)-(X, Y)
DrawFirst = False
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If DrawFirst = False Then
Line (x0, y0)-(CurrentX, CurrentY)
End If
End Sub

Тут у меня полный завал Вот хоть убейте но совсем не понимаю как
работает DrawFirst As Boolean (Что это Переменная принимает значение
только правда или ложь я знаю но как она работает непредстовляю) и
как следствие непонимаю как стираются ненужные линии (еслиможно то
здесь по подробнее)
Потом если DrawMode = vbInvert то не меняется цвет а рисует только
чёрным А если Copy Pen то опять куча линий
И почему при пересечении линий точка пересечения как бы стирается

Вот такие вопросы Да и как их решить стандартными методами (если
возможно)А то АПИ я пока не тяну
Всем спасибо

[A.A.Z.]

Можно через объект Line

Код: Выделить всё

Option Explicit
Dim L() As Line, I&, Draw As Boolean, MU As Boolean, Color&

Private Sub Form_Load()
Color = vbBlue
End Sub

Private Sub Form_MouseUp(Button%, Shift%, X!, Y!)
If MU Then MU = False: Exit Sub
ReDim Preserve L(I) As Line
Set L(I) = Me.Controls.Add("VB.Line", "L" & I)
I = I + 1
Draw = True
L(I - 1).X1 = X
L(I - 1).Y1 = Y
L(I - 1).Visible = True
End Sub

Private Sub Form_DblClick()
Draw = False: MU = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Draw
Case True
L(I - 1).X2 = X
L(I - 1).Y2 = Y
L(I - 1).BorderColor = Color
End Select
End Sub

Так проще будет

[upor]

Спасибо за код всё работает , но вот только вопросов ещё больше стало . Если это возможно
то будте так добры написать пояснения к коду что и как делает программа .А то есличестно как
в первый раз увидел код программы
И ещё это то не принципиально но интересно : почему когда рисуешьтолстые линии то на форме как бы мерцание
и почему если свойство формы Auturedraw=false когда сворачиваешь и опять разворачиваешь
форму сохроняется рисунок
И вот ещёвопрос Я немного дописал код и вот что получилось если вводить данные до рисования
(там цвет ,толщина линии) то всё срабатывает , а вот как сделать так чтоб можно было редактировать
уже нарисованные линии причём не целиком ломанную а ёё участок прямую . Ну чтоб это происходило
примерно так кликаем кнопку "редоктировать" и кликаем по линии и можно менять её параметры ?
Заранее спасибо

[Опришник]

Тут всё просто
1) создадим глобальные переменные EditSt As Boolean, LineI&
2) при нажатие "редактировать" EditSt=True
3) при клике на форме
If EditSt Then
'Получаем индекс линии
LineI = GetLineI(X,Y) 'код этой функции в самом низу
Else
...
4) получили индекс, теперь можно редактировать

Код: Выделить всё

'Функция GetLineI возвращает индекс линии, которой принадлежит точка(X;Y)
Function GetLineI(X!, Y!) As Long
Dim J&, a!, b!, c0!, c1!, sL!, sR!, Xc!, Yc!
For J = 0 To I - 1
    With L(J)
        'Уравнение прямой содержащей линию L(J)
                                'можно представить как a*x+b*y+c0=0,
            'прямой содержащей перпендикуляр к L(J) как -b*x+a*y+c1=0
        a = .Y2 - .Y1
        b = .X1 - .X2
        c0 = -.X1 * a - .Y1 * b
        c1 = X * b - Y * a
        'sL - квадрат длины линии L(J)
        sL = a * a + b * b
        If sL Then
            '(Xc;Yc) - точка пересечения прямой(которой принадлежит линия L(J))
                        'и её перпендикуляра, проведённого из (X;Y)
            Xc = (b * c1 - a * c0) / sL
            Yc = -(a * c1 + b * c0) / sL
            'sR - квадрат полутолщины линии L(J)
            sR = 0.25 * .BorderWidth * .BorderWidth + 3 '3 добавляем для повышения точности попадания курсора
            'Если длина перпендикуляра меньше или равна полудиаметру и
                                'точка (Xc;Yc) принадлежит линии L(J), или
            '(X;Y) лежит в одной из окружностей с центрами (.X1;.Y1), (.X2;.Y2)
                                        'и диаметром равным толщине линии L(J)
            'То возвращаем индекс линии и выходим из функции
            If sR >= (Xc - X) ^ 2 + (Yc - Y) ^ 2 And (.X1 - Xc) * (.X2 - Xc) <= 0 _
            Or sR >= (.X1 - X) ^ 2 + (.Y1 - Y) ^ 2 _
            Or sR >= (.X2 - X) ^ 2 + (.Y2 - Y) ^ 2 Then
                GetLineI = J
                Exit Function
            End If
        End If
    End With
Next
'Если точка не принадлежит не одной линии, то возвращаем -1
GetLineI = -1
End Function


примечание: функция работает корректно если ScaleMode = 3 'Pixel

[upor]

Хотел соединить 2 представленных мне выше кода и потерпел полное фиаско
(Ну не хватает пока мозгов)
Мужики , простите за назойливость но немоглиб выдать мне готовый код
По мере обучения буду его разбирать а пока так поюзаю
Есть форма на ней2 текстовых поля (тощина и цвет лини) и 2 кнопки
(рисовать и редактировать ) Нажимаю "рисовать" Щёлкаю мышой по форме
рисую линию Щёлкаю 2 раза закончилось рисование . В поля "толщина" и
"цвет" Ввожу данные .Дальше нажимаю "редактировать" Щёлкаю мышой по куску
нарисованной ломанной и она принимает параметры полей "толщина" и
"цвет"И всё это без АПИ
Да , чувствую с графикой попал в засаду.
всем спосибо

[A.A.Z.]

В блоконте создай файл Form1.frm и вставь туда этот текст:

Код: Выделить всё

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Draw"
   ClientHeight    =   7965
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8955
   LinkTopic       =   "Form1"
   ScaleHeight     =   531
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   597
   StartUpPosition =   3  'Windows Default
   Begin VB.OptionButton optWidth
      Caption         =   "Редактировать"
      Height          =   375
      Left            =   1680
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   720
      Width           =   1335
   End
   Begin VB.OptionButton optDraw
      Caption         =   "Рисовать"
      Height          =   375
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   720
      Width           =   1335
   End
   Begin VB.TextBox txtWidth
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Text            =   "10"
      Top             =   240
      Width           =   1335
   End
   Begin VB.TextBox txtColor
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Text            =   "0"
      Top             =   240
      Width           =   1335
   End
   Begin VB.Label lblWidth
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "Толщина"
      Height          =   195
      Left            =   2010
      TabIndex        =   5
      Top             =   0
      Width           =   705
   End
   Begin VB.Label lblColor
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "Цвет"
      Height          =   195
      Left            =   705
      TabIndex        =   4
      Top             =   0
      Width           =   405
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim L() As Line, I&, Draw As Boolean, DrawNow As Boolean, MU As Boolean, Ind&

Private Sub Form_Load()
Draw = False
DrawNow = True
MU = True
optDraw.Value = True
End Sub

Private Sub Form_MouseDown(Button%, Shift%, X!, Y!)
If DrawNow = False And Draw = False And MU = True Then Ind = GetLineI(X, Y)
End Sub

Private Sub Form_MouseUp(Button%, Shift%, X!, Y!)
If DrawNow = False And Draw = False And MU = True Then Exit Sub
If MU Then MU = False: Exit Sub
ReDim Preserve L(I) As Line
Set L(I) = Me.Controls.Add("VB.Line", "L" & I)
I = I + 1
Draw = True
L(I - 1).X1 = X
L(I - 1).Y1 = Y
L(I - 1).BorderWidth = txtWidth.Text
L(I - 1).Visible = True
End Sub

Private Sub Form_DblClick()
Draw = False: MU = True
Me.Controls.Remove ("L" & I - 1)
Me.Controls.Remove ("L" & I - 2)
Set L(I - 1) = Nothing
Set L(I - 2) = Nothing
I = I - 2
End Sub

Private Sub Form_MouseMove(Button%, Shift%, X!, Y!)
If DrawNow And Draw Then
L(I - 1).X2 = X
L(I - 1).Y2 = Y
L(I - 1).BorderColor = txtColor.Text
End If
End Sub

Private Sub optDraw_Click()
DrawNow = True: Draw = False: MU = True
End Sub

Private Sub optWidth_Click()
DrawNow = False: Draw = False: MU = True
End Sub

Function GetLineI&(X!, Y!)
Dim J&, a!, b!, c0!, c1!, sL!, sR!, Xc!, Yc!
For J = 0 To I - 1
With L(J)
a = .Y2 - .Y1
b = .X1 - .X2
c0 = -.X1 * a - .Y1 * b
c1 = X * b - Y * a
sL = a * a + b * b
If sL Then
Xc = (b * c1 - a * c0) / sL
Yc = -(a * c1 + b * c0) / sL
sR = 0.25 * .BorderWidth * .BorderWidth + 3
If sR >= (Xc - X) ^ 2 + (Yc - Y) ^ 2 And (.X1 - Xc) * (.X2 - Xc) <= 0 Or sR >= (.X1 - X) ^ 2 + (.Y1 - Y) ^ 2 Or sR >= (.X2 - X) ^ 2 + (.Y2 - Y) ^ 2 Then
GetLineI = J
Exit Function
End If
End If
End With
Next
GetLineI = -1
End Function

Private Sub txtColor_KeyPress(KeyAscii%)
If Ind = -1 Then Exit Sub
If KeyAscii = 13 Then L(Ind).BorderColor = txtColor.Text
End Sub

Private Sub txtWidth_KeyPress(KeyAscii%)
If Ind = -1 Then Exit Sub
If KeyAscii = 13 Then L(Ind).BorderWidth = txtWidth.Text
End Sub

Затем сохрани и открой уже в VB.

[upor]

Помогите разобраться до конца в данном коде и исправте где я не прав
Option Explicit
Dim L() As Line, I&, Draw As Boolean, MU As Boolean, Color&

Private Sub Form_Load()
Color = vbBlue
End Sub
До сюдавсё ясно
Private Sub Form_MouseUp(Button%, Shift%, X!, Y!) Ну само собатие понятно
If MU Then MU = False: Exit Sub Тут если мыш нажата то выйти из процедуры
Вот тут попрошу очень подробноПонимаю что создаётся динамический массив
но как он работает в этом примере ?
ReDim Preserve L(I) As Line
Set L(I) = Me.Controls.Add("VB.Line", "L" & I) Вот этустроку вообще не понимаю
Расскажите на пальцах о ней ?
I = I + 1 Ну тут вроде как делаем вторую запись в массив
Draw = True
L(I - 1).X1 = X Это тоже смутно Пчему i-1
L(I - 1).Y1 = Y
L(I - 1).Visible = True Почему линии досель небыливидны
End Sub

Private Sub Form_DblClick()
Draw = False: MU = True Тут всё ясно
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
А как записать без касе ,а то я с ним недружу
Select Case Draw
Case True
L(I - 1).X2 = X
L(I - 1).Y2 = Y
L(I - 1).BorderColor = Color
End Select
End Sub

[A.A.Z.]

Используй код, который я выше привел - он лучше По нему могу объяснить

[upor]

Ничего не имею против
Только по подробнее как в детском саду
Спосибо

[A.A.Z.]

Сорри, что долго

Код: Выделить всё

Option Explicit

Dim L() As Line, I&, Draw As Boolean, DrawNow As Boolean, MU As Boolean, Ind&

Private Sub Form_Load()
Draw = False 'по mousemove рисовать не надо
DrawNow = True 'режим рисования (не редактирования)
MU = True 'линия не рисуется ("MouseUp" = True, MU - "MouseUp")
optDraw.Value = True
End Sub

Private Sub Form_MouseDown(Button%, Shift%, X!, Y!)
If DrawNow = False And Draw = False And MU = True Then Ind = GetLineI(X, Y)
'если режим редактирования + рисовать не надо (а вдруг? :)) + "MouseUp" = True тогда получить Ind = индекс линии под курсором
End Sub

Private Sub Form_MouseUp(Button%, Shift%, X!, Y!)
If DrawNow = False And Draw = False And MU = True Then Exit Sub
'если режим редактирования, то ничего не делать
If MU Then MU = False: Exit Sub
'если нажали первый раз, то изменить переменную (следующий раз будет вторым) и выйти (остальное сделает MouseMove)
'если нет, то:
ReDim Preserve L(I) As Line 'переобъявляем массив линий, сделав его на 1 больше (чуть ниже есть строчка I=I+1), и сохранив предыдущие
Set L(I) = Me.Controls.Add("VB.Line", "L" & I) 'прибавляем в массив созданную только что линию
I = I + 1 'логичнее было бы эту строчку поместить выше, перед переобъявлением, но так тоже можно
Draw = True 'создали линию, теперь по mousemove можно рисовать
L(I - 1).X1 = X 'присваиваем ей соответствующие координаты и параметры
L(I - 1).Y1 = Y
L(I - 1).BorderWidth = txtWidth.Text
L(I - 1).Visible = True 'по поводу Visible. Когда создаешь ЭУ вышеуказанным способом (Me.Controls.Add ...), то по умолчанию у ЭУ Visible = False.
End Sub

Private Sub Form_DblClick()
Draw = False: MU = True 'рисовать не надо; "MouseUp" = True
Me.Controls.Remove ("L" & I - 1) 'удалить одну линию, порожденную DBLclick'ом (щелкали-то мы 2 раза)
Set L(I - 1) = Nothing
I = I - 1
End Sub

Private Sub Form_MouseMove(Button%, Shift%, X!, Y!)
If DrawNow And Draw Then 'если режим рисования и один раз уже нажали, то присвоить коорд. мыши координатам линии
L(I - 1).X2 = X
L(I - 1).Y2 = Y
L(I - 1).BorderColor = txtColor.Text
End If
End Sub

Вот, собсна, и все Будут еще вопросы - спрашивай!

[upor]

1. Set L(I) = Me.Controls.Add("VB.Line", "L" & I) Вот в общем случае как это
записать т.е что значит Me.Controls.Add и "VB.Line" и "L" & I ?
Вообще с масивами завал везде описано как их объявлять но нигде нету
как их заполнять
2. Вот на форме рисую какойнибудь стандартную фигуру ну пусть прямоугольник
даю ему Name Pr Вообщем пишу код

Dim A as Line
Set A= Pr Всё теперь с этем прямоугольником могу вытворять всё что угодно
А вот как поступить если прямоугольник создовался программно
Line (x1,y1)-(x2,y2),,B И вот как мне привязать его к А ну чтоб
программа знала что А это мой прямоугольник Line (x1,0y1)-(x2,y2),,B ?

[A.A.Z.]

1. Set L(I) = - Присваиваем элементу I массива линий L
Me.Controls.Add - Функция, добавляющая объект на форму и использующая его в качестве возвращаемого значения. Параметры функции - (1) класс создаваемого объекта и (2) имя создаваемого объекта.
"VB.Line" - класс "Линия"
"L" & I - новое имя объекта (например, если линия 10ая по счету, то ее имя будет L9).
Вроде все

2. Никак. То, что ты нарисовал, не является объектом в VB. А объект Shape (Line / Label / Image) - это совсем другое (хотя и не намного )

[upor]

Ну кажись пошли дела потиху. Остальное редактирование там пересечение линий заливка пространства
это уже математика а не програмирование . Спасибо за помощь
Только вот хотелосьбы побольше узнать о функции Me.Controls.**.(*******).Как записывается
в общем виде,её составляющие , где применяется ну и всё что о ней нужно знать чтобы выжать
из неё всё что можно ?

[A.A.Z.]

M S D N


http://msdn.microsoft.com/library/defau ... collection).asp

Это обычная коллекция, там практически ничего такого больше и нет