[МишаИнженер]

При подключении библиотеки GDIplus.dll к VBA появляется ошибка.
Почему не удается подключить GDIplus.dll к VBA?
Есть ли способ использовать функции GDIPlus.dll в коде VBA?
Какие еще можно подключить библиотеки чтобы начать рисовать на формах UserForm VBA?

[Нубий-IV]

Сообщение от Сергей812 WorkCanvas - PicturesBox ака холст

Видимо, в нем все и дело. Если рисовать на форме - без буферизации будет дискотека. Два теста во вложении отличаются только свойством DoubleBuffered у формы. Достаточно поводить мышкой поверх. А если накинуть PicturesBox и рисовать в нем - мерцания не будет; видимо, буферизация у него встроенная.

[МишаИнженер]

Спасибо большое Сергей812 и Нубий-IV за ответы!
Не все понятно, но очень интересно!
Скажите пожалуйста почему в моей проге Excel не чертится конструкция (после нажатия на кнопке "Начертить конструкцию" на листе "узлы").
Если отключить Msgbox, то конструкция начинает чертится при перетаскивании мышкой, а начальной картинки нет.
Почему так получается?
Ещё вопрос: Где взять метод MouseWheel для UserForm?
Пока меня все устраивает в VBA: быстро открывается, легко программировать и т.д.
Но похоже с масштабированием чертежа на UserForm у меня не получается. Не могу найти метод который бы реагировал на вращение колесика на UserForm.
Из-за этого не получается сделать масштабирование. Может надо другой компонент использовать?
Но на других стандартных тоже такого метода не нашел.
Ещё вопрос: почему у меня опорные реакции вычисляются перепутанными местами?
Может я не учитываю перестановку строк при вычислении обратной матрицы?

[Сергей812]

не у всех 32-битный офис вообще то)

[Нубий-IV]

Сообщение от МишаИнженер начальной картинки нет. Почему так получается?

Она есть, ее иногда даже видно, но потом она пропадает. Очевидно, это конфликт между автоматической перерисовкой формы и ручным рисованием.

В WinApi рисование положено делать при обработке события WM_PAINT. Windows знает, что рисование - это дело тормозное, и оптимизирует перерисовку. Например, если в очереди болтается не обработанная предыдущая прорисовка, новое событие не добавляется в очередь, а объединяется с предыдущим, чтобы не мучить программу лишними рисованиями. Иногда можно создавать свои события через SendMessage или PostMessage (например, отправляя их при обработке события движения мышки), но большинство событий - автоматические. То есть команды на перерисовку приходят в основном от системы в автоматическом порядке. Например, в форму VB при ее создании или растягивании приходит WM_PAINT, и форма в ответ заливает себя серым фоном. Этот ответ формы на WM_PAINT невидим для программиста, событие UserForm_OnPaint почему-то спрятали. Но где-то внутри программы эта функция все равно есть, и события все равно обрабатываются.

Вот тут и начинаются проблемы: сначала вызов "Call НачертитьКонструкцию" что-то рисует на форме, а потом Windows присылает сообщение WM_PAINT, и форма в ответ обновляется, затирая рисунок. А если сначала вызвать MsgBox, то, видимо, событие присылается сразу после него, форма обновляется, потом работает "Call НачертитьКонструкцию", создавая рисунок, а потом Windows считает, что форма уже обновлена, новых событий перерисовки не требуется, и рисунок остается видимым.

Сообщение от МишаИнженер Где взять метод MouseWheel

На самом деле все события приходят в так называемую "оконную процедуру", в справке она зовется "WindowProc". На C она пишется вручную, и там можно обработать любые события; если завтра выйдет новая версия Windows с новыми событиями, их обработку можно будет дописать, и программа обзаведется новыми фишками. Обычно эта процедура в ответ на любое событие вызывает соответствующий обработчик. Так вот в бейсике эта процедура фиксированная и спрятана внутри, а наружу торчат всего несколько обработчиков - это те самые UserForm_Click() и т.п. Потому он и обрабатывает всего несколько типов событий - те, которые сочли важными разработчики. Они просто хотели как лучше - т.е. как проще; взамен "как сложнее" можно сделать только через костыли.

В WinApi есть еще понятие "Window Subclassing", это подмена готовой чужой оконной процедуры с целью ее расширить и углубить. Надо написать свою функцию - обработчик событий. В основном она просто вызывает старую через CallWindowProc, и только на несколько новых событий добавляет новые обработчики. Устанавливается она взамен родной вызовом SetWindowLong.

