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

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

[Сергей812]

кинуть на форму Images и рисовать через декларируемые апишные функции, насколько помню.. еще то развлечение)

[Александр Ривилис]

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

Почитай какого типа dll можно использовать в VBA - вопросы отпадут.

[Сергей812]

даже в древней версии .Net Framework 1.1 (выпущенной 20 лет назад) есть классы, реализующие поддержку вызова API функций графического интерфейса для рисования. В VBA за эти годы ничего не изменилось - все ручками, ручками)

----- добавлено через ~35 мин. -----
Например, в VBA начертить эллипс на форме

Код:

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

Option Explicit

' Функция получения дескриптора окна
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

' Функция получения дескриптора для клиентской области указанного окна
Private Declare PtrSafe Function GetDC Lib "USER32" (ByVal HWnd As LongPtr) As Long

' Функция рисования эллипса, вписанного в указанный прямоугольник
Public Declare PtrSafe Function Ellipse Lib "gdi32" (ByVal HDc As LongPtr, _
  ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

' Функция освобождения контекста устройства
Private Declare PtrSafe Function ReleaseDC Lib "User32.dll" (ByVal HWnd As LongPtr, _
  ByVal HDc As LongPtr) As LongPtr


Public Sub Test001()
  ' Получаем дескриптор окна формы
  Dim lHWnd As LongPtr: lHWnd = FindWindow(vbNullString, UserForm1.Caption)
  ' Получаем дескриптор для клиентской области окна
  Dim lHDc As Long: lHDc = GetDC(lHWnd)
  ' Рисуем эллипс
  Ellipse lHDc, 10, 10, 50, 50
  ' Освобождаем контекст устройства
  ReleaseDC lHWnd, lHDc
End Sub

при этом еще надо учитывать, что декларации API функций для 32 и 64-битных приложений будет отличаться.

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

Удалось начертить линии на UserForm, посмотрите файл Excel.
Но проблема теперь заключается в том, что начальная точка отсчета находится в левом ВЕРХНЕМ углу и ось Y направлена вниз.
Есть функция TranslateTransform, которая переносит точку начала координат в другую точку.
Попытался применить эту функцию в коде и появляется ошибка что "Функция не найдена в gdiplus.dll".
Как исправить эту ошибку?

[Сергей812]

подозреваю, что при вашей нелюбви к чтению документации неправильно задекларировали функцию)

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

Немного поменял декларацию функции TranslateTransform согласно описанию данной функции на сайте Microsoft. Добавил пользовательский тип Status, (посмотрите картинки)
Но при вызове функции опять появляется таже ошибка

Код:

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

Private Sub UserForm_Initialize()
Dim retVal As Status
'Get hWndForm
   hWndForm = FindWindow(vbNullString, Me.Caption)
   hDCForm = GetDC(hWndForm)
   retVal = GdipTranslateTransform(hDCForm, 0, 50)
'Initiate GDI+
   Call InitGDI
End Sub

Где можно посмотреть какое название имеет эта функция TranslateTransform в файле gdiplus.dll?
Правильно ли решение, что параметр "optional" можно не описывать при декларации функции?

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

Удалось запустить метод TranslateTransform поместив вызов в функцию вычерчивания линии:

Код:

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

