Ошибка при рисовании линий и окружностей

Аксима · Регистрация: 12.12.2012

Студворк — интернет-сервис помощи студентам

Здравствуйте, коллеги,

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

Просмотрел похожие темы (по рисованию на форме), но примеры из этих тем у меня также не работают.

В моем коде все успешно обрабатывает до самого последнего этапа, а вот само рисование-то и не получается. Причем, после замены функции GetDC на более информативную функцию BeginPaint заметил следующую странность: размеры прямоугольника рисования (обозначенного мной как drawingRect) равны нулю! Очень странно.
Если бы вы объяснили мне, где я напортачил, я был бы вам очень признателен. Да и Disilly помогли бы в итоге.

С уважением,

Аксима

P.S. На всякий случай - у меня Office 2013, 64-битная версия.

@Catstail · 27.01.2016, 20:04

Увы... У меня офис-2003

@Димит · 27.01.2016, 20:39

посмотрите http://www.andypope.info/vba/userformdraw.htm
на практике я бы воспользовался GetDC, т. к. не знаком с BeginPaint
попробуйте UserForm_Initialize заменить на активате

Аксима · 28.01.2016, 14:57 **[ТС]**

Сообщение от Димит

на практике я бы воспользовался GetDC, т. к. не знаком с BeginPaint

Тоже сначала использовал GetDC, а на BeginPaint перешел в надежде узнать больше информации для отладки.

Сообщение от Димит

попробуйте UserForm_Initialize заменить на активате

Нет, не помогло...

После целой ночи разбирательств, кажется, установил причину проблемы. Если создать окно в C++ и попытаться нарисовать в окне что-нибудь, скажем, по клику мыши, то также ничего не нарисуется. Точнее, нарисуется, но после обработки события WM_PAINT все нарисованное будет уничтожено. А вот после того, как я реализовал перехват сообщения WM_PAINT, запретив системе самостоятельно перерисовывать окно, стало возможным лицезреть результаты трудов по рисованию в окне.

Сейчас работаю над реализацией перехвата этого сообщения в VBA. Пока ничего не получается, что и не удивительно - голова уже не варит должным образом после такой ночки... Когда удастся этого добиться - обязательно опубликую свое решение.

С уважением,

Аксима

@Catstail · 28.01.2016, 17:43

Дорогой Аксима!
Поскольку я не смог увидеть Ваш код, взгляните на мой (Проверил в Office-200). Рисование поверх формы на чистом API:

Visual Basic
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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
'::: Модуль mGraph
 
Public Type POINTAPI
       x As Long
       y As Long
End Type
 
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) 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 CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public 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) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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
 
Sub Sca(x As Double, y As Double, wXmin As Double, wXmax As Double, wYmin As Double, wYmax As Double, _
        x0 As Double, y0 As Double, W As Double, H As Double, xx As Long, yy As Long)
 
    xx = x0 + (x - xMin) * W / (wXmax - wXmin)
    yy = y0 + (wYmax - y) * H / (wYmax - wYmin)
 
End Sub
 
Sub DrawGraph()
 
Dim Lp  As POINTAPI
Dim Beg As Boolean
 
    hwnd& = GetActiveWindow
    hdc& = GetDC(hwnd&)
    
    penR& = CreatePen(1, 3, QBColor(12))
    penB& = CreatePen(1, 1, QBColor(8))
    hbr& = CreateSolidBrush(QBColor(15))
    
    SelectObject hdc&, hbr&
    Rectangle hdc&, 2, 2, 300, 300
    DeleteObject hbr&
 
    SelectObject hdc&, penB&
 
    For xx# = 0 To 10.9 Step 1#
        
        Sca xx#, -1.1, -0.1, 11#, -1.1, 1.1, 2, 2, 300, 300, x_1&, y_1&
        Sca xx#, 1.1, -0.1, 11#, -1.1, 1.1, 2, 2, 300, 300, x_2&, y_2&
        
        MoveToEx hdc&, x_1&, y_1&, Lp
        LineTo hdc&, x_2&, y_2&
    
    Next xx#
 
    For yy# = -1# To 1.1 Step 0.2
    
        Sca -0.1, yy#, -0.1, 10.9, -1.1, 1.1, 2, 2, 300, 300, x_1&, y_1&
        Sca 10.9, yy#, -0.1, 10.9, -1.1, 1.1, 2, 2, 300, 300, x_2&, y_2&
    
        MoveToEx hdc&, x_1&, y_1&, Lp
        LineTo hdc&, x_2&, y_2&
    
    Next yy#
    
    DeleteObject penB&
    SelectObject hdc&, penR&
    
    Beg = True
    
    For xx# = 0.01 To 10.9 Step 0.05
    
        yy# = Exp(-0.3 * xx#) * Sin(8 * xx#)
    
        Sca xx#, yy#, -0.1, 11#, -1.1, 1.1, 2, 2, 300, 300, x_1&, y_1&
    
        If Beg Then
           MoveToEx hdc&, x_1&, y_1&, Lp
        Else
           LineTo hdc&, x_1&, y_1&
        End If
        
        Beg = False
        
    Next xx#
 
    DeleteObject penR&
 