Так можно обработать MouseWheel. Так можно обработать WM_PAINT - сначала вызвать родную функцию, которая заливает форму фоном, а потом дорисовать поверх что надо.

Но я не развлекался таким в бейсике, и не посоветую, как сделать это правильно, это все надо гуглить - WindowProc, Window Subclassing, SetWindowLong, CallWindowProc. Примеры для C есть в справке по WinApi, для бейсика должны найтись на форумах.

Сообщение от МишаИнженер меня все устраивает в VBA

Пока все заданные вопросы - это на самом деле проблемы бейсика. Для простоты его огурец обрезали по самые помидоры. Легко делать простое, но тяжело делать сложное. Плюс он уже давно не обновляется. Массовые вызовы WinApi - это уже какая-то имитация C на бейсике получается. Тут уж либо смириться и писать в стиле Win98, либо читать справку WinApi для C и костылить, либо менять язык.

[МишаИнженер]

Сообщение от Нубий-IV если в очереди болтается не обработанная предыдущая прорисовка, новое событие не добавляется в очередь, а объединяется с предыдущим

Это идея стала основой модернизации кода:
Ситуацию выручила строка кода типа me.Repaint:

Код:

[Выделить все]

'Начертим конструкцию из КЭ
   gdМКЧ = 1#: gdDXЧ = 0#: gdDYЧ = 0#
   Set objЧ = New UserForm2
   objЧ.Show
   objЧ.StatusBar1.SimpleText = "Чертеж открыт"
   objЧ.Repaint

Теперь при нажатии кнопки "Начертить конструкцию" конструкция сразу вычерчивается на форме. Спасибо Нубий-IV!!!

[Нубий-IV]

Сообщение от МишаИнженер Ситуацию выручила

Хорошо, если так. Но подозреваю, что ситуации с пропадающим изображением могут проявляться и при других условиях. На всякий случай можно скачать программу WinSpy или WinSpy++, она для выбранного окна показывает приходящие события в реальном времени. Можно прифигеть от их количества и разнообразия.

[Сергей812]

Сообщение от Нубий-IV Пока все заданные вопросы - это на самом деле проблемы бейсика. Для простоты его огурец обрезали по самые помидоры

не для простоты - а чтобы не было конкуренции с отдельной средой разработки VB)

[МишаИнженер]

Сообщение от Сергей812 В приложении пример рисовалки на .Net Winforms (поставить вершину - левая кнопка мыши, завершить рисование - правая, Ctrl+Z тоже прикручена) - и без оптимизации "движка" не лагает заметно. Все сделано стандартными средствами ЯП

Уважаемый Сергей812!
Можете конвертировать вашу программу DrawLineWindowsForms3 на язык программирования VB.NET?
Или подскажите пожалуйста как сделать чтобы в следующей программе на VB.NET:

Код:

[Выделить все]

