Работа с графикой при помощи Win32 API
Объявим функции, которые нам понадобятся
Private Declare Function RoundRect Lib "gdi32" (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) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) _
As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) _
As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, ByVal crColor As Long, _
ByVal wFillType As Long) As Long
Private Declare Function SetPixel& Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, ByVal crColor As Long)
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, _
lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, _
lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function CreateBrushIndirect Lib "gdi32" _
(lpLogBrush As LOGBRUSH) As Long
Private Declare Function CreatePenIndirect Lib "gdi32" _
(lpLogPen As LOGPEN) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) _
As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd _
As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) _
As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
Private Declare Function Arc Lib "gdi32" (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 Declare Function Chord Lib "gdi32" (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 Declare Function Pie Lib "gdi32" (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 Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type LOGBRUSH
lbStyle As Long
lbColor As Long
lbHatch As Long
End Type
Private Type LOGPEN
lopnStyle As Long
lopnWidth As POINTAPI
lopnColor As Long
End Type
Private Const FLOODFILLBORDER = 0
Private Const FLOODFILLSURFACE = 1
Private Const BS_SOLID = 0
Private Const BS_HATCHED = 2
Private Const HS_HORIZONTAL = 0
Private Const HS_VERTICAL = 1
Private Const HS_FDIAGONAL = 2
Private Const HS_BDIAGONAL = 3
Private Const HS_CROSS = 4
Private Const HS_DIAGCROSS = 5
Private Const PS_SOLID = 0
Private Const PS_DASH = 1
Private Const PS_DOT = 2
Private Const PS_DASHDOT = 3
Private Const PS_DASHDOTDOT = 4
Графические функции Win32 API работают с графикой гораздо быстрее, чем стандартные функции VB. К тому же они позволяют рисовать на других окнах (например на рабочем столе), и практически на любых контролах. API функции работают с масштабом vbPixels несмотря на свойство ScaleMode. Для работы с графикой при помощи Win32 API требуется контекст устройства (hdc). Если у контрола его нет, то его можно получить при помощи функции GetWindowDC по описателю hwnd. Например, чтобы нарисовать линию на кнопке можно ввести следующий код:
Dim dc As Long
' Получаем hdc кнопки
dc = GetWindowDC(Command1.hwnd)
' Рисуем линию
LineTo dc, 100, 10
' Освобождаем ресурсы
ReleaseDC Command1.hwnd, dc
Есть еще одно отличие API от стандартных графических функций. При свойстве AutoRedraw = True после того как был нарисован рисунок, его надо обновить. Например
LineTo hdc, 100, 100
Refresh
Но метод Refresh работает довольно медленно. Лучше использовать API функцию InvalidateRect, которая обновляет не все окно, а только его часть. Например
Dim r As RECT
AutoRedraw = True
LineTo hdc, 100, 100
' Устанавливаем координаты участка, который
' нужно обновить
r.Left = 0
r.Top = 0
r.Right = 100
r.Bottom = 100
' Обновляем этот участок
InvalidateRect hwnd, r, True
Теперь рассмотрим что такое перо и кисть. Перо определяет тип линии т.е. ее толщину, цвет и стиль. Кисть определяет заливку, ее цвет и стиль. Следующий пример рисует в текстовом окошке квадрат с синей в черточку границей и красной штриховкой
Dim Pen As Long
Dim Brush As Long
Dim p As LOGPEN
Dim b As LOGBRUSH
Dim dc As Long
' Устанавливаем тип линии
p.lopnColor = vbBlue
p.lopnStyle = PS_DASH
' Устанавливаем тип заливки
b.lbStyle = BS_HATCHED
b.lbColor = vbRed
b.lbHatch = HS_FDIAGONAL
' Получаем hdc текстового окошка
dc = GetWindowDC(Text1.hwnd)
' Создаем перо
Pen = CreatePenIndirect(p)
' Создаем кисть
Brush = CreateBrushIndirect(b)
' Присваиваем контексту созданные перо и кисть
SelectObject dc, Pen
SelectObject dc, Brush
' Рисуем прямоугольник
Rectangle dc, 10, 10, 100, 100
' Освобождаем ресурсы
DeleteObject Brush
DeleteObject Pen
ReleaseDC Text1.hwnd, dc
Рассмотрев основные положения, можно приступить к рисованию
Функция RoundRect (hdc, X1, Y1, X2, Y2, X3, Y3) рисует прямоугольник с закругленными краями. Параметры x3 и y3 определяют закругленность углов по ширине и высоте. Например
RoundRect hdc, 10, 10, 100, 100, 10, 10
Функция MoveToEx (hdc, x, y, lpPoint) устанавливает позицию графического пера. Последний параметр этой функции возвращает предыдущее положение пера. Например
' Рисуем линию из точки (10,10) в точку (100,100)
Dim p As POINTAPI
MoveToEx hdc, 10, 10, p
LineTo hdc, 100, 100
Функция Ellipse (hdc, X1, Y1, X2, Y2) рисует эллипс. Например
Ellipse hdc, 10, 10, 100, 50
Функция SetPixel (x, y, crColor) рисует точку. Например
SetPixel hdc, 10, 10, vbRed
Функция GetPixel (hdc, x, y) возвращает цвет точки. Например
Dim Color As Long
Color = GetPixel(hdc, 10, 10)
Функция Polyline (hdc, lpPoint, nCount) рисует ломаную линию, где lpPoint - начальный элемент массива, содержащего координаты вершин этой линии, nCount - число вершин. Например
Dim p(3) As POINTAPI
p(0).x = 10
p(0).y = 10
p(1).x = 100
p(1).y = 10
p(2).x = 150
p(2).y = 100
p(3).x = 150
p(3).y = 200
Polyline hdc, p(0), 4
Функция Polygon (hdc, lpPoint, nCount) рисует многоугольник, где lpPoint - начальный элемент массива, содержащего координаты вершин многоугольника, nCount - число вершин. Последняя точка многоугольника должна совпадать с начальной. Например
Dim p(4) As POINTAPI
p(0).x = 10
p(0).y = 10
p(1).x = 100
p(1).y = 10
p(2).x = 150
p(2).y = 100
p(3).x = 150
p(3).y = 200
p(4).x = 10
p(4).y = 10
Polygon hdc, p(0), 5
Функции Arc (hdc, X1, Y1, X2, Y2, X3, Y3, X4, Y4), Pie (hdc, X1, Y1, X2, Y2, X3, Y3, X4, Y4), Chord (hdc, X1, Y1, X2, Y2, X3, Y3, X4, Y4) рисуют фигуры в виде эллипса, усеченного двумя прямыми следующим образом:
Например
Arc hdc, 10, 10, 100, 100, 20, 20, 90, 20
Pie hdc, 110, 10, 200, 100, 120, 20, 190, 20
Chord hdc, 210, 10, 300, 100, 220, 20, 290, 20
Функция PaintDesktop (hdc) заполняет окно рисунком рабочего стола (без иконок и других элементов, находящихся на нем).
Функция ExtFloodFill (hdc, x, y, crColor, wFillType) выполняет заливку фигуры. x, y - координаты любой точки, находящейся внутри этой фигуры. Если wFillType = FLOODFILLBORDER, то заливка выполняется до границ фигуры, где crColor должен быть равен цвету этой границы и не должен быть равен цвету точки с координатами x,y. Если wFillType = FLOODFILLSURFACE, то цвет crColor должен быть равен цвету точки (x,y). При этом заливается область, которая имеет этот цвет. Данный способ заливки нужен в том случае если цвет границ фигуры разный. Например
ScaleMode = vbPixels
' Устанавливаем прозрачную заливку
FillStyle = 1
' Рисуем красную окружность
Circle (50, 50), 40, vbRed
' Рисуем синию окружность, пересеченную зеленой линией
Circle (150, 50), 40, vbBlue
Line (190, 10)-(110, 90), vbGreen
' Устанавливаем заливку в виде горизонтальных линий
FillStyle = 2
' Закрашиваем красную окружность
ExtFloodFill hdc, 50, 50, vbRed, FLOODFILLBORDER
' Закрашивает часть синей окружности
ExtFloodFill hdc, 140, 40, GetPixel(hdc, 140, 40), FLOODFILLSURFACE
Функция BitBlt (hdc, x, y, nWidth, nHeight, hSrcDC, xSrc, ySrc, dwRop) копирует изображение из контекста hSrcDC в контекст hdc. x,y - координаты левой верхней точки картинки-приемника, nWidth, nHeight - размеры картинки-приемника, xSrc, ySrc - координаты левой верхней точки картинки-источника, DwRop - способ копирования. Используются константы как в стандартном методе PaintPicture (vbSrcCopy, vbSrcPaint и т.д.). Отличие этого метода от PaintPicture в том, что PaintPicture копирует лишь картинку, помещенную в PictureBox, а BitBlt копирует картинку вместе изобржением всех контролов, помещенных в PictureBox. Например скопируем на форму изображение рабочего стола
Dim deskhwnd As Long
Dim deskdc As Long
' Получаем описатель рабочего стола
deskhwnd = GetDesktopWindow
' Получаем контекст устройства рабочего стола
deskdc = GetWindowDC(deskhwnd)
' Переносим изображение рабочего стола на форму
BitBlt hdc, 0, 0, Screen.Width / 15, Screen.Height / 15, deskdc, 0, 0, vbSrcCopy
' Освобождаем ресурсы
ReleaseDC deskhwnd, deskdc
Функция StretchBlt (hdc, x, y, nWidth, nHeight, hSrcDC, xSrc, ySrc, nSrcWidth, nSrcHeight, dwRop) масштабирует или отражает изображение. x,y - координаты левой верхней точки картинки-приемника, nWidth, nHeight - размеры картинки-приемника, xSrc, ySrc - координаты левой верхней точки картинки-источника, nSrcWidth, nSrcHeight - размеры картинки-источника, DwRop - способ копирования. Эта функция аналогична методу PaintPicture за исключением того, что копирует картинку с изображением всех контролов, находящихся поверх нее. Если nWidth и nSrcWidth или nHeight и nSrcHeight отличаются, то картинка масштабируется. Если nWidth<0 или nHeight<0, то картинка отображается. Например
' Копируем картинку, увеличив ее в 2 раза
StretchBlt hdc, 0, 0, 48, 44, Picture2.hdc, 0, 0, 24, 22, vbSrcCopy
' Копируем картинку, отобразив по горизонтали
StretchBlt hdc, 24, 48, -24, 22, Picture2.hdc, 0, 0, 24, 22, vbSrcCopy