End Sub

Ну в форму добавляем две кнопки:

Visual Basic
1
2
3
4
5
6
7
Private Sub CommandButton1_Click()
        mGraph.DrawGraph
End Sub
 
Private Sub CommandButton2_Click()
        Me.Hide
End Sub

Проект и картинку прилагаю

@fever brain · 28.01.2016, 18:03

а к чему этот ряд чисел ? тут же не видно что это ответ ли это ))
решение ли это ? или это исправление ошибки рисования

Добавлено через 5 минут

Сообщение от Аксима

P.S. На всякий случай - у меня Office 2013, 64-битная версия

К сожалению .. тоже не могу помочь

@Catstail · 28.01.2016, 18:09

fever brain, это Вы мне? Я просто попробовал рисовать апишными вызовами поверх VBA-формы.

Аксима · 29.01.2016, 11:19 **[ТС]**

Catstail, я потрясен!!! Скачал ваш файл, нажал на кнопку - все работает! Скопировал свой код из файла DrawingGraphs.xlsm в вашу форму, нажал на кнопку - все работает!! Магия какая-то...
В общем, вы меня спасли, и это без всякого преувеличения, а то вполне мог бы в больницу попасть, если бы не удалось с этой проблемой разобраться.

С уважением,

Аксима

Аксима · 29.01.2016, 11:42 **[ТС]**

Хотел ваш файлик переделать, чтобы рисовал не по нажатию кнопки, а по событию Initialize формы, как в моем файле, но... ничего не получилось. Не рисует. Видимо, в этом и состояла моя ошибка - в неудачном выборе события для рисования, и никакой магии... Поскольку ни Initialize, ни Activate не работают, то видимо, придется обходить проблему через Application.OnTime...

Аксима · 29.01.2016, 11:55 **[ТС]**

С Application.OnTime все работает как и мечталось... Как же я доволен! И Catstail большой молодец, без его файла я бы еще долго мучался с диагностикой проблемы.

@Catstail · 29.01.2016, 11:56

Аксима, тут все дело в статусе DC. Чтобы рисовалось, нужно создавать свой DC, рисовать в нем, на на форму копировать. Примерно так.

@OLEGOFF · 29.01.2016, 11:56

Аксима,подскажите пожалуйста почему форма не инициализируется сразу.А потом выдает ошибку

Не по теме:

У меня 2003 офис

@fever brain · 29.01.2016, 12:07

OLEGOFF, Проверьте еще раз может вы зря говорите
если результат будет отрицательный, звоните 8 914 468 8320

@OLEGOFF · 29.01.2016, 12:21

Сообщение от fever brain

OLEGOFF, Проверьте еще раз может вы зря говорите

А что зря?Если на фото все видно

Не по теме:

Позвонить не могу,я в ДНР

Shersh · 29.01.2016, 12:33

Сообщение от Catstail

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

OLEGOFF, LONG<>LONGPTR

@Sasha_Smirnov · 29.01.2016, 16:42

Не по теме:

xtreme, привет!

Примеры SoftIce:

График на форме (античемпион-2014 по лайкам* за рисунок в ВБА!)
Рисование в VBA (чемпион-2013 по лайкам** за рисунок в ВБА!)

