Вставка рисунка в рапорты access. Как создать кнопку в базе Microsoft Access

" Функция возвращает контекст устройства для рисования
Private Declare Function apiGetDC Lib "user32" Alias "GetDC" _
(ByVal hwnd As Long ) _
As Long

" Функция освобождает контекст устройства для других приложений
Private Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" _
(ByVal hwnd As Long , _
ByVal hDc As Long ) _
As Long

" Далеее идут, функции управляющие рисованием

" Функция рисует точку на экране
Private Declare Function apiSetPixel Lib "gdi32" Alias "SetPixel" _
(ByVal hDc As Long , _
ByVal x As Long , _
ByVal Y As Long , _
ByVal crColor As Long ) As Long

" Функция рисует линию из текущей позиции "пера" до точки с координатами
" x,y, но не включая ее саму. Линия рисуется с помощью выбранного "пера". Если
" нет ошибки, то текущее положение пера устанавливается в точку с координатами
" (x,y)
Private Declare Function apiLineTo Lib "gdi32" Alias "LineTo" _
(ByVal hDc As Long , _
ByVal x As Integer , _
ByVal Y As Integer ) _
As Long

" Функция рисует дугу элипса с помощью выбранного "пера".
" Дуга рисуется против часовой стрелки.
" (x1,y1 - x2,y2) ограничивающий прямоугольник для дуги.


Private Declare Function apiArc Lib "gdi32" Alias "Arc" _
(ByVal hDc As Long , _
ByVal X1 As Integer , _
ByVal Y1 As Integer , _
ByVal X2 As Integer , _
ByVal Y2 As Integer , _
ByVal X3 As Integer , _
ByVal Y3 As Integer , _
ByVal X4 As Integer , _
ByVal Y4 As Integer ) _
As Long
" Функция рисует прямоугольник с помощью выбранного "пера".
" (x1,y1) - первый угол

Private Declare Function apiRectangle Lib "gdi32" Alias "Rectangle" _
(ByVal hDc As Long , _
ByVal X1 As Long , _
ByVal Y1 As Long , _
ByVal X2 As Long , _
ByVal Y2 As Long ) As Long

" Функция передвигает позицию рисования
" (x,y) - новая точка
" (lpPoint) - предыдущая точка
Private Declare Function apiMoveTo Lib "gdi32" Alias "MoveToEx" _
(ByVal hDc As Long , _
ByVal x As Long , _
ByVal Y As Long , _
lpPoint As POINTAPI) As Long
" Структура координаты точки
Private Type POINTAPI
x As Long
Y As Long
End Type

" Функция рисует элипс с помощью выбранного "пера".
" (x1,y1) - первый угол
" (x2,y2) - противоположный угол
Private Declare Function apiEllipse Lib "gdi32" Alias "Ellipse" _
(ByVal hDc As Long , _

ByVal X2 As Long , ByVal Y2 As Long ) As Long

" lpPoint - массив точек
" nCount - число точек
Private Declare Function apiPolyline Lib "gdi32" Alias "Polyline" _
(ByVal hDc As Long , _
lpPoint As POINTAPI, _

" Функция рисует ломаную с помощью выбранного "пера"
" lpPoint - массив точек
" nCount - число точек
Private Declare Function apiPolygon Lib "gdi32" Alias "Polygon" _
(ByVal hDc As Long , _
lpPoint As POINTAPI, _
ByVal nCount As Long ) As Long

" (x3,y3) - начальная точка рисования "пером"
" (x4,y4) - конечная точка рисования дуги
Private Declare Function apiChord Lib "gdi32" Alias "Chord" _
(ByVal hDc As Long , _
ByVal X1 As Long , ByVal Y1 As Long , _

" Функция заливает круг с помощью выбранного "пера"
" (x1,y1 - x2,y2) ограничивающий прямоугольник для дуги
" (x3,y3) - начальная точка рисования "пером"
" (x4,y4) - конечная точка рисования дуги
Private Declare Function apiPie Lib "gdi32" Alias "Pie" _
(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 Sub butExecute_Click()
Dim hwnd As Long , hDc As Long "Окно и контекст рисования
Dim X1 As Long , Y1 As Long , X2 As Long , Y2 As Long
Dim xy(3) As POINTAPI "Точки рисования
On Error GoTo 999

"Очистить зону рисования
Me.Refresh
DoEvents

"Поиск окна для рисования. Это решение предложено
"Николаем Малютиным г.Якутск: [email protected]
hwnd = FindWindowEx(Me.hwnd, FindWindowEx(Me.hwnd, 0, "OFormSub" , "" ), "OFormSub" , "" )

"Выбираем контекст устройства
hDc = apiGetDC(hwnd)

"Координаты зоны рисования
X1 = 15
Y1 = 90
X2 = 180
Y2 = 250

"Рисуем объекты
Select Case Me.Объекты
Case 1: "Точка - красная
Call apiSetPixel(hDc, X2 / 2, Y2 / 2, RGB(255, 0, 0))
Case 2: "Линия
Call apiMoveTo(hDc, X1, Y1, xy(0)) "Передвигаем указатель
Call apiLineTo(hDc, X2, Y2) "Рисуем линию
Case 3: "Элипс
Call apiEllipse(hDc, X1, Y1, X2, Y2 / 2)
Case 4: "Прямоугольник - закрашенный
Call apiRectangle(hDc, X1, Y1, X2, Y2)
Case 5: "Дуга
Call apiArc(hDc, X1, Y1, X2, Y2, 50, 100, 150, 150)
Case 6, 7: "Ломаная, Заливка
" Загружаем координаты
xy(0).x = X1
xy(0).Y = Y1
xy(1).x = X1 + 20
xy(1).Y = Y2
xy(2).x = X2
xy(2).Y = Y2 - 20
If Me.Объекты = 6 Then "Ломаная
Call apiPolyline(hDc, xy(0), UBound(xy))
Else "Заливка
Call apiPolygon(hDc, xy(0), UBound(xy))
End If
Case 8: "Заливка круга до хорды
Call apiChord(hDc, X1, Y1, X2, Y2, 50, 100, 150, 150)
Case 9: "Заливка круга из центра
Call apiPie(hDc, X1, Y1, X2, Y2, 50, 100, 150, 150)
End Select

"Освобождаем контекст устройства
Call apiReleaseDC(hwnd, hDc)
Exit Sub
999:
MsgBox Err.Description "Ошибка
Err.Clear
End Sub

2. Картинку надобно прописывать позже тега

	Содержимое 2-й ячейки
Содержимое 3-й ячейки	Содержимое 4-й ячейки

3. Применять изображение дозволено в качестве ссылки. Для этого его довольно облачить в соответствующий тег: В контексте таблицы это будет выглядеть так:

	Содержимое 2-й ячейки
Содержимое 3-й ячейки	Содержимое 4-й ячейки

4. Добавочные вероятности изображений. 1. Смена картинки на цвет при наведении на нее мышью и позже смены местоположения курсора:onMouseOver=”this.style.background=’#номер цвета"” onMouseOut=”this.style.background=’#номер цвета"”2. Смена картинки на другое изображение при наведении мышью:onmouseover=”this.src=’images/1.gif"” onmouseout=”this.src=’images/2.gif"”3. Вставка вращающейся карусели из картинок в ячейку таблицы (значения дозволено менять):