О вырезанных формах писалось уже неоднократно. Во многих публикациях предлагались различные варианты их создания. Однако, тема по-прежнему остается актуальной и по электронной почте продолжают приходить письма с просьбой осветить все возможные аспекты работы. Учитывая повторяемость вопросов, я создал пример, реализующий некоторые подходы для решения этой проблемы. Хочу оговориться сразу, что представленные коды - "не есть мое изобретение", я только попытался их упорядочить. И в конце этого короткого вступления хочется поблагодарить Ивана Шатрыкина, за оказанную помощь.
Ну что ж, пожалуй, начнем. Нам понадобится две формы и модуль. На первой форме разместим восемь радиокнопок (по числу вариантов) и обычную кнопку, для вывода демонстрационной формы.
На второй форме не будем размещать ничего, а
только установим параметры, чтобы не
засорять пример дополнительными строками
кода.
Name = frmDemonstration, AutoRedraw = True, BackColor = &H00000000& (черный
цвет, для лучшей визуализации), BorderStyle = 0 (None),
ScaleMode = 3 (Pixel - все API-функции работают только
с пикселами).
Модуль будем использовать для объявления
API-функций и глобальных функций.
Сразу же предусмотрим
перемещение и закрытие демонстрационной
формы.
Для перемещения объявим в модуле API-функции
и пару констант к ним.
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" _
() As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
А в форме напишем пару процедур, отвечающих за эти действия.
Private Sub Form_DblClick()
Unload Me
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift
As Integer, _
X As Single, Y
As Single)
Select Case Button
Case vbLeftButton
Call ReleaseCapture
Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Select
End Sub
Собственно говоря, это все коды
для демонстрационной формы. Все остальные
мы будем оформлять в основной форме (с
радиокнопками).
Маленькая функция, определяющая какая
радиокнопка была выбрана, будет потом
использоваться в процедуре нажатия кнопки
для вывода демонстрационной формы.
Private Function FindOptionButton()
As Integer
Dim i%
For i = 0 To optSelect.Count - 1
If optSelect(i).Value =
True Then Exit For
Next
FindOptionButton = i
End Function
Прежде чем перейти к дальнейшему описанию кодов давайте уясним, как работает сам принцип "вырезания" формы. Вначале мы должны создать регион - массив точек, по которым и будет производиться "вырезание". Именно здесь и используются различные API-функции, определяющие итоговую фигуру. На них мы остановимся подробнее чуть ниже. После того как регион получен, с помощью API-функции SetWindowRgn (кстати, не забудьте внести ее в модуль) и производим непосредственное "вырезание" формы. В конце удаляем созданный нами регион, освобождая память.
Private Sub cmdPreview_Click()
Dim hRgn As Long
With frmDemonstration
hRgn = ...
SetWindowRgn .hwnd, hRgn, True
DeleteObject hRgn
.Show vbModal
End With
End Sub
Итак, настала пора заняться
регионами. Указанные API-функции необходимо
объявлять в модуле. Воспользуйтесь для их
правильного написания Программой API Text Viewer (меню:
Пуск\Программы\Microsoft Visual Studio 6.0\Microsoft
Visual Studio 6.0 Tools\API Text Viewer).
Для начала "вырежем" обычный
прямоугольник. Для этого используется
функция
Public Declare Function CreateRectRgn
Lib "gdi32" _
(ByVal X1 As
Long, _
ByVal Y1 As
Long, _
ByVal X2 As
Long, _
ByVal Y2 As
Long) _
As Long
где X1 и Y1 координаты верхнего левого угла
квадрата, а X2 и Y2 - нижнего правого. Внесем
изменения в процедуру cmdPreview_Click, вырезав
прямоугольник с размерами сторон в 2 раза
меньше формы:
Private Sub cmdPreview_Click()
Dim hRgn As Long
With frmDemonstration
Select Case FindOptionButton
Case 0
hRgn = CreateRectRgn(.ScaleWidth * 0.25, .ScaleHeight * 0.25,
_
.ScaleWidth * 0.75, .ScaleHeight * 0.75)
End Select
SetWindowRgn .hwnd, hRgn, True
DeleteObject hRgn
.Show vbModal
End With
End Sub
Запустим на проверку и получим "вырезанный" черный прямоугольник, который можно перемещать по экрану и закрыть двойным щелчком.
Так же легко как прямоугольник, мы
можем получить и овальную форму. Для этого
используется другая API-функция, но
параметры те же, что и в предыдущей. В итоге
получим овал, с размерами по основным осям,
равным высоте и ширине формы:
Public Declare Function CreateEllipticRgn
Lib "gdi32" _
(ByVal X1 As
Long, _
ByVal Y1 As
Long, _
ByVal X2 As
Long, _
ByVal Y2 As
Long) _
As Long
и в форме:
...
Select Case FindOptionButton
...
Case 3
hRgn = CreateEllipticRgn(0, 0,
.ScaleWidth, .ScaleHeight)
End Select
...
Аналогичным образом можно
получить прямоугольник с закругленными
краями. Естественно, для этого используется
своя API-функция:
Public Declare Function CreateRoundRectRgn
Lib "gdi32" _
(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
Как Вы обратили, наверное, внимание, данная функция имеет два дополнительных параметра: X3 и Y3, которые отвечают за начало и конец закругления по горизонтальной и вертикальной осям левого верхнего угла. Остальные углы автоматически делаются симметричными этому.
...
Select Case FindOptionButton
...
Case 2
hRgn = CreateRoundRectRgn(0, 0,
.ScaleWidth, .ScaleHeight, _
.ScaleWidth / 3 * 2,
.ScaleHeight / 5 * 3)
End Select
...
Прямоугольник и овал можно
получить так же и с помощью двух других API-функций.
В ряде ситуаций ими бывает пользоваться
удобней.
Public Declare Function CreateRectRgnIndirect
Lib "gdi32" _
(lpRect As RECT) _
As Long
Public Declare Function CreateEllipticRgnIndirect Lib "gdi32" _
(lpRect As RECT) _
As Long
Здесь, в качестве параметра,
используется структура RECT, которую
необходимо объявить в разделе деклараций
модуля. Кроме того, добавим еще одну API-функцию
для более легкого получения переменной с
этой структурой:
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function SetRect Lib "user32" _
(lpRect As RECT, _
ByVal X1 As
Long, _
ByVal Y1 As
Long, _
ByVal X2 As
Long, _
ByVal Y2 As
Long) _
As Long
X1, Y1 - передаваемые координаты
левого верхнего угла; X2, Y2 - передаваемые
координаты правого нижнего угла; а lpRect -
принимаемое значение этих координат в
формате типа RECT.
Соответственно, в процедуре вывода
демонстрационной формы внесем дополнения:
Private Sub cmdPreview_Click()
Dim hRgn As Long
Dim R As RECT
With frmDemonstration
Select Case FindOptionButton
...
Case 1
SetRect R, .ScaleWidth * 0.25, .ScaleHeight * 0.25,
_
.ScaleWidth * 0.75, .ScaleHeight * 0.75
hRgn = CreateRectRgnIndirect(R)
...
Case 4
SetRect R, 0, 0, .ScaleWidth, .ScaleHeight
hRgn = CreateEllipticRgnIndirect(R)
...
End Select
SetWindowRgn .hwnd, hRgn, True
DeleteObject hRgn
.Show vbModal
End With
End Sub
В результате получим те же фигуры, но другим способом
На закуску, в Части 1, напишем коды
работы с вырезанием формы неправильной (или,
если больше нравится, многоугольной)
конфигурации. Здесь так же используется
своя API-функция
Public Declare Function CreatePolygonRgn
Lib "gdi32.dll" _
(lpPoint As POINTAPI, _
ByVal nCount As Long, _
ByVal nPolyFillMode As Long) _
As Long
Естественно, прежде чем объявить
эту функцию необходимо объявить тип POINTAPI,
отвечающий за координаты каждой точки
Type POINTAPI
X As Long
Y As Long
End Type
nCount - определяет, сколько точек мы
используем для вырезания данной фигуры,
последний параметр - nPolyFillMode - определяет
способ заполнения региона для каждого
пиксела (в нашем случае этот параметр равен
0)- Для того чтобы создать регион
неправильной формы вначале, в разделе
деклараций формы, объявим массив с типом
POINTAPI, и напишем маленькую процедуру
заполнения этого массива значениями,
учитывающими размеры формы, для получения
шестиугольника:
Private Sub CreateRgnContur()
With frmDemonstration
rgnPts(1).X = .ScaleWidth * 0.3
rgnPts(1).Y = .ScaleHeight * 0
rgnPts(2).X = .ScaleWidth * 0.7
rgnPts(2).Y = .ScaleHeight * 0
rgnPts(3).X = .ScaleWidth * 1
rgnPts(3).Y = .ScaleHeight * 0.5
rgnPts(4).X = .ScaleWidth * 0.7
rgnPts(4).Y = .ScaleHeight * 1
rgnPts(5).X = .ScaleWidth * 0.3
rgnPts(5).Y = .ScaleHeight * 1
rgnPts(6).X = .ScaleWidth * 0
rgnPts(6).Y = .ScaleHeight * 0.5
End With
End Sub
И наконец, в основной процедуре:
Private Sub cmdPreview_Click()
Dim hRgn As Long
Dim R As RECT
With frmDemonstration
Select Case FindOptionButton
...
Case 5
Dim numAngle
As Integer
numAngle = 6
ReDim rgnPts(1
To numAngle) As POINTAPI
CreateRgnContur
hRgn = CreatePolygonRgn(rgnPts(1), numAngle, 0)
...
End Select
SetWindowRgn .hwnd, hRgn, True
DeleteObject hRgn
.Show vbModal
End With
End Sub
И еще пару слов об этом методе вырезания формы. Вроде бы те методы, которые будут описаны в Части 2 (работа с bmp-файлами), более эффектно выглядят на экране, но не торопитесь сбрасывать со счетов последний вариант. Во-первых, он работает значительно быстрее (точек-то меньше); и, во-вторых, данный метод позволяет масштабировать форму, что с картинками сделать значительно труднее без потери их качества. А кроме всего прочего, никто не мешает Вам с помощью графических методов раскрасить "вырезанную" форму. Из недостатков данного метода, конечно же, надо отметить сложность рассчетов координат каждой точки. Однако безвыходных ситуаций не бывает. В свое время я написал Add-In, упрощающий подсчет координат до простого кликанья по точкам на картинке. Если кому-то данный Add-In срочно необходим :) - можете скачать с моей странички (MapGraf).