Public Sub gLine(ByVal hDC As LongPtr, ByVal penColor As Long, ByVal penAlpha As Long, thickness As Long, _
                 ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
Dim hGraphics As LongPtr, hPen As LongPtr, lRes As Long
Dim retVal As Status, MOrd As MatrixOrder
   If GdipToken <> 0 And GdipCreateFromHDC(hDC, hGraphics) = 0 Then
      MOrd = MatrixOrderAppend
      retVal = GdipTranslateWorldTransform(hGraphics, 0#, 50#, MOrd)
      If penAlpha < 0 Then penAlpha = 0
      If penAlpha > 100 Then penAlpha = 100
      lRes = GdipCreatePen1(ConvertColor(penColor, penAlpha), thickness, &H2&, hPen)
      If hPen <> 0 Then
        lRes = GdipSetSmoothingMode(hGraphics, SmoothingModeAntiAlias)
        lRes = GdipDrawLineI(hGraphics, hPen, X1, Y1, X2, Y2)
        GdipDeletePen (hPen)
      End If     
      Call GdipDeleteGraphics(hGraphics)
   End If
End Sub

Это пришлось сделать потому что в качестве параметра этой функции надо указывать не дескриптор UserForm, а дескриптор объекта Grafix, который создается в функции вычерчивания линии.
Функция вызывается нормально, правда ничего не делает и возвращает состояние "сбой при выполнении".
Изменить ТЕКСТОВЫЙ режим черчения на форме (начало координат слева сверху) на ИЗОМЕТРИЧЕСКИЙ (начало координат слева снизу) не получается.
Есть ли возможность настроить ИЗОМЕТРИЧЕСКИЙ режим черчения на UserForm VBA?
И еще:
Получается что при рисовании каждой линии создается новый объект Grafix который вычерчивает эту линию на форме и потом этот объект удаляется, а линия остается.
А в какой контейнер записывается эта линия? Так как при рисовании следующей линии предыдущие не пропадают с экрана.
Мне в будущем надо будет постоянно вызывать этот контейнер для отрисовки, так как надо показывать ДИНАМИЧЕСКУЮ отрисовку линии на форме. То есть пока не указана конечная точка линии, на форме должна всегда чертиться, поверх всех остальных линий, линия от начальной точки до курсора мышки. То есть при перемещении мышки по форме в методе MouseMove надо перерисовывать картинку на форме и поверх этой картинки чертить линию от начальной точки до курсора мышки. Как вызвать метод перерисовки формы, чтобы заново чертились все линии до момента черчения новой линии?
Эти задачи надо решить для удобства черчения на UserForm.
Есть ли способ решения этих задач?

[Сергей812]

Сообщение от МишаИнженер Есть ли способ решения этих задач?

хранить всю информацию и в обработчике события Paint отрисовывать заново. Причем в VBA WinForms этого обработчика события нет, насколько помню. Поэтому еще и хук (это не ругательство, если что) придется ставить на это событие.

[Нубий-IV]

Не спец по Gdi+ и бейсику, но когда-то писал простые программы WinApi на пурсике, что-то еще смутно помню .

Сообщение от МишаИнженер Есть ли возможность настроить ИЗОМЕТРИЧЕСКИЙ режим черчения на UserForm VBA?

SetMapMode прекрасно работает. Фокус в том, что GetDC при каждом вызове возвращает новый контекст, у которого режим сброшен в дефолтный MM_TEXT. Так что надо вызвать GetDC, сохранить результат в переменной, и передавать его как параметр во все остальные функции - SetMapMode, GetMapMode, DrawLine, DrawCircle, DrawRectangle, ReleaseDC. А сейчас при каждом их вызове контекст запрашивается заново, со сброшенным режимом.

Еще важно: WinApi не освобождает память самостоятельно, как VB. Всю очистку нужно делать вручную. Есть вызов CreateDC - нужен и DeleteDC; есть GetDC - нужен ReleaseDC, и т.д. для всех остальных объектов - окон, перьев и т.п.; в справке по функциям WinApi всегда в примечаниях указывают соответствующую функцию очистки. Количество создающих функций должно точно соответствовать количеству удаляющих, иначе в программе начнет течь память; иногда даже Windows можно заглючить своими действиями. Сейчас в программе функция hdc(), которая запрашивает контекст, вызывается много раз, а освобождающая ReleaseDC - редко.

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

Очевидно, форма держит в памяти картинку со всеми начерченными линиями, и показывает ее на экране, когда надо. В чистом WinApi такой халявы нет, там обязательно в ответ на событие WM_PAINT нужно рисовать все, что должно быть видно в окне, иначе вместо картинки будут видны обрывки чужих окон.

Сообщение от МишаИнженер надо показывать ДИНАМИЧЕСКУЮ отрисовку линии

Придется очищать форму и рисовать по ней заново - сначала все старые линии, потом новую. Известно, что скорость рисования через функции WinApi невысокая, от этого при рисовании экран будет сильно мигать. И есть стандартный трюк с двойной буферизацией, чтобы это мигание убрать. WinApi поддерживает этот трюк через специальные функции:

1. Создаем копию контекста в памяти - CreateCompatibleDC
2. Создаем картинку, которая имитирует поверхность окна - CreateCompatibleBitmap. Это картинка и есть буфер.
3. Загружаем картинку в новый контекст - SelectObject
4. Заливаем картинку цветом - FillRect
5. Рисуем что надо - DrawLine и т.п. Рисуем не в контексте окна, а в новом. При этом все нарисованное пишется в буферную картинку.
6. Когда картинка готова - выводим ее на форму, копируя контекст памяти в контекст формы - BitBlt

Код:

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

 
void OnPaint(HWND hWnd, WPARAM, LPARAM)
{
   PAINTSTRUCT ps;
   HDC hdc = BeginPaint(hWnd, &ps);
   
   HDC hMemDC = CreateCompatibleDC(hdc);  // Чистый контекст памяти

   RECT rect;
   GetWindowRect(hWnd, &rect);
   
   HBITMAP hbm = CreateCompatibleBitmap(  // Содержимое контекста
      hdc,
      rect.right - rect.left,
      rect.bottom - rect.top
   );
   SelectObject(hMemDC, hbm);             //Вставка содержимого в контекст

   
   RECT r = rect;
   r.left -= rect.left;
   r.right -= rect.left;
   r.top -= rect.top;
   r.bottom -= rect.top;
   
   FillRect(hMemDC, &r, GetStockObject(WHITE_BRUSH)); // Заливка контекста
   
   Rotate();
  
   for(UINT i=0; i<nNumOfElements; i++){              // Рисование в контексте
      MoveToEx(
         hMemDC,
         X + pRotatePoints[pElements[i].first].x,
         Y + pRotatePoints[pElements[i].first].y,
         0
      );
      LineTo(
         hMemDC,
         X + pRotatePoints[pElements[i].second].x,
         Y + pRotatePoints[pElements[i].second].y
      );
   }

   BitBlt(                          // Быстрый вывод из памяти на экран
      hdc,
      0,
      0,
      rect.right - rect.left,
      rect.bottom - rect.top,
      hMemDC,
      0,
      0,
      SRCCOPY
   );
   
   DeleteDC(hMemDC);  // Порядок уничтожения важен
   DeleteObject(hbm);   // Порядок уничтожения важен
   
   EndPaint(hWnd, &ps);
}

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

Кстати, есть еще фунция CreateDIBSection - она создает картинку поверх массива байтов. В чистом C можно этот массив редактировать впрямую, тем самым рисуя на картинке попиксельно, скорость по сравнению с Gdi получается на порядки выше. Не знаю, можно ли этот трюк провернуть в VB.

Черчение не из той точки

Функция LineTo хитро устроена - она чертит из предыдущего положения, поэтому у нее не 4 координаты в параметрах, а только 2. Начальную точку надо задавать отдельно через MoveTo.

[Сергей812]

Сообщение от Нубий-IV Известно, что скорость рисования через функции WinApi невысокая, от этого при рисовании экран будет сильно мигать.

это было актуально лет так *-цать назад. Сейчас неизвестно, что больше будет тормозить - API GDI или сам VBA) Да и перерисовывать надо не всю форму, а лишь рабочий холст. Что опять же в VBA потребует приделывания очередных костылей. Слезать с VBA, в общем, надо) В приложении пример рисовалки на .Net Winforms (поставить вершину - левая кнопка мыши, завершить рисование - правая, Ctrl+Z тоже прикручена) - и без оптимизации "движка" не лагает заметно. Все сделано стандартными средствами ЯП.

