|
Дата публикации статьи: 10.06.2006 10:56 ГЛАВА 2. Пример элемента ActiveX инкапсулирующего компонент технологического процесса.
Элемент ActiveX является сервером COM, размещенным внутри клиентского процесса и обладает интерфейсом для отображения графики, а это значит, что элемент может обращаться к графической подсистеме Windows. Клиентами элементов ActiveX могут быть такие контейнеры OLE, как сам Visual Basic, Internet Explorer и большое семейство SCADA программ ( InTouch, Trace Mode и.т.п. ).
Option Explicit
Public Event Ustavka1()
Public Event Ustavka2()
Public Event Ustavka3()
Public Event Ustavka4()
''''''API''''''''''''''''
Private Declare Function CreateSolidBrush& Lib "gdi32" (ByVal crColor _
As Long)
Private Declare Function InvalidateRect& Lib "user32" (ByVal hwnd _
As Long, lpRect As RECT, ByVal bErase 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)
Private Declare Function MoveToEx& Lib "gdi32" (ByVal hDC As Long, _
ByVal x As Long, ByVal y As Long, Prev As POINTAPI)
Private Declare Function LineTo& Lib "gdi32" (ByVal hDC As Long, ByVal x _
As Long, ByVal y As Long)
Private Declare Function CreatePen& Lib "gdi32" (ByVal nPenStyle As Long, _
ByVal nWidth As Long, ByVal crColor As Long)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hDC As Long, _
ByVal hObject As Long)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
Private Declare Function SaveDC& Lib "gdi32" (ByVal hDC As Long)
Private Declare Function RestoreDC& Lib "gdi32" (ByVal hDC As Long, ByVal_
nSavedDC As Long)
Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, _
ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long)
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
left As Long
top As Long
right As Long
botton As Long
End Type
Private pererisovka As RECT
Private TsenaSkali As Long
Private Lebatska As String
Dim HDConst As Long
Private Zaitsik As Long
Private Sub UserControl_Initialize()
TsenaSkali = 5 '50=400'40=5And50'20=10And100
Lebatska = "Тгр"
HDConst = UserControl.hDC
Zaitsik = 3
pererisovka.botton = 25
pererisovka.left = 0
pererisovka.right = 211
pererisovka.top = 18
End Sub
Private Sub UserControl_Paint()
Dim i As Long 'для цикла
Dim vozvr As Long
Dim oldP As Long
Dim oldB As Long
Dim novP As Long
Dim novB As Long
Dim savedDC As Long 'dc
Dim myPoint As POINTAPI
savedDC = SaveDC&(HDConst)
novB = CreateSolidBrush(QBColor(11))
oldB = SelectObject&(HDConst, novB) '''VB Odjekt
Rectangle& HDConst, Zaitsik, 18, Zaitsik + 4, 25
Rectangle& HDConst, Zaitsik + 4, 18, Zaitsik + 8, 25
vozvr = MoveToEx&(HDConst, 5, 30, myPoint)
vozvr = LineTo&(HDConst, 5, 43)
vozvr = LineTo&(HDConst, 205, 43)
vozvr = LineTo&(HDConst, 205, 30)
''''''''''''''Цена шкалы''''''''''''''
''''''''''''''''5градусов'''''''''''''
If TsenaSkali = 5 Then
vozvr = TextOut(HDConst, 80, 2, Lebatska & " 0-" & CStr(TsenaSkali), 7)
For i = 46 To 180 Step 40 'Цена шкалы
vozvr = MoveToEx&(HDConst, i, 38, myPoint)
vozvr = LineTo&(HDConst, i, 43)
Next i
'''''''''''''Цифры на шкале'''''''''''
For i = 1 To 4 Step 1
vozvr = TextOut(HDConst, i * 40, 27, CStr(i), 1)
Next i
End If
''''''''''''''''50градусов'''''''''''
If TsenaSkali = 50 Then
vozvr = TextOut(HDConst, 80, 2, Lebatska & " 0-" & CStr(TsenaSkali), 8)
For i = 46 To 180 Step 40 'Цена шкалы
vozvr = MoveToEx&(HDConst, i, 38, myPoint)
vozvr = LineTo&(HDConst, i, 43)
Next i
For i = 6 To 204 Step 4 'Цена шкалы
vozvr = MoveToEx&(HDConst, i, 40, myPoint)
vozvr = LineTo&(HDConst, i, 43)
Next i
'''''''''''''Цифры на шкале'''''''''''
For i = 10 To 40 Step 10
vozvr = TextOut(HDConst, i * 4, 27, CStr(i), 2)
Next i
End If
''''''''''''''''10градусов'''''''''''
If TsenaSkali = 10 Then
vozvr = TextOut(HDConst, 80, 2, Lebatska & " 0-" & CStr(TsenaSkali), 8)
For i = 26 To 200 Step 20 'Цена шкалы
vozvr = MoveToEx&(HDConst, i, 38, myPoint)
vozvr = LineTo&(HDConst, i, 43)
Next i
'''''''''''''Цифры на шкале'''''''''''
For i = 5 To 45 Step 5
vozvr = TextOut(HDConst, i * 4, 27, CStr(i / 5), 1)
Next i
End If
''''''''''''''''100градусов'''''''''''
If TsenaSkali = 100 Then
vozvr = TextOut(HDConst, 80, 2, Lebatska & " 0-" & CStr(TsenaSkali), 9)
For i = 26 To 200 Step 20 'Цена шкалы
vozvr = MoveToEx&(HDConst, i, 38, myPoint)
vozvr = LineTo&(HDConst, i, 43)
Next i
For i = 4 To 200 Step 2 'Цена шкалы
vozvr = MoveToEx&(HDConst, i + 2, 40, myPoint)
vozvr = LineTo&(HDConst, i + 2, 43)
Next i
'''''''''''''Цифры на шкале'''''''''''
For i = 5 To 45 Step 5
vozvr = TextOut(HDConst, i * 4, 27, CStr(i * 2), 2)
Next i
End If
''''''''''''''''400градусов''''''''''
If TsenaSkali = 400 Then
vozvr = TextOut(HDConst, 80, 2, Lebatska & " 0-" & CStr(TsenaSkali), 9)
For i = 30 To 180 Step 25 'Цена шкалы
vozvr = MoveToEx&(HDConst, i, 37, myPoint)
vozvr = LineTo&(HDConst, i, 43)
Next i
For i = 2 To 200 Step 2 'Цена шкалы
vozvr = MoveToEx&(HDConst, i + 2, 40, myPoint)
vozvr = LineTo&(HDConst, i + 2, 43)
Next i
'''''''''''''Цифры на шкале'''''''''''''
For i = 10 To 30 Step 10
vozvr = TextOut(HDConst, i * 5, 27, CStr(i * 10), 3)
Next i
For i = 15 To 40 Step 10
vozvr = TextOut(HDConst, i * 5, 27, CStr(i * 10), 3)
Next i
vozvr = TextOut(HDConst, 27, 27, "50", 2)
End If
vozvr = SelectObject&(HDConst, oldB)
vozvr = DeleteObject&(novB)
vozvr = RestoreDC&(HDConst, savedDC)
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
TsenaSkali = .ReadProperty("Interval", 5)
Lebatska = .ReadProperty("TPHG", "Tгр")
End With
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
.WriteProperty "Interval", TsenaSkali
.WriteProperty "TPHG", Lebatska
End With
End Sub
Public Property Get Interval() As Long
Interval = TsenaSkali
End Property
Public Property Let Interval(vNewValue As Long)
If vNewValue <> 5 And vNewValue <> 10 And vNewValue <> 50 _
And vNewValue <> 100 And vNewValue <> 400 Then Exit Property
TsenaSkali = vNewValue
UserControl.Refresh
PropertyChanged "Interval"
End Property
Public Property Get PTHG() As String
PTHG = Lebatska
End Property
Public Property Let PTHG(ByVal vNewValue As String)
If vNewValue <> "Тгр" And vNewValue <> "Ркг" And vNewValue <> "Н% " And vNewValue <> "Gмч" Then Exit Property
Lebatska = vNewValue
UserControl.Refresh
End Property
Private Sub UserControl_Resize()
With UserControl
.Width = 3190
.Height = 750
End With
End Sub
Public Sub Indikator(vNewValue As Long, sob As Long)
If sob = 1 Then RaiseEvent Ustavka1
If sob = 2 Then RaiseEvent Ustavka2
If sob = 3 Then RaiseEvent Ustavka3
If sob = 4 Then RaiseEvent Ustavka4
'''''''''''''''100'''''''''''''''''''
If TsenaSkali = 100 Then
If Zaitsik > 200 Then vNewValue = 98
If Zaitsik < 3 Then vNewValue = 0
Zaitsik = vNewValue * 2 + 3
End If
''''''''''''''''50''''''''''''''''''
If TsenaSkali = 50 Then
If Zaitsik > 200 Then vNewValue = 49
If Zaitsik < 3 Then vNewValue = 0
Zaitsik = vNewValue * 4 + 3
End If
''''''''''''''''10''''''''''''''''''
If TsenaSkali = 10 Then
If Zaitsik > 200 Then vNewValue = 98
If Zaitsik < 3 Then vNewValue = 0
Zaitsik = vNewValue * 2 + 3
End If
'''''''''''''''''5'''''''''''''''''''
If TsenaSkali = 5 Then
If Zaitsik > 200 Then vNewValue = 49
If Zaitsik < 3 Then vNewValue = 0
Zaitsik = vNewValue * 4 + 3
End If
'''''''''''''''''400'''''''''''''''''
If TsenaSkali = 400 Then
If Zaitsik > 200 Then vNewValue = 398
If Zaitsik < 3 Then vNewValue = 0
Zaitsik = vNewValue \ 2 + 3
End If
'''''''''''''''''''''''''''''''''''''
InvalidateRect UserControl.hwnd, pererisovka, 0
End Sub
Вся работа по выводу графики ложится на графические функции API. Процедуру Private Sub UserControl_Initialize() можно считаться аналогом Form_Load. В событии Private Sub UserControl_Paint() элемента управления, рисуется оставшаяся часть шкалы прибора (не вошедшая в файл Pribor.wmf). Размерность шкалы и назначение измерительного прибора выбирается в странице свойств. Страница свойств состоит из двух элементов ComboBox (Рис. 1). При желании вы можете реализовать четыре события Ustavka при достижении значений прибора контрольных значений в процедуре Indikator.
Введите следующий код для элементов страницы свойств: Private Sub Combo1_Change() Changed = True End Sub Private Sub Combo2_Change() Changed = True End Sub Private Sub PropertyPage_ApplyChanges() SelectedControls(0).Interval = CLng(Combo1.Text) SelectedControls(0).PTHG = Combo2.Text End Sub Private Sub PropertyPage_Initialize() Combo1.AddItem "5", 0 Combo1.AddItem "10", 1 Combo1.AddItem "50", 2 Combo1.AddItem "100", 3 Combo1.AddItem "400", 4 Combo2.AddItem "Тгр", 0 Combo2.AddItem "Ркг", 1 Combo2.AddItem "Н% ", 2 Combo2.AddItem "Gмч", 3 End Sub Private Sub PropertyPage_SelectionChanged() Combo1.Text = SelectedControls(0).Interval Combo2.Text = SelectedControls(0).PTHG End Sub В дальнейшем свойства Interval и PTHG будут отображаться в окне Properties для элемента управления. Выполните команду Make Pribor.ocx. Для тестирования созданного элемента ActiveX создайте проект типа Standard EXE(см. проект папка N3/). Войдите в меню Project – Components и выберите из вкладки Controls элемент Pribor (Рис. 2).
ПримечаниеВ связи тем, что элементы ActiveX необходимо регистрировать в системном реестре при установке на другой компьютер для данного проекта создан инсталляционный пакет (см. проект папка N2/Release2). Если все сделано правильно на панели General появится новый значок и вы сможете размещать на форме приборы, изменяя при этом шкалу через страницу свойств (вызывается через свойство Custom или щелчком правой клавиши мыши на элементе). Свойства Interval и PTHG отобразятся в окне Properties (Рис. 3).
Нарисуйте на форме две кнопки и введите в обработчики их событий следующий код: Option Explicit Dim i As Long Private Sub Command1_Click() i = i + 1 UserControl11.Indikator i, 0 End Sub Private Sub Command2_Click() i = i - 1 UserControl11.Indikator i, 0 End Sub Private Sub Form_Load() i = 0 End Sub Нажимая кнопки вы сможете перемещать указатель показаний прибора. Первый параметр в функции UserControl11.Indikator это значение прибора, а второй параметр номер события (в данном случае не используется).
Option Explicit
Private Declare Function Polygon& Lib "gdi32" (ByVal hDC As Long, lpPoint As _
POINTAPI, ByVal nCount As Long)
Private Declare Function CreateSolidBrush& Lib "gdi32" (ByVal crColor As Long)
Private Declare Function InvalidateRect& Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT, ByVal bErase 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)
Private Declare Function MoveToEx& Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long, Prev As POINTAPI)
Private Declare Function LineTo& Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long)
Private Declare Function CreatePen& Lib "gdi32" (ByVal nPenStyle As Long, _
ByVal nWidth As Long, ByVal crColor As Long)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hDC As Long, _
ByVal hObject As Long)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
Private Declare Function SaveDC& Lib "gdi32" (ByVal hDC As Long)
Private Declare Function RestoreDC& Lib "gdi32" (ByVal hDC As Long, _
ByVal nSavedDC As Long)
Private Declare Function SetMapMode& Lib "gdi32" (ByVal hDC As Long, _
ByVal nMapMode As Long)
Private Declare Function SetWindowExtEx& Lib "gdi32" (ByVal hDC As Long, _
ByVal nX As Long, ByVal nY As Long, lpSize As SIZE)
Private Declare Function SetWindowOrgEx& Lib "gdi32" (ByVal hDC As Long, _
ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
Private Declare Function SetViewportExtEx& Lib "gdi32" (ByVal hDC As Long, _
ByVal nX As Long, ByVal nY As Long, lpSize As SIZE)
Private Declare Function SetViewportOrgEx& Lib "gdi32" (ByVal hDC As Long, _
ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
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)
Dim HDConst As Long
Private Type SIZE
cx As Long
cy As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
left As Long
top As Long
right As Long
botton As Long
End Type
Private MassivTotsek() As POINTAPI
Dim mySize As SIZE
Dim mPointapi As POINTAPI
Dim Ptrect1 As RECT
Dim Ptrect2 As RECT
Dim Ptrect3 As RECT
Dim Ptrect4 As RECT
Private ugpov As Long
Private Sub Command1_Click()
Dim vozvr As Long
ugpov = ugpov + 10
vozvr = SetWindowOrgEx(HDConst, 0, 0, mPointapi)
Form1.Refresh
End Sub
Private Sub Form_Load()
HDConst = Form1.hDC
ugpov = 0
Ptrect1.top = 0 'y
Ptrect1.left = 70 'x
Ptrect1.botton = 14 'y
Ptrect1.right = 78 'x
Ptrect2.top = 70
Ptrect2.left = 0
Ptrect2.botton = 78
Ptrect2.right = 14
Ptrect3.top = 134
Ptrect3.left = 70
Ptrect3.botton = 148
Ptrect3.right = 78
Ptrect4.top = 70
Ptrect4.left = 134
Ptrect4.botton = 78
Ptrect4.right = 148
End Sub
Private Sub Form_Paint()
Dim vozvr As Long
Dim oldP As Long
Dim oldB As Long
Dim novP As Long
Dim novB As Long
Dim savedDC As Long 'dc
''''''''''''''''''''''''''''
vozvr = SetMapMode(HDConst, 8) 'ANISOTROPIC
vozvr = SetWindowOrgEx(HDConst, -74, -74, mPointapi)
Ellipse HDConst, -60, -60, 60, 60
''''''''''''''''''''''''''''''''''''
ReDim Preserve MassivTotsek(3)
MassivTotsek(0).X = (Cos(ugpov / 180 * 3.14) * 0) - _
(Sin(ugpov / 180 * 3.14) * -50) 'CLng(0)
MassivTotsek(0).Y = (Sin(ugpov / 180 * 3.14) * 0) + _
(Cos(ugpov / 180 * 3.14) * -50) 'CLng(-30)
'''''
MassivTotsek(1).X = (Cos(ugpov / 180 * 3.14) * 10) - _
(Sin(ugpov / 180 * 3.14) * 20) ' - 74 'CLng(30)
MassivTotsek(1).Y = (Sin(ugpov / 180 * 3.14) * 10) + _
(Cos(ugpov / 180 * 3.14) * 20) '- 74 'CLng(30)
'''''
MassivTotsek(2).X = (Cos(ugpov / 180 * 3.14) * 0) - _
(Sin(ugpov / 180 * 3.14) * 30) ' - 74 'CLng(30)
MassivTotsek(2).Y = (Sin(ugpov / 180 * 3.14) * 0) + _
(Cos(ugpov / 180 * 3.14) * 30) '- 74 'CLng(30)
'''''
MassivTotsek(3).X = (Cos(ugpov / 180 * 3.14) * -10) - _
(Sin(ugpov / 180 * 3.14) * 20) '- 74 'CLng(-30)
MassivTotsek(3).Y = (Sin(ugpov / 180 * 3.14) * -10) + _
(Cos(ugpov / 180 * 3.14) * 20) '- 74 'CLng(30)
savedDC = SaveDC&(HDConst)
novB = CreateSolidBrush(QBColor(11))
oldB = SelectObject&(HDConst, novB) '''VB Odjekt
Polygon HDConst, MassivTotsek(0), 4
vozvr = SelectObject&(HDConst, oldB)
vozvr = DeleteObject&(novB)
Ellipse HDConst, -2, -2, 2, 2
'''''''''''''''''''''''''''''''''''''
vozvr = MoveToEx&(HDConst, 0, -74, mPointapi)
vozvr = LineTo&(HDConst, 0, -60)
vozvr = MoveToEx&(HDConst, -74, 0, mPointapi)
vozvr = LineTo&(HDConst, -60, 0)
vozvr = MoveToEx&(HDConst, 0, 74, mPointapi)
vozvr = LineTo&(HDConst, 0, 60)
vozvr = MoveToEx&(HDConst, 74, 0, mPointapi)
vozvr = LineTo&(HDConst, 60, 0)
End Sub
Цель данного примера изобразить геометрический объект (круговой переключатель, стрелку прибора итп) вращающийся вокруг своей оси. Вращающийся объект рисуется с помощью функции Polygon HDConst, MassivTotsek(0), 4 и состоит из четырех вершин (Рис. 4).
Для вычисления нового положения вершин мы применяем, вышеназванную тригонометрическую формулу, которая в данном случае для одной точки примет вид:
|