__________________
* 1
** 8, не считая конкурсных (там их под сотню)

@fever brain · 29.01.2016, 17:00

нее .. )) надо чтото совсем необычное..

Аксима · 29.01.2016, 17:28 **[ТС]**

Сообщение от OLEGOFF

Аксима,подскажите пожалуйста почему форма не инициализируется сразу.А потом выдает ошибку

Потому, что я все объявления функций пишу для 64-битной системы. Потом копирую в блок для 32-битной системы и удаляю Ptr в LongPtr'ах, но часть этих LongPtr я пропустил.
Прикладываю исправленный файл.

Сообщение от Sasha_Smirnov

античемпион-2014 по лайкам* за рисунок в ВБА

Теперь звание античемпиона принадлежит мне... что и неудивительно. Мне нужно работать намного больше, если я хочу впечатлить людей своими познаниями в WinAPI.

@Catstail · 31.01.2016, 10:27

Аксима, чтобы изображение на форме было "устойчивым" и не портилось при перемещениях за пределы экрана, нужно, отрисовав картинку, занести ее в свойство Picture формы. Поискал в Cети, нашел на одном форуме подходящий код и чуть-чуть его подрихтовал (для своего случая). Изображение теперь устойчиво (то, что в VB обеспечивается свойством Autoredraw=True).

Visual Basic
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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
Public Type POINTAPI
       x As Long
       y As Long
End Type
 
Public Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type
 
Public Type PicBmp
   Size As Long
   Type As Long
   hBmp As Long
End Type
 
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) 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 CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public 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) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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 Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Integer
Private Declare Function DeleteDC 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 OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
 
Sub Sca(x As Double, y As Double, wXmin As Double, wXmax As Double, wYmin As Double, wYmax As Double, _
        x0 As Double, y0 As Double, W As Double, H As Double, xx As Long, yy As Long)
 
    xx = x0 + (x - xMin) * W / (wXmax - wXmin)
    yy = y0 + (wYmax - y) * H / (wYmax - wYmin)
 
End Sub
 
Public Function ConvertBmpToIPicture(hBmp As Long) As IPictureDisp
    Dim Pic As PicBmp
    Dim IPic As IPicture
    Dim IID_IDispatch As GUID
    
    With IID_IDispatch
       .Data1 = &H20400
       .Data4(0) = &HC0
       .Data4(7) = &H46
    End With
    
    With Pic
       .Size = Len(Pic)
       .Type = 1
       .hBmp = hBmp
    End With
    
    rez& = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
     
    Set ConvertBmpToIPicture = IPic
    
End Function
 
Sub DrawGraph()
 
Dim Lp  As POINTAPI
Dim Beg As Boolean
Dim Pic As IPictureDisp
    
    hDCScreen& = GetWindowDC(0)
    
    hdc& = CreateCompatibleDC(hDCScreen&)
    hBMPDest& = CreateCompatibleBitmap(hDCScreen, 300, 300)
    hBMPOld& = SelectObject(hdc&, hBMPDest&)
    
    penR& = CreatePen(1, 3, QBColor(12))
    penB& = CreatePen(1, 1, QBColor(8))
    hbr& = CreateSolidBrush(QBColor(15))
    
    SelectObject hdc&, hbr&
    Rectangle hdc&, 2, 2, 300, 300
    DeleteObject hbr&
 
    SelectObject hdc&, penB&
 
    For xx# = 0 To 10.9 Step 1#
        
        Sca xx#, -1.1, -0.1, 11#, -1.1, 1.1, 2, 2, 300, 300, x_1&, y_1&
        Sca xx#, 1.1, -0.1, 11#, -1.1, 1.1, 2, 2, 300, 300, x_2&, y_2&
        
        MoveToEx hdc&, x_1&, y_1&, Lp
        LineTo hdc&, x_2&, y_2&
    
    Next xx#
 
    For yy# = -1# To 1.1 Step 0.2
    
        Sca -0.1, yy#, -0.1, 10.9, -1.1, 1.1, 2, 2, 300, 300, x_1&, y_1&
        Sca 10.9, yy#, -0.1, 10.9, -1.1, 1.1, 2, 2, 300, 300, x_2&, y_2&
    
        MoveToEx hdc&, x_1&, y_1&, Lp
        LineTo hdc&, x_2&, y_2&
    
    Next yy#
    
    DeleteObject penB&
    SelectObject hdc&, penR&
    
    Beg = True
    
    For xx# = 0.01 To 10.9 Step 0.05
    
        yy# = Exp(-0.3 * xx#) * Sin(8 * xx#)
    
        Sca xx#, yy#, -0.1, 11#, -1.1, 1.1, 2, 2, 300, 300, x_1&, y_1&
    
        If Beg Then
           MoveToEx hdc&, x_1&, y_1&, Lp
        Else
           LineTo hdc&, x_1&, y_1&
        End If
        
        Beg = False
        
    Next xx#
 
    DeleteObject penR&
 
    hBMPDest = SelectObject(hdc&, hBMPOld&)
    DeleteDC hdc&
    ReleaseDC 0, hDCScreen&
 
    Set Pic = ConvertBmpToIPicture(hBMPDest)
    
    frmMain.PictureAlignment = fmPictureAlignmentTopLeft
    
    Set frmMain.Picture = Pic
 