[Нубий-IV]

Сообщение от Сергей812 это было актуально лет так *-цать назад.

Посмотрел - мои старые тестовые программки работают как и в стародавние времена: небуферизованный вывод мигает, буферизованный не мигает, доступ к массиву пикселей дает гладкий попиксельный рендер в реальном времени. Но у меня тесты посложенее были, там проволочные объекты крутились, и перерисовывать надо было все линии в новом положении, а не только последний сегмент. Так в небуферизованной версии вся картика мигает, как тут в Net-примере мигает последний сегмент.

Сообщение от Сергей812 Все сделано стандартными средствами ЯП.

А как там перерисовка последнего сегмента сделана? Как он исчезает из предыдущего положения и появляется в новом, восстанавливая ранее закрашенную часть картинки?

[Сергей812]

Сообщение от Нубий-IV А как там перерисовка последнего сегмента сделана? Как он исчезает из предыдущего положения и появляется в новом, восстанавливая ранее закрашенную часть картинки?

раньше написал же

Сообщение от Сергей812 без оптимизации "движка"

т.е. просто заново перерисовываются все линии на холсте (PicturesBox). А последний сегмент дорисовывается - если стоит флаг рисования линии и курсор мыши находится над холстом: тогда от последней фиксированной точки до позиции мыши. А чуть "лагает" - просто гистерезис сделан на пару координатных единиц смещения мыши, чтобы перерисовку по каждому чиху не дергало.