Imports System.Drawing.Drawing2D
Public Class Form1_Чертилка
    Private ballX As Integer = 50
    Private ballY As Integer = 50
    Private ballSpeedX As Integer = 5
    Private ballSpeedY As Integer = 5
    Private ballSize As Integer = 50
    Private WithEvents tmrAnimation As New Timer()
    Dim g As Graphics
    Private X1 As Integer, Y1 As Integer
    Private X2 As Integer, Y2 As Integer
    Private brush As LinearGradientBrush
    Private pn As Pen
    Private lns As List(Of aLine)
    Private NewLine As aLine
    Private bПрПолучТочки1 As Boolean
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.DoubleBuffered = True
        tmrAnimation.Interval = 5
        tmrAnimation.Enabled = True
        brush = New LinearGradientBrush(New Point(20, 20), New Point(Me.ClientSize.Width, Me.ClientSize.Height), Color.Red, Color.Blue)
        pn = New Pen(brush, 8)
        lns = New List(Of aLine)
        g = Me.CreateGraphics()
    End Sub
 
    Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
        Dim gr As Graphics = e.Graphics
        gr.SmoothingMode = SmoothingMode.AntiAlias
        gr.InterpolationMode = InterpolationMode.Bicubic
        Dim brush As New SolidBrush(Color.LightBlue)
        gr.FillEllipse(brush, ballX, ballY, ballSize, ballSize)
        gr.DrawEllipse(New Pen(Color.Red, 0), ballX, ballY, ballSize, ballSize)
        For Each ln As aLine In lns
            gr.DrawLine(pn, ln.xx1, ln.yy1, ln.xx2, ln.yy2)
        Next
    End Sub
 
    Private Sub tmrAnimation_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrAnimation.Tick
        ballX += ballSpeedX
        ballY += ballSpeedY
        If ballX < 0 OrElse ballX + ballSize > Me.ClientSize.Width Then
            ballSpeedX = -ballSpeedX
        End If
        If ballY < 0 OrElse ballY + ballSize > Me.ClientSize.Height Then
            ballSpeedY = -ballSpeedY
        End If
        Me.Refresh()
    End Sub
 
    Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
        If bПрПолучТочки1 = False Then
            X1 = e.X
            Y1 = e.Y
            bПрПолучТочки1 = True
        Else
            X2 = e.X
            Y2 = e.Y
            lns.Add(New aLine(X1, Y1, X2, Y2))
            bПрПолучТочки1 = False
        End If
    End Sub
 
    Private Sub Form1__SizeChanged(sender As Object, e As EventArgs) Handles MyBase.SizeChanged
        g = Me.CreateGraphics
        brush = New LinearGradientBrush(New Point(20, 20), New Point(Me.ClientSize.Width, Me.ClientSize.Height), Color.Red, Color.Blue)
        pn = New Pen(brush, 8)
    End Sub
 
    Private Sub Form1_Чертилка_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
        Dim X2d As Integer, Y2d As Integer
        If bПрПолучТочки1 = True Then
            X2d = e.X
            Y2d = e.Y
            g.DrawLine(pn, X1, Y1, X2d, Y2d)
        End If
    End Sub
 
    Private Class aLine
        Public Property xx1 As Integer
        Public Property yy1 As Integer
        Public Property xx2 As Integer
        Public Property yy2 As Integer
        Public Sub New(ax As Integer, ay As Integer, bx As Integer, by As Integer)
            _xx1 = ax
            _yy1 = ay
            _xx2 = bx
            _yy2 = by
        End Sub
    End Class
End Class

чтобы новая линия была видна на форме когда мышка неподвижна и чтобы изображение не рябило?

[Сергей812]

Сообщение от МишаИнженер Можете конвертировать вашу программу DrawLineWindowsForms3 на язык программирования VB.NET?

попробуйте конвертер типа этого.

[МишаИнженер]

Сообщение от Сергей812 попробуйте конвертер типа этого.

Получил следующий код:

Код:

[Выделить все]

Imports System.Collections.Generic
Imports System.Drawing

Namespace DrawLineWindowsForms
    Friend NotInheritable Class DrawLineInfo
        Private ReadOnly _PenColor As Color
        Private ReadOnly _PenWidth As Single
        Private ReadOnly _Vertexes As New List(Of Point)

        Public Sub New(aPenColor As Color, aPenWidth As Single)
            _PenColor = aPenColor
            _PenWidth = aPenWidth
        End Sub

        Public Sub AddVertex(aPoint As Point)
            _Vertexes.Add(aPoint)
        End Sub

        Public Function RemoveLastVertex() As Boolean
            Dim lRes As Boolean = _Vertexes.Count > 0
            If _Vertexes.Count > 0 Then _Vertexes.RemoveAt(_Vertexes.Count - 1)
            Return lRes
        End Function

        Public Sub Update(aGraphics As Graphics)
            If _Vertexes.Count > 1 Then
                Dim lScaleX As Single = aGraphics.DpiX / 25.4F
                Dim lScaleY As Single = aGraphics.DpiY / 25.4F
                Dim lCVertexes((_Vertexes.Count) - 1) As Point
                Dim i As Integer = 0
                For Each lVertex As Point In _Vertexes
                    lCVertexes(i) = New Point(CInt(lVertex.X / lScaleX), CInt(lVertex.Y / lScaleY))
                    i += 1
                Next
                Dim lPen As New Pen(_PenColor, _PenWidth)
                aGraphics.DrawLines(lPen, lCVertexes)
            End If
        End Sub

        Public Sub Update(aGraphics As Graphics, aMouseLocation As Point)
            If _Vertexes.Count > 0 Then
                Dim lScaleX As Single = aGraphics.DpiX / 25.4F
                Dim lScaleY As Single = aGraphics.DpiY / 25.4F
                Dim lCVertexes(_Vertexes.Count) As Point
                Dim i As Integer = 0
                For Each lVertex As Point In _Vertexes
                    lCVertexes(i) = New Point(CInt(lVertex.X / lScaleX), CInt(lVertex.Y / lScaleY))
                    i += 1
                Next
                lCVertexes(i) = New Point(CInt(aMouseLocation.X / lScaleX), CInt(aMouseLocation.Y / lScaleY))
                Dim lPen As New Pen(_PenColor, _PenWidth)
                aGraphics.DrawLines(lPen, lCVertexes)
            End If
        End Sub
    End Class