End Sub

Добавлено через 2 минуты
Кстати, стоит испытать эту технику для рисования в Image...

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

@Catstail Супер-модератор 38174 / 21109 / 4307 Регистрация: 12.02.2012 Сообщений: 34,711 Записей в блоге: 14
	27.01.2016, 20:04
	Увы... У меня офис-2003 1

@Димит 90 / 37 / 14 Регистрация: 03.11.2010 Сообщений: 429
	27.01.2016, 20:39
	посмотрите http://www.andypope.info/vba/userformdraw.htm на практике я бы воспользовался GetDC, т. к. не знаком с BeginPaint попробуйте UserForm_Initialize заменить на активате 1

@Catstail Супер-модератор 38174 / 21109 / 4307 Регистрация: 12.02.2012 Сообщений: 34,711 Записей в блоге: 14
	28.01.2016, 18:09
	fever brain, это Вы мне? Я просто попробовал рисовать апишными вызовами поверх VBA-формы. 0

Аксима 6082 / 1327 / 195 Регистрация: 12.12.2012 Сообщений: 1,023
	29.01.2016, 11:42 [ТС]
	Хотел ваш файлик переделать, чтобы рисовал не по нажатию кнопки, а по событию Initialize формы, как в моем файле, но... ничего не получилось. Не рисует. Видимо, в этом и состояла моя ошибка - в неудачном выборе события для рисования, и никакой магии... Поскольку ни Initialize, ни Activate не работают, то видимо, придется обходить проблему через Application.OnTime... 0

@Catstail Супер-модератор 38174 / 21109 / 4307 Регистрация: 12.02.2012 Сообщений: 34,711 Записей в блоге: 14
	29.01.2016, 11:56
	Аксима, тут все дело в статусе DC. Чтобы рисовалось, нужно создавать свой DC, рисовать в нем, на на форму копировать. Примерно так. 0

@OLEGOFF 1082 / 523 / 141 Регистрация: 27.02.2013 Сообщений: 1,508
	29.01.2016, 11:56
	Аксима,подскажите пожалуйста почему форма не инициализируется сразу.А потом выдает ошибку Не по теме: У меня 2003 офис Миниатюры Изображения 0

@fever brain oh my god 1456 / 796 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	29.01.2016, 12:07
	OLEGOFF, Проверьте еще раз может вы зря говорите если результат будет отрицательный, звоните 8 914 468 8320 0

@Sasha_Smirnov 5562 / 1370 / 150 Регистрация: 08.02.2009 Сообщений: 4,109 Записей в блоге: 30
	29.01.2016, 16:42
	Не по теме: xtreme, привет! Примеры SoftIce: График на форме (античемпион-2014 по лайкам* за рисунок в ВБА!) Рисование в VBA (чемпион-2013 по лайкам** за рисунок в ВБА!) __________________ * 1 ** 8, не считая конкурсных (там их под сотню) 1

@fever brain oh my god 1456 / 796 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	29.01.2016, 17:00
	нее .. )) надо чтото совсем необычное.. 0

Ошибка при рисовании линий и окружностей

Решение