----- добавлено через ~15 мин. -----
собственно весь код, где:

WorkCanvas - PicturesBox ака холст
OutDrawCoor - метка вывода координат мыши
SelectPenColorCBox - комбобокс цвета линии
SelectPenWidthCBox - комбобокс толщины линии
DrawLineBtn - кнопка рисования линии
ClearWorkCanvasBtn - кнопка очистки холста

Код:

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

 
using System.Collections.Generic;
using System.Drawing;


namespace DrawLineWindowsForms
{
    internal sealed class DrawLineInfo
    {
        private readonly Color _PenColor;

        private readonly float _PenWidth;

        private readonly List<Point> _Vertexes = new List<Point>();

        public DrawLineInfo(Color aPenColor, float aPenWidth)
        {
           _PenColor = aPenColor;
           _PenWidth = aPenWidth;
        }

        public void AddVertex(Point aPoint)
        {
            _Vertexes.Add(aPoint);
        }

        public bool RemoveLastVertex()
        {
            bool lRes = _Vertexes.Count > 0;
            if (_Vertexes.Count > 0) _Vertexes.RemoveAt(_Vertexes.Count - 1);
            return lRes;
        }

        public void Update(Graphics aGraphics)
        {
            if (_Vertexes.Count > 1)
            {
                float lScaleX = aGraphics.DpiX / 25.4F;
                float lScaleY = aGraphics.DpiY / 25.4F;
                Point[] lCVertexes = new Point[_Vertexes.Count];
                int i = 0;
                foreach (Point lVertex in _Vertexes)
                {
                    lCVertexes[i++] = new Point(
                        (int)(lVertex.X / lScaleX), (int)(lVertex.Y / lScaleY));
                }
                Pen lPen = new Pen(_PenColor, _PenWidth);
                aGraphics.DrawLines(lPen, lCVertexes);
            }
        }

        public void Update(Graphics aGraphics, Point aMouseLocation)
        {
            if (_Vertexes.Count > 0)
            {
                float lScaleX = aGraphics.DpiX / 25.4F;
                float lScaleY = aGraphics.DpiY / 25.4F;
                Point[] lCVertexes = new Point[_Vertexes.Count + 1];
                int i = 0;
                foreach (Point lVertex in _Vertexes)
                {
                    lCVertexes[i++] = new Point(
                        (int)(lVertex.X / lScaleX), (int)(lVertex.Y / lScaleY));
                }
                lCVertexes[i] = new Point((int)(aMouseLocation.X / lScaleX), 
                    (int)(aMouseLocation.Y / lScaleY));
                Pen lPen = new Pen(_PenColor, _PenWidth);
                aGraphics.DrawLines(lPen, lCVertexes);
            }
        }
    }

}

***************************************************************************************


using System;
using System.Collections.Generic;
using System.Drawing;
using System.Linq;
using System.Windows.Forms;

namespace DrawLineWindowsForms
{
    public partial class SuperPaint : Form
    {
        private const int cToleranceDispPosMouse = 2;

        private struct PenColorInfo
        {
            public string Desc;

            public Color Color;

            public PenColorInfo(string aDesc, Color aColor)
            {
                Desc = aDesc;
                Color = aColor;
            }
        }
        
		
        private struct PenWidthInfo
        {
            public string Desc;

            public float Width;

            public PenWidthInfo(string aDesc, float aWidth)
            {
                Desc = aDesc;
                Width = aWidth;
            }
        }


        private bool _StateDrawLine = false;

        private readonly List<DrawLineInfo> _DrawLines = new List<DrawLineInfo>();

        private readonly List<PenColorInfo> _PresetsPenColors = new List<PenColorInfo>();

        private readonly List<PenWidthInfo> _PresetsPenWidths = new List<PenWidthInfo>();

        private Point _LastPosMouseInWorkCanvas = new Point(0, 0);

        private bool _IsChangedPosMouseInWorkCanvas = false;


        private void UpdateEnabledStateControls()
        {
            SelectPenColorCBox.Enabled = !_StateDrawLine;
            SelectPenWidthCBox.Enabled = !_StateDrawLine;
            DrawLineBtn.Enabled = !_StateDrawLine;
        }