End Namespace

Imports System
Imports System.Collections.Generic
Imports System.Drawing
Imports System.Linq
Imports System.Windows.Forms

Namespace DrawLineWindowsForms
    Partial Public Class SuperPaint
        Inherits Form

        Private Const cToleranceDispPosMouse As Integer = 2

        Private Structure PenColorInfo
            Public Desc As String
            Public Color As Color

            Public Sub New(aDesc As String, aColor As Color)
                Desc = aDesc
                Color = aColor
            End Sub
        End Structure

        Private Structure PenWidthInfo
            Public Desc As String
            Public Width As Single

            Public Sub New(aDesc As String, aWidth As Single)
                Desc = aDesc
                Width = aWidth
            End Sub
        End Structure

        Private _StateDrawLine As Boolean = False
        Private ReadOnly _DrawLines As New List(Of DrawLineInfo)
        Private ReadOnly _PresetsPenColors As New List(Of PenColorInfo)
        Private ReadOnly _PresetsPenWidths As New List(Of PenWidthInfo)
        Private _LastPosMouseInWorkCanvas As New Point(0, 0)
        Private _IsChangedPosMouseInWorkCanvas As Boolean = False

        Private Sub UpdateEnabledStateControls()
            SelectPenColorCBox.Enabled = Not _StateDrawLine
            SelectPenWidthCBox.Enabled = Not _StateDrawLine
            DrawLineBtn.Enabled = Not _StateDrawLine
        End Sub

        Private Sub FillSelectPenColorCBox()
            _PresetsPenColors.Add(New PenColorInfo("Синий цвет", Color.Blue))
            _PresetsPenColors.Add(New PenColorInfo("Красный цвет", Color.Red))
            _PresetsPenColors.Add(New PenColorInfo("Зеленый цвет", Color.Green))
            For Each lPCI As PenColorInfo In _PresetsPenColors
                SelectPenColorCBox.Items.Add(lPCI.Desc)
            Next
            If _PresetsPenColors.Count > 0 Then SelectPenColorCBox.SelectedIndex = 0
        End Sub

        Private Sub FillSelectPenWidthCBox()
            _PresetsPenWidths.Add(New PenWidthInfo("0.25 мм", 0.25F))
            _PresetsPenWidths.Add(New PenWidthInfo("0.5 мм", 0.5F))
            _PresetsPenWidths.Add(New PenWidthInfo("1.0 мм", 1.0F))
            _PresetsPenWidths.Add(New PenWidthInfo("2.0 мм", 2.0F))
            _PresetsPenWidths.Add(New PenWidthInfo("3.0 мм", 3.0F))
            _PresetsPenWidths.Add(New PenWidthInfo("4.0 мм", 4.0F))
            _PresetsPenWidths.Add(New PenWidthInfo("5.0 мм", 5.0F))
            For Each lPWI As PenWidthInfo In _PresetsPenWidths
                SelectPenWidthCBox.Items.Add(lPWI.Desc)
            Next
            If _PresetsPenWidths.Count > 0 Then SelectPenWidthCBox.SelectedIndex = 0
        End Sub

        Public Sub New()
            InitializeComponent()
            FillSelectPenColorCBox()
            FillSelectPenWidthCBox()
            Me.KeyPreview = True
            AddHandler Me.KeyDown, AddressOf SuperPaint_KeyDown
        End Sub

        Private Sub SuperPaint_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            AddHandler WorkCanvas.Paint, AddressOf WorkCanvas_Paint
        End Sub

        Private Sub SuperPaint_KeyDown(sender As Object, e As KeyEventArgs)
            If (e.KeyValue = CInt(Keys.Z)) AndAlso e.Control AndAlso _StateDrawLine Then
                If _DrawLines.Last().RemoveLastVertex() Then
                    _IsChangedPosMouseInWorkCanvas = True
                    WorkCanvas.Invalidate()
                End If
            End If
        End Sub

        Private Sub WorkCanvas_Paint(sender As Object, e As PaintEventArgs)
            Dim lGraphics As Graphics = e.Graphics
            lGraphics.PageUnit = GraphicsUnit.Millimeter
            lGraphics.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
            If _DrawLines.Count > 0 Then
                If _StateDrawLine Then
                    If _IsChangedPosMouseInWorkCanvas Then
                        If _DrawLines.Count > 1 Then
                            For i As Integer = 0 To _DrawLines.Count - 2
                                _DrawLines(i).Update(lGraphics)
                            Next
                            _DrawLines.Last().Update(lGraphics, _LastPosMouseInWorkCanvas)
                        Else
                            _DrawLines.Last().Update(lGraphics, _LastPosMouseInWorkCanvas)
                        End If
                        _IsChangedPosMouseInWorkCanvas = False
                    Else
                        For Each aItem As DrawLineInfo In _DrawLines
                            aItem.Update(lGraphics)
                        Next
                    End If
                Else
                    For Each aItem As DrawLineInfo In _DrawLines
                        aItem.Update(lGraphics)
                    Next
                End If
            End If
        End Sub

        Private Sub WorkCanvas_MouseMove(sender As Object, e As MouseEventArgs) Handles WorkCanvas.MouseMove
            OutDrawCoor.Text = $"X = {e.X}; Y = {e.Y}"
            If (Math.Abs(e.X - _LastPosMouseInWorkCanvas.X) > cToleranceDispPosMouse) OrElse
               (Math.Abs(e.Y - _LastPosMouseInWorkCanvas.Y) > cToleranceDispPosMouse) Then
                _LastPosMouseInWorkCanvas = e.Location
                _IsChangedPosMouseInWorkCanvas = True
                WorkCanvas.Invalidate()
            Else
                _IsChangedPosMouseInWorkCanvas = False
            End If
        End Sub

        Private Sub WorkCanvas_MouseLeave(sender As Object, e As EventArgs) Handles WorkCanvas.MouseLeave
            OutDrawCoor.Text = Nothing
            _IsChangedPosMouseInWorkCanvas = False
            If _StateDrawLine Then WorkCanvas.Invalidate()
        End Sub

        Private Sub DrawLineBtn_Click(sender As Object, e As EventArgs) Handles DrawLineBtn.Click
            _DrawLines.Add(New DrawLineInfo(_PresetsPenColors(SelectPenColorCBox.SelectedIndex).Color, _PresetsPenWidths(SelectPenWidthCBox.SelectedIndex).Width))
            _StateDrawLine = True
            UpdateEnabledStateControls()
            WorkCanvas.Invalidate()
        End Sub

        Private Sub ClearWorkCanvasBtn_Click(sender As Object, e As EventArgs) Handles ClearWorkCanvasBtn.Click
            _DrawLines.Clear()
            _StateDrawLine = False
            UpdateEnabledStateControls()
            WorkCanvas.Invalidate()
        End Sub

        Private Sub WorkCanvas_MouseDown(sender As Object, e As MouseEventArgs) Handles WorkCanvas.MouseDown
            If (e.Button = MouseButtons.Left) AndAlso _StateDrawLine Then
                _DrawLines.Last().AddVertex(e.Location)
                WorkCanvas.Invalidate()
            End If
            If (e.Button = MouseButtons.Right) AndAlso _StateDrawLine Then
                _StateDrawLine = False
                UpdateEnabledStateControls()
            End If
        End Sub
    End Class
End Namespace

Почему в коде 2 блока Namespace?
В какие модули (классы, формы или просто модули) надо вставлять эти Namespace и это код?

[Сергей812]

потому что это несколько объявлений классов, каждый из которых в своем физическом файле находится. В исходном C# были вставлена строка из звездочек по границам физических файлов - в посте просто объединил все в один блок кода.

[МишаИнженер]

Сообщение от Сергей812 потому что это несколько объявлений классов, каждый из которых в своем физическом файле находится. В исходном C# были вставлена строка из звездочек по границам физических файлов - в посте просто объединил все в один блок кода.

А названия файлов какие были?

[Сергей812]

Сообщение от МишаИнженер А названия файлов какие были?

да любые) В вижуалстудии названия файлов - это для удобства навигации программиста по решению, сама студия оперирует с логической моделью решения на основе пространств. Назовите по именам классов, например.