Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Можно ли рисовать линии на формах UserForm в VBA?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Имеется древняя проблема с отрисовкой линий окружностей и эллипсов на формах UserForm в VBA. На формах Visual Basic с отрисовкой этих примитивов нет никаких проблем, а на формах VBA они не рисуются. Что можно использовать чтобы начертить простые пояснительно-контрольные схемы расчётов на формах VBA?
Public Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'---------------------------------
Private Sub Form_Paint()
Dim oldPoint As POINTAPI
MoveToEx Form1.hdc, 0, 50, oldPoint
LineTo Form1.hdc, 200, 50
End Sub
Это то, что тебе надо?
А вот ещё один вариант!
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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 Sub UserForm_Click()
Dim hwnd As Long, hdc As Long
hwnd = FindWindow(vbNullString, UserForm1.Caption)
hdc = GetDC(hwnd)
Ellipse hdc, 50, 50, 150, 100
ReleaseDC hwnd, hdc
End Sub
Спасибо за програмки! Обязательно попробую их применить.
А не подскажите ли Вы где можно взять билиотеку DLL с функциями для вычислений произведения, обращения, транспонирования матриц и решения систем линеёных уравнений, которую можно подключить к VBA и использовать её функции в программах? Например для MathCAD2001 есть пакет Numeric Recipes в котором есть замечательная функция gaussjSolve(A,b), а в самом MathCAD2001 есть функция lsolve(M,v) но как ими воспользоваться в программе VBA не знаю.
Пробовал сам писать функции для решения СЛАУ методом Гаусса (и даже написал функцию для решения СЛАУ с диагональной матрицей) но они или работают медленно или в точности и надёжности их решений у меня нет уверенности.
Помогите найти надёжный, быстрый и проверенный пакет или библиотеку для решения СЛАУ пожалуйста!
Вообще-то сам я программирую на С++ и не смогу тебе помочь с алгоритмами в VB :(((
А вот тебе наиболее полный код для рисования в VBA:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'код для модуля:
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public 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) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Type LOGBRUSH
lbStyle As Long
lbColor As Long
lbHatch As Long
End Type
Public Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'код для формы:
Private Sub UserForm_Click()
Dim hwnd As Long, hdc As Long, oldBkMode As Long
Dim lbBrush As LOGBRUSH
Dim hBrush As Long, hOldBrush As Long
Dim hPen As Long, hOldPen As Long
Dim crOldTextColor As Long
hwnd = FindWindow(vbNullString, UserForm1.Caption)
hdc = GetDC(hwnd)
oldBkMode = SetBkMode(hdc, 1) 'TRANSPARENT = 1, OPAQUE = 2
lbBrush.lbStyle = 0 'BS_SOLID = 0
lbBrush.lbColor = RGB(255, 0, 0)
lbBrush.lbHatch = 3 'HS_BDIAGONAL = 3
hBrush = CreateBrushIndirect(lbBrush)
hOldBrush = SelectObject(hdc, hBrush)
hPen = CreatePen(0, 1, RGB(0, 0, 255)) 'PS_SOLID = 0, PS_DASH = 1
hOldPen = SelectObject(hdc, hPen)
crOldTextColor = SetTextColor(hdc, RGB(0, 150, 0))
''''''''''''''''''''''''
'Здесь рисуй с hdc (draw here with hdc):
Ellipse hdc, 50, 50, 150, 100
Ellipse hdc, 60, 90, 160, 140
TextOut hdc, 50, 25, "Hello!", 6
''''''''''''''''''''''''
SetBkMode hdc, oldBkMode
SelectObject hdc, hOldBrush
DeleteObject hBrush
SelectObject hdc, hOldPen
DeleteObject hPen
SetTextColor hdc, crOldTextColor
ReleaseDC hwnd, hdc
End Sub
Дело в том что в VBA нет события соответствующего WM_PAINT, поэтому функциями GUI рисовать практически бесполезно, все пропадет после перекрытия окна, когда оно снова станет видимым, все что нарисовано функциями GUI не восстановится.
Александр, но не тот
"Не тот" Александр не совсем прав!
В VBA действительно нет обработчика сообщения WM_PAINT :( , но его можно сделать самому :) :) :) ... -
установить hook! Смотрите как это сделать
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'код для модуля:
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public hwnd As Long, hHook As Long
Public Function CBTProc(ByVal ncode As Long, ByVal wParam As Long, lParam As Variant) As Long
UserForm_Paint hwnd
CBTProc = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function
Public Sub UserForm_Paint(hw As Long)
Dim hdc As Long
hdc = GetDC(hw)
Ellipse hdc, 50, 50, 150, 100
ReleaseDC hw, hdc
End Sub
Public Sub RunMyProgram()
UserForm1.Show
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'код для формы:
Private Sub UserForm_Initialize()
hwnd = FindWindow(vbNullString, UserForm1.Caption)
hHook = SetWindowsHookEx(5, AddressOf CBTProc, 0, GetWindowThreadProcessId(hwnd, vbNull)) 'WH_CBT = 5
End Sub
Private Sub UserForm_Terminate()
UnhookWindowsHookEx hHook
End Sub
А их обязательно рисовать програмно? Может достаточно управлять видимостью картинок, которые ты нарисуешь в каком-нить граф. редакторе и навставляешь в форму?
многое я видал... но чтобы в вижуал бейсике хук создавали.....
Пути господни неисповедимы :)
MoveToEx Form1.hdc, 0, 50, oldPoint
Сделал программу для черчения на форме UserForm в VBA Excel. Объясните пожалуйста, почему не работает метод MoveToEx и все линии чертятся из начальной точки 0,0?
И ещё: как вызвать перерисовку формы, чтобы показать черчение линии на форме в "динамике"? То есть пока мы не отпустим кнопку мыши линия на форме должна не фиксироваться, а перемещаться за курсором мышки. Когда мы кнопку отпустим тогда линия должна начертиться и не менять свое положение.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Можно ли рисовать линии на формах UserForm в VBA?
Форум работает на PunBB, при поддержке Informer Technologies, Inc
