ReSQL.ru
     
powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как рисовать API-функциями из VBA?
6 сообщений из 6, страница 1 из 1
Как рисовать API-функциями из VBA?
    #36218928
litvin44
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
litvin44
Гость
Стоит задача: средствами VBA создать растровое изображение (на основе заданных данных) и вставить его в документ.

В VB можно нарисовать с помощью GDI API-функций, указывая дискриптор (hDC) Form или PictureBox. А потом просто скопировать в Clipboard Form.Image или PictureBox.Image.
Но VBA не поддерживает PictureBox, а у UserForm нет свойств hDC и Image

Что можно придумать? На чем рисовать?
...
Рейтинг: 0 / 0
26.09.2009, 17:31
| Ответить | Цитировать | Написать  
Как рисовать API-функциями из VBA?
    #36218991
Фотография Бенедикт
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бенедикт
Участник
litvin44,
рисовать на битмапе в памяти. Ключевые слова: CreateCompatibleDC, CreateDIBSection или CreateCompatibleBitmap.
В MSForms есть элемент управления Image, у которого есть свойство Picture. Чтобы ему что-то присвоить, нужно объект GDI завернуть в COM-объект. Ключевое слово: OleCreatePictureIndirect.

Хинт: VB и VBA обсуждаются в форумах Visual Basic, Microsoft Office, Microsoft Access.
...
Рейтинг: 0 / 0
26.09.2009, 20:09
| Ответить | Цитировать | Написать  
Как рисовать API-функциями из VBA?
    #36225616
litvin44
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
litvin44
Гость
Вот, если это кому интересно

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Sub Рисование_GDI_и_Копирование()
Dim hCompDC As Long, hCompBM As Long
    'в памяти
    hCompDC = CreateCompatibleDC( 0 )
    hCompBM = CreateCompatibleBitmap(GetDC(GetDesktopWindow), размер_X, размер_Y)
    Call SelectObject(hCompDC, hCompBM)
    'рисование
    Call Рисование_GDI(hCompDC) 'вызов подпрограммы рисования с дискриптором в качестве аргумента
    'в буфер обмена
    If OpenClipboard( 0 ) Then
        EmptyClipboard
        Call SetClipboardData( 2 , hCompBM)  'vbCFBitmap=2, есть не во всех версиях VBA
        CloseClipboard
    Else
        MsgBox "Буфер обмена не доступен" 'ситуация маловероятная
    End If
    'удаление
    DeleteDC(hCompDC)
    DeleteObject(hCompBM)
End Sub

А я что не в том разделе?
...
Рейтинг: 0 / 0
30.09.2009, 16:24
| Ответить | Цитировать | Написать  
Как рисовать API-функциями из VBA?
    #36225863
Фотография Бенедикт
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бенедикт
Участник
litvin44,

Ошибки:
1) GetDC() без ReleaseDC().
2) SelectObject(hCompDC, hCompBM) без запоминания старого битмапа и обратного восстановления его.

IMHO, передавать через буфер обмена нехорошо, но это up to you, как говорится.

>А я что не в том разделе?
Хинт давался для поиска примеров.
Но я думаю, что не в том (формально), если поставлен такой вопрос. Другое дело - все привыкли.
...
Рейтинг: 0 / 0
30.09.2009, 17:42
| Ответить | Цитировать | Написать  
Как рисовать API-функциями из VBA?
    #36227005
litvin44
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
litvin44
Гость
Бенедикт, об ошибках:

1) А что ставить аргументом ReleaseDC()?
Ведь ответ GetDC() используется как аргумент для CreateCompatibleBitmap(), нигде не сохраняется и исчезает из памяти после заверешения подпрограммы
2.1) SelectObject() - там нечего запоминать (нули,черное поле), соответственно и нечего восстанавливать.
2.2) Восствновление перед удалением?
2.3) Запоминание/восстановление имело бы смысл для реального окна.
2.4) Для реального окна: надо изменить его изображение. После восстановления изображение останетсяНЕ измененным

Чем нехорошо?
Просмотр на форме НЕ нужен. И вообще нет никаких форм.
Надо именно скопировать в буфер
Потому и привожу свей код, что множество примеров в нете про скриншоты окон, т.е. про другое
...
Рейтинг: 0 / 0
01.10.2009, 11:43
| Ответить | Цитировать | Написать  
Как рисовать API-функциями из VBA?
    #36227589
Фотография Бенедикт
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Бенедикт
Участник
litvin441) А что ставить аргументом ReleaseDC()?
Ведь ответ GetDC() используется как аргумент для CreateCompatibleBitmap(), нигде не сохраняется и исчезает из памяти после заверешения подпрограммы
Код: plaintext
1.
2.
3.
4.
5.
Dim hwndDesktop As Long
Dim hdcDesktop As Long
hwndDesktop = GetDesktopWindow
hdcDesktop = GetDC(hwndDesktop)
hCompBM = CreateCompatibleBitmap(hdcDesktop, размер_X, размер_Y)
ReleaseDC hwndDesktop, hdcDesktop
litvin442.1) SelectObject() - там нечего запоминать (нули,черное поле), соответственно и нечего восстанавливать.Проверяйте - запомните, что вернул SelectObject и подайте на вход GetObjectType. Что возвращает GetObjectType?litvin442.2) Восствновление перед удалением?Да.
Код: plaintext
1.
2.
3.
4.
Dim hbmpPrev As Long
hbmpPrev = SelectObject(hCompDC, hCompBM)
'...
SelectObject hCompDC, hbmpPrev
DeleteDC hCompDC
Да, кстати о DeleteDC(hCompDC). Обратили внимание, что редактор VB/VBA упорно вставляет пробел перед открывающей скобкой? Вызов процедуры со взятием параметра в скобки имеет вполне определённый смысл: Вы говорите, что параметр следует передать по значению. В данном случае ошибки нет, но ситуация потенциально ведущая к неприятностям (при объявлении параметра ByRef), если не осознавать этот момент. Рекомендуется вызов процедуры делать либо через Call Процедура(Параметр{, [Параметр]}), либо Процедура Параметр{, [Параметр]}.litvin442.3) Запоминание/восстановление имело бы смысл для реального окна.Не понял. Т.е., если ничего не видно, то можно позволить утечку ресурсов?litvin442.4) Для реального окна: надо изменить его изображение. После восстановления изображение останетсяНЕ измененнымОкно, если отрисовывается рекомендованным способом, обновляется по WM_PAINT. Обработчик сообщения вызывает BeginPaint и получает DC для отрисовки с уже выбранным битмапом. Если надо обновить этот битмап (или его часть), например, отрисовав на нём битмап (или его часть), выбранный в memory DC, вызывается функция BitBlt. По крайней мере, такова стандартная последовательность.litvin44Чем нехорошо?Это моё скромное мнение как пользователя. Мне не нравится, когда программа без моего ведома а) уничтожает состояние буфера обмена, б) оставляет там что-то другое, в) передаёт данные "несекьюрным" способом.litvin44Надо именно скопировать в буферРаз так, значит так. Просто разные бывают документы, и разные способы вставки в них изображений.litvin44
Код: plaintext
DeleteObject(hCompBM)
Это уберите. После того, как отдали объект Clipboard-у, тот хозяйничает.
...
Рейтинг: 0 / 0
01.10.2009, 15:08
| Ответить | Цитировать | Написать  
6 сообщений из 6, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как рисовать API-функциями из VBA?
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]