02. Данный способ позволяет вам нарисовать некоторые объекты в форме, хотя в программе Международный Туризм использовался другой алгоритм для рисования карты. Этот способ может Вам пригодится в некоторых случаях. Рисуются линии, точки, элипсы, многоугольники, т.е. те базовые объекты, которые применяются в api интерфейсе.
' Функция используется для поиска окна
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWndParent As Long, _
ByVal hWndChildAfter As Long, _
ByVal lpClassname As String, _
ByVal lpWindowName As String) As Long
' Функция возвращает контекст устройства для рисования
Private Declare Function apiGetDC Lib "user32" Alias "GetDC" _
(ByVal hwnd As Long) _
As Long
' Функция освобождает контекст устройства для других приложений
Private Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" _
(ByVal hwnd As Long, _
ByVal hDc As Long) _
As Long
'==============================================================
' Далеее идут, функции управляющие рисованием
' Функция рисует точку на экране
Private Declare Function apiSetPixel Lib "gdi32" Alias "SetPixel" _
(ByVal hDc As Long, _
ByVal x As Long, _
ByVal Y As Long, _
ByVal crColor As Long) As Long
' Функция рисует линию из текущей позиции "пера" до точки с координатами
' x,y, но не включая ее саму. Линия рисуется с помощью выбранного "пера". Если
' нет ошибки, то текущее положение пера устанавливается в точку с координатами
' (x,y)
Private Declare Function apiLineTo Lib "gdi32" Alias "LineTo" _
(ByVal hDc As Long, _
ByVal x As Integer, _
ByVal Y As Integer) _
As Long
' Функция рисует дугу элипса с помощью выбранного "пера".
' Дуга рисуется против часовой стрелки.
' (x1,y1 - x2,y2) ограничивающий прямоугольник для дуги.
' (x3,y3) - начальная точка рисования "пером"
' (x4,y4) - конечная точка рисования дуги
Private Declare Function apiArc Lib "gdi32" Alias "Arc" _
(ByVal hDc As Long, _
ByVal X1 As Integer, _
ByVal Y1 As Integer, _
ByVal X2 As Integer, _
ByVal Y2 As Integer, _
ByVal X3 As Integer, _
ByVal Y3 As Integer, _
ByVal X4 As Integer, _
ByVal Y4 As Integer) _
As Long
' Функция рисует прямоугольник с помощью выбранного "пера".
' (x1,y1) - первый угол
' (x2,y2) - противоположный угол
Private Declare Function apiRectangle Lib "gdi32" Alias "Rectangle" _
(ByVal hDc As Long, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) As Long
' Функция передвигает позицию рисования
' (x,y) - новая точка
' (lpPoint) - предыдущая точка
Private Declare Function apiMoveTo Lib "gdi32" Alias "MoveToEx" _
(ByVal hDc As Long, _
ByVal x As Long, _
ByVal Y As Long, _
lpPoint As POINTAPI) As Long
' Структура координаты точки
Private Type POINTAPI
x As Long
Y As Long
End Type
' Функция рисует элипс с помощью выбранного "пера".
' (x1,y1) - первый угол
' (x2,y2) - противоположный угол
Private Declare Function apiEllipse Lib "gdi32" Alias "Ellipse" _
(ByVal hDc As Long, _
ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
' Функция рисует ломаную с помощью выбранного "пера"
' lpPoint - массив точек
' nCount - число точек
Private Declare Function apiPolyline Lib "gdi32" Alias "Polyline" _
(ByVal hDc As Long, _
lpPoint As POINTAPI, _
ByVal nCount As Long) As Long
' Функция рисует ломаную с помощью выбранного "пера"
' lpPoint - массив точек
' nCount - число точек
Private Declare Function apiPolygon Lib "gdi32" Alias "Polygon" _
(ByVal hDc As Long, _
lpPoint As POINTAPI, _
ByVal nCount As Long) As Long
' Функция заливает круг с помощью выбранного "пера"
' (x1,y1 - x2,y2) ограничивающий прямоугольник для дуги
' (x3,y3) - начальная точка рисования "пером"
' (x4,y4) - конечная точка рисования дуги
Private Declare Function apiChord Lib "gdi32" Alias "Chord" _
(ByVal hDc As Long, _
ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long, _
ByVal X3 As Long, ByVal Y3 As Long, _
ByVal X4 As Long, ByVal Y4 As Long) As Long
' Функция заливает круг с помощью выбранного "пера"
' (x1,y1 - x2,y2) ограничивающий прямоугольник для дуги
' (x3,y3) - начальная точка рисования "пером"
' (x4,y4) - конечная точка рисования дуги
Private Declare Function apiPie Lib "gdi32" Alias "Pie" _
(ByVal hDc As Long, _
ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long, _
ByVal X3 As Long, ByVal Y3 As Long, _
ByVal X4 As Long, ByVal Y4 As Long) As Long
'==============================================================
' Назначение
' Нарисовать объекты
'
Private Sub butExecute_Click()
Dim hwnd As Long, hDc As Long 'Окно и контекст рисования
Dim X1 As Long, Y1 As Long, X2 As Long, Y2 As Long
Dim xy(3) As POINTAPI 'Точки рисования
On Error GoTo 999
'Очистить зону рисования
Me.Refresh
DoEvents
'Поиск окна для рисования. Это решение предложено
'Николаем Малютиным г.Якутск: malnik@mail.ru
hwnd = FindWindowEx(Me.hwnd, FindWindowEx(Me.hwnd, 0, "OFormSub", ""), "OFormSub", "")
'Выбираем контекст устройства
hDc = apiGetDC(hwnd)
'Координаты зоны рисования
X1 = 15
Y1 = 90
X2 = 180
Y2 = 250
'Рисуем объекты
Select Case Me.Объекты
Case 1: 'Точка - красная
Call apiSetPixel(hDc, X2 / 2, Y2 / 2, RGB(255, 0, 0))
Case 2: 'Линия
Call apiMoveTo(hDc, X1, Y1, xy(0)) 'Передвигаем указатель
Call apiLineTo(hDc, X2, Y2) 'Рисуем линию
Case 3: 'Элипс
Call apiEllipse(hDc, X1, Y1, X2, Y2 / 2)
Case 4: 'Прямоугольник - закрашенный
Call apiRectangle(hDc, X1, Y1, X2, Y2)
Case 5: 'Дуга
Call apiArc(hDc, X1, Y1, X2, Y2, 50, 100, 150, 150)
Case 6, 7: 'Ломаная, Заливка
' Загружаем координаты
xy(0).x = X1
xy(0).Y = Y1
xy(1).x = X1 + 20
xy(1).Y = Y2
xy(2).x = X2
xy(2).Y = Y2 - 20
If Me.Объекты = 6 Then 'Ломаная
Call apiPolyline(hDc, xy(0), UBound(xy))
Else 'Заливка
Call apiPolygon(hDc, xy(0), UBound(xy))
End If
Case 8: 'Заливка круга до хорды
Call apiChord(hDc, X1, Y1, X2, Y2, 50, 100, 150, 150)
Case 9: 'Заливка круга из центра
Call apiPie(hDc, X1, Y1, X2, Y2, 50, 100, 150, 150)
End Select
'Освобождаем контекст устройства
Call apiReleaseDC(hwnd, hDc)
Exit Sub
999:
MsgBox Err.Description 'Ошибка
Err.Clear
End Sub