        private void FillSelectPenColorCBox()
        {
            _PresetsPenColors.Add(new PenColorInfo("Синий цвет", Color.Blue));
            _PresetsPenColors.Add(new PenColorInfo("Красный цвет", Color.Red));
            _PresetsPenColors.Add(new PenColorInfo("Зеленый цвет", Color.Green));
            foreach (PenColorInfo lPCI in _PresetsPenColors)
                SelectPenColorCBox.Items.Add(lPCI.Desc);
            if(_PresetsPenColors.Count > 0) SelectPenColorCBox.SelectedIndex = 0;
        }


        private void FillSelectPenWidthCBox()
        {
            _PresetsPenWidths.Add(new PenWidthInfo("0.25 мм", 0.25F));
            _PresetsPenWidths.Add(new PenWidthInfo("0.5 мм", 0.5F));
            _PresetsPenWidths.Add(new PenWidthInfo("1.0 мм", 1F));
            _PresetsPenWidths.Add(new PenWidthInfo("2.0 мм", 2F));
            _PresetsPenWidths.Add(new PenWidthInfo("3.0 мм", 3F));
            _PresetsPenWidths.Add(new PenWidthInfo("4.0 мм", 4F));
            _PresetsPenWidths.Add(new PenWidthInfo("5.0 мм", 5F));
            foreach (PenWidthInfo lPWI in _PresetsPenWidths)
                SelectPenWidthCBox.Items.Add(lPWI.Desc);
            if (_PresetsPenWidths.Count > 0) SelectPenWidthCBox.SelectedIndex = 0;
        }


        public SuperPaint()
        {
            InitializeComponent();
            FillSelectPenColorCBox();
            FillSelectPenWidthCBox();
            this.KeyPreview = true;
            this.KeyDown += new KeyEventHandler(SuperPaint_KeyDown); 
        }


        private void SuperPaint_Load(object sender, EventArgs e)
        {
            WorkCanvas.Paint += new PaintEventHandler(this.WorkCanvas_Paint);
        }

        private void SuperPaint_KeyDown(object sender, KeyEventArgs e)
        {
            if ((e.KeyValue == (int)Keys.Z) && e.Control && _StateDrawLine)
            {
                if (_DrawLines.Last().RemoveLastVertex())
                {
                    _IsChangedPosMouseInWorkCanvas = true;
                    WorkCanvas.Invalidate();
                }
            }
        }


        private void WorkCanvas_Paint(object sender, PaintEventArgs e)
        {
            Graphics lGraphics = e.Graphics;
            lGraphics.PageUnit = GraphicsUnit.Millimeter;
            lGraphics.SmoothingMode = System.Drawing.Drawing2D.SmoothingMode.HighQuality;
            if (_DrawLines.Count > 0)
            {
                if (_StateDrawLine)
                {
                    if (_IsChangedPosMouseInWorkCanvas)
                    {
                        if (_DrawLines.Count > 1)
                        {
                            for (int i = 0; i < (_DrawLines.Count - 1); i++)
                            {
                                _DrawLines[i].Update(lGraphics);
                            }
                            _DrawLines.Last().Update(lGraphics, _LastPosMouseInWorkCanvas);
                        }
                        else
                        {
                            _DrawLines.Last().Update(lGraphics, _LastPosMouseInWorkCanvas);
                        }
                        _IsChangedPosMouseInWorkCanvas = false;
                    }
                    else
                    {
                        _DrawLines.ForEach(delegate (DrawLineInfo aItem) { aItem.Update(lGraphics); });
                    }
                }
                else
                {
                    _DrawLines.ForEach(delegate (DrawLineInfo aItem) { aItem.Update(lGraphics); });
                }
            }
        }


        private void WorkCanvas_MouseMove(object sender, MouseEventArgs e)
        {
            OutDrawCoor.Text = $"X = {e.X}; Y = {e.Y}";
            if ((Math.Abs(e.X - _LastPosMouseInWorkCanvas.X) > cToleranceDispPosMouse) ||
                (Math.Abs(e.Y - _LastPosMouseInWorkCanvas.Y) > cToleranceDispPosMouse))
            {
                _LastPosMouseInWorkCanvas = e.Location;
                _IsChangedPosMouseInWorkCanvas = true;
                WorkCanvas.Invalidate();
            }
            else _IsChangedPosMouseInWorkCanvas = false;
        }


        private void WorkCanvas_MouseLeave(object sender, EventArgs e)
        {
            OutDrawCoor.Text = null;
            _IsChangedPosMouseInWorkCanvas = false;
            if (_StateDrawLine) WorkCanvas.Invalidate();
        }


        private void DrawLineBtn_Click(object sender, EventArgs e)
        {
            _DrawLines.Add(new DrawLineInfo(
                _PresetsPenColors[SelectPenColorCBox.SelectedIndex].Color, 
                    _PresetsPenWidths[SelectPenWidthCBox.SelectedIndex].Width));
            _StateDrawLine = true;
            UpdateEnabledStateControls();
            WorkCanvas.Invalidate();
        }

        
        private void ClearWorkCanvasBtn_Click(object sender, EventArgs e)
        {
            _DrawLines.Clear();
            _StateDrawLine = false;
            UpdateEnabledStateControls();
            WorkCanvas.Invalidate();
        }


        private void WorkCanvas_MouseDown(object sender, MouseEventArgs e)
        {
            if ((e.Button == MouseButtons.Left) && _StateDrawLine)
            {
                _DrawLines.Last().AddVertex(e.Location);
                WorkCanvas.Invalidate();
            }
            if ((e.Button == MouseButtons.Right) && _StateDrawLine)
            {
                _StateDrawLine = false;
                UpdateEnabledStateControls();
            }
        }
    }

}

[Нубий-IV]

Сообщение от Сергей812 т.е. просто заново перерисовываются все линии на холсте (PicturesBox)

Все остальные линии не мигают. Мигает только последний сегмент. "Мигает" - значит, что иногда видно, как этой линии еще нет, вместо нее только серый фон, а потом она уже есть.

Когда в WinApi обрабатывается перерисовка, приходится сначала заливать форму фоном, а потом рисовать поверх линии - вот в этот момент и происходит моргание: форма то чисто белая, то на ней уже линии. А буферизация просто выводит новую картинку поверх старой, и мигания не видно, потому что оно на скрытой буферной картинке происходит, и видно только как старая картинка просто мгновенно заменяется новой.

А тут все выглядит так, будто старые линии остаются как были, а перерисовывается только последняя, потому и мигает. То есть выглядит так, как будто тут уже есть оптимизация - оптимизированы старые линии. Вот и итересно, почему не мигают старые линии? Должны или мигать все, или не мигать никто.

На словах тяжело объяснить. Разницу "мигает - не мигает " лучше видно на моих примерах, во вложении:

Пара кубиков. В меню в параметрах на современном железе надо число сторон поставить побольше, штук 20. Вращать клавишами-стрелками, или полосами прокрутки.
1. Кубик без буферизации.
2. Кубик с буферизацией.

3. Простейший калейдоскоп - загрузить картинку и двигать область в левом окне. Подсказки в заголовке, настройки в меню.

А в NET - примере старые линии рисуются, как у меня кубик версии 2, а последний сегмент - как кубик версии 1. В чем фокус?!

[Сергей812]

Сообщение от Нубий-IV А в NET - примере старые линии рисуются, как у меня кубик версии 2, а последний сегмент - как кубик версии 1. В чем фокус?!

а сейчас как?

[Нубий-IV]

Сообщение от Сергей812 а сейчас как?

А сейчас все как надо. Никто не мигает - ни старые линии, ни новые.

Кстати, гугель подсказывает, что в Net - формах из коробки поддерживается двойная буферизация. Не могу вспомнить, в старом VB (не VBA) было ли свойство DoubleBuffered у форм, или я его только где-то в Net видел?

[Сергей812]

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

просто в коде заменил private const int cToleranceDispPosMouse = 2 на нулевое значение, т.е. убрал гистерезис. А в вашем примере небыстро, конечно - наверно, не имеет смысла соревноваться с разработчиками FrameWork в быстродействии, у них явно есть больший доступ к информации по коду GDI)

----- добавлено через ~5 мин. -----
если есть сильное желание копнуть "вглубь" - исходной код того же класса Graphics, через который в моем примере проводится отрисовка линий.

[Нубий-IV]

Сообщение от Сергей812 в вашем примере небыстро

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

В NET форме есть свойство DoubleBuffered? Его можно выставить в False? Если от этого начнется мерцание, значит, NET просто автоматически делает то, что мне приходилось делать вручную. И тогда в VB тоже придется делать вручную, потому что у него нет такой фишки.

[Сергей812]

Сообщение от Нубий-IV В NET форме есть свойство DoubleBuffered? Его можно выставить в False?

есть, но оно и стоит в false по умолчанию.

[Сергей812]

вариант с включенным DoubleBuffered

[Нубий-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]

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

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