Рисование на форме (MS Access 2003) , Линия и надпись

Доброго времени суток!
Я только начинаю на VBA кодить, поэтому сильно не пинайте =))
Суть вот в чем. Нужно нарисовать на форме в MS Access несколько линий и несколько надписей.
Как я понял вариант как это сделать только один - через API функции библиотеки gdi32.dll.
Использую следующий код:
Модуль1:

Public Declare Function dwLineTo Lib "gdi32" Alias "LineTo" _
    (ByVal hDC As Long, _
    ByVal X As Integer, _
    ByVal Y As Integer) _
    As Long
    
Public Declare Function dwMoveTo Lib "gdi32" Alias "MoveTo" _
    (ByVal hDC As Long, _
    ByVal X As Integer, _
    ByVal Y As Integer) _
    As Long
 
....
....

Модуль2:

Function Draw()
    Dim hWnd As Long, hDC As Long
    
    hWnd = dwGetHandle(Me.hWnd)
    If hWnd = 0 Then Exit Function
    hDC = dwGetDC(hWnd)
    
    Call dwMoveTo(hDC, 5, 10)
    Call dwLineTo(hDC, 150, 200)
    
    Call dwReleaseDC(hWnd, hDC)
        
End Function
 
...
...

Функцию dwLineTo я скопировал с примера, поэтому она работает =))
А вот функцию dwMoveTo я попробовал описать сам, но она не работает почему-то(
Проблема в том, что в Интернете нет (или где-то очень глубоко закопан) справочник по функциям gdi32.dll
Подскажите, пожалуйста в чем ошибка при описании функции dwMoveTo и самое главное Как нарисовать текст на форме.

Заранее спасибо за ответы!

А почему именно на форме?
Положи на неё PictureBox, и в нём пиши-рисуй...

Добавлено 23.11.09, 11:17

Цитата freebits @ 23.11.09, 11:11

в Интернете нет (или где-то очень глубоко закопан) справочник по функциям gdi32.dll

NDSN - Platform SDK - Graphics and Multimedia Service - Windows GDI

А как поместить PictureBox на форму, в панели элементов его нет((

Он ещё может называться "Рисунок*"

Чет не могу разобраться(( поставил на форму Рисунок (Image). Как теперь на нем рисовать? У него нет методов для этого..

Всё разобраля! Сделал все через API функции.
Кому надо выкладываю код:

WinAPIfuncs:

Option Compare Database
Option Explicit
 
Public Const DT_CENTER = &H1 'выравниевание по центру
Public Const DT_LEFT = &H0 'у левого края
Public Const DT_RIGHT = &H2 'у правого края
Public Const DT_VCENTER = &H4 'по центру по вертикали
Public Const DT_WORDBREAK = &H10 'перенос слов (многострочный текст)
Public Const DT_SINGLELINE = &H20 'подчеркнутый
 
'вывод линии
Public Declare Function dwLineTo Lib "gdi32" Alias "LineTo" _
    (ByVal hdc As Long, _
    ByVal x As Long, _
    ByVal y As Long) _
    As Long
 
'перемещение указателя    
Public Declare Function dwMoveTo Lib "gdi32" Alias "MoveToEx" _
    (ByVal hdc As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal lpPoint As Long) _
    As Long
 
'вывод текста в прямоугольнике RECT (в т.ч. многострочный)    
Declare Function dwDrawText Lib "user32" Alias "DrawTextA" _
    (ByVal hdc As Long, _
    ByVal lpStr As String, _ 'строка для вывода
    ByVal nCount As Long, _ 'количество символов в строке
    lpRect As RECT, _ 'область вывода
    ByVal wFormat As Long) As Long
 
'вывод текста в одной строке    
Public Declare Function dwTextOut Lib "gdi32" Alias "TextOutA" _
    (ByVal hdc As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal str As String, _
    ByVal Count As Long) As Boolean
 
 
' получение имени класса
Public Declare Function dwGetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hWnd As Long, _
    ByVal lpClassname As String, _
    ByVal nMaxCount As Long) _
    As Long
 
'получение заголовка окна формы
Public Declare Function dwGetWindow Lib "user32" Alias "GetWindow" _
    (ByVal hWnd As Long, _
    ByVal wCmd As Long) _
    As Long
 
'получение контекста устройства для рисования
Public Declare Function dwGetDC Lib "user32" Alias "GetDC" _
    (ByVal hWnd As Long) _
    As Long
'освобождение контекста устройства
Public Declare Function dwReleaseDC Lib "user32" Alias "ReleaseDC" _
    (ByVal hWnd As Long, _
    ByVal hdc As Long) _
    As Long
 
 
'получение дескриптора окна
Public Function dwGetHandle(frmHwnd As Long) As Long
Dim hWnd As Long, h As Long
Const HW_CHILD = 5
Const HW_NEXT = 2
 
 
    hWnd = dwGetWindow(frmHwnd, HW_CHILD)
 
 
    Do While hWnd
        Select Case dwGetClassWin(hWnd)
        Case "OFormSub", "OTabControl"
            h = dwGetHandle(hWnd)
            If dwGetClassWin(h) = "OFEDT" Then
                dwGetHandle = hWnd
                Exit Function
            End If
        Case "OFEDT"
            dwGetHandle = hWnd
            Exit Function
        End Select
        hWnd = dwGetWindow(hWnd, HW_NEXT)
    Loop
End Function
 
'определение класса окна
Public Function dwGetClassWin(hWnd As Long) As String
Dim s As String, cnt As Long
 
    s = String$(255, " ") 'Çàïîëíÿåì ñòðîêó
    cnt = dwGetClassName(hWnd, s, 255) 'Çàïèñûâàåì êëàññ â s
    If cnt > 0 Then
        dwGetClassWin = Left$(s, cnt) 'Ïîëó÷àåì êëàññ
    End If
End Function

Модуль формы:

Private Sub Form_Open(cancel As Integer)
 
    Draw
 
End Sub
 
Function Draw()
    Dim hWnd As Long, hdc As Long
    Dim str As String
    Dim r As Boolean    
    Dim txtRect As RECT 'область вывода
 
    txtRect.Bottom = 600 'нижняя координата
    txtRect.Left = 200 'левая
    txtRect.Right = 400 'правая
    txtRect.Top = 400 'верхняя
        
    hWnd = dwGetHandle(Me.hWnd) 'получаем дескриптор
    If hWnd = 0 Then Exit Function
         hdc = dwGetDC(hWnd) ' если дескриптор получен, получаем контекст устройства
 
    Call dwMoveTo(hdc, 50, 50, 0) 'перемещаем указатель
    Call dwLineTo(hdc, 50, 200) 'рисуем линию
    
    'текст для вывода
    str = "Ехал Грека через реку, видит Грека в реке рак. Сунул Грека руку в реку, рак за руку Грека цап"
    
    'рисуем текст двумя способами (если r = True текст нарисовался)
    r = dwDrawText(hdc, str, Len(str), txtRect, DT_WORDBREAK)
    r = dwTextOut(hdc, 200, 200, str, Len(str))
    
    'освобождаем контекст устройства
    Call dwReleaseDC(hWnd, hdc)
    
    
End Function

Если надо чтобы функция Draw вызывалась каждый раз при перерисовке то можно получать дескриптор элемента который поддерживает такое событие

Сообщения были разделены в тему "линии на форму для VBA Excel"

Пример простенькой программки, которая рисует линию на форме. Данный код необходимо вставить в тело формы (создать форму и нажать F7)

Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function dwMoveTo Lib "gdi32" Alias "MoveToEx" _
    (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
    ByVal lpPoint As Long) As Long
Private Declare Function dwLineTo Lib "gdi32" Alias "LineTo" _
    (ByVal hdc As Long, ByVal x As Integer, ByVal y As Integer) As Long
Private Declare Function dwGetDC Lib "user32" Alias "GetDC" _
    (ByVal hWnd As Long) As Long
Private Declare Function dwEllipse 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
Private Function Draw()
    Dim hForm As Long, hdc As Long
    hForm = FindWindow("ThunderDFrame", Me.Caption)
    hdc = dwGetDC(hForm)
    Call dwMoveTo(hdc, 10, 40, 0)
    Call dwLineTo(hdc, 150, 100)
    Call dwEllipse(HDC, 50, 50, 150, 150)
End Function
Private Sub UserForm_Click()
    Draw
End Sub

Программка рисует на форме VBA Excel линию с координатами точек (10, 40) и (150, 100) после щелчка мыши по панели формы, а также окружность.

Сообщение отредактировано: vaulin - 24.03.10, 11:04