| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите найти работающий код VBA функции GdipDrawString из библиотеки GDIPlus.dll

Помогите найти работающий код VBA функции GdipDrawString из библиотеки GDIPlus.dll

Ответ
Поиск в этой теме
Непрочитано 01.03.2023, 10:31 #1
Помогите найти работающий код VBA функции GdipDrawString из библиотеки GDIPlus.dll
МишаИнженер
 
Регистрация: 14.12.2008
Сообщений: 1,079

Помогите научиться выводить текст на форме с помощью функции GdipDrawString из библиотеки GDIPlus.dll
Пытаюсь запустить эту функцию, но пришел к выводу что перед этим надо создать шрифт функцией GdipCreateFont.
Может это лишнее? Какой самый простой способ запустить функцию GdipDrawString?
Код:
[Выделить все]
Public Declare PtrSafe Function GdipDrawString Lib "GdiPlus.dll" (ByVal mGraphics As LongPtr, Text As String, Length As Long, Font As Long, layoutRect As RECTF, StringFormat As Long, ByVal mBrush As LongPtr) As Status
Public Declare PtrSafe Function GdipCreateFont Lib "GdiPlus.dll" (ByVal fontFamily As Long, ByVal emSize As Single, ByVal Style As GDIPLUS_FONTSTYLE, ByVal UNIT As Long, createdfont As Long) As Long

Public Sub gText(ByVal hDC As LongPtr, ByVal Text As String, ByVal x As Double, ByVal y As Double, _
                 ByVal brushColor As Long, ByVal brushAlpha As Long, _
                 ByVal Width As Double, ByVal Height As Double)
Dim hGraphics As LongPtr, hBrush As LongPtr, lRes As Long
Dim retVal As Status

   If GdipToken <> 0 And GdipCreateFromHDC(hDC, hGraphics) = 0 Then
      If penAlpha < 0 Then penAlpha = 0
      If penAlpha > 100 Then penAlpha = 100
      If brushAlpha < 0 Then brushAlpha = 0
      If brushAlpha > 100 Then brushAlpha = 100
      lRes = GdipCreateFont(pFontFamily, FontSize, 0&, 0, hCurrentFont)
      lRes = GdipCreateSolidFill(ConvertColor(brushColor, brushAlpha), hBrush)
      retVal = GdipSetPageUnit(hGraphics, UnitPoint)
      Call GdipDrawString(hGraphics, Text, 6, 0&, rc, ByVal 0&, 0&)
   End If
End Sub
Просмотров: 1730
 
Автор темы   Непрочитано 01.03.2023, 13:33
#2
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,079


Сделал такую функцию для вывода текста:
Код:
[Выделить все]
Public Sub gText(ByVal hDC As LongPtr, ByVal Text As String, ByVal x As Double, ByVal y As Double, FontSize As Long, _
                 ByVal brushColor As Long, Optional brushAlpha As Long = 0, _
                 Optional Width As Double = 50, Optional Height As Double = 25)
'прежде чем я покажу код, нам нужно кое-что знать о рисовании текста с помощью GDIPLUS:
'1 - создайте имя шрифта с помощью GdipCreateFontFamilyFromName();
'2 - теперь мы можем создать шрифт из hFontFamily с помощью GdipCreateFont();
'3 - необходимо создать цвет текста (он может быть черным) с помощью кисти .. используя GdipCreateSolidFill();
'4 - мы должны создать прямоугольник строки. я советую использовать размер hBitmap. или DrawText() для вычисления размера строки;
'5 - теперь, когда у нас есть textcolor, графика и растровое изображение, прямоугольник строки и шрифт, мы можем нарисовать строку с помощью GdipDrawString();
'6 - не забудьте очистить все созданные ресурсы (не удаляйте растровое изображение илиграфика).
'В GDI+ сначала вы вызываете GdipNewPrivateFontCollection чтобы создать новую коллекцию шрифтов,
'затем вызовите GdipPrivateAddFontFile чтобы добавить имя файла .ttf в эту коллекцию,
'затем вызовите GdipGetFontCollectionFamilyList чтобы перечислить семейства шрифтов (например, "Font Awesome"),
'затем вызовите GdipCreateFont для определенного семейства с определенным размером шрифта.
Dim hGraphics As LongPtr, hBrush As LongPtr, lRes As Long, retVal As Status, a As Status
Dim hFontCollection As Long, hFontFamily As Long, hFont As Long, recText As RECTF, hStrFormat As Long
Dim dX1п As Double, dY1п As Double
   
   dX1п = gdDXЧ + gdXD + gdМКЧ * x
   dY1п = gdHDUf - gdDYЧ - gdYD - gdМКЧ * y
   
   If GdipToken <> 0 And GdipCreateFromHDC(hDC, hGraphics) = 0 Then
      If brushAlpha < 0 Then brushAlpha = 0
      If brushAlpha > 100 Then brushAlpha = 100
      retVal = GdipSetPageUnit(hGraphics, UnitPoint)
      
      '1)Создадим семейство шрифтов
      a = GdipNewPrivateFontCollection(hFontCollection)
      If (a <> Ok) Then
         Debug.Print "error: GdipNewPrivateFontCollection(): " & Val(a)
         Exit Sub
      End If
      
      '2)Добавим шрифт в коллекцию шрифтов
      a = GdipPrivateAddFontFile(hFontCollection, StrConv("C:\Windows\Fonts\times.ttf", vbUnicode))
      If (a <> Ok) Then
         Debug.Print "error: GdipPrivateAddFontFile(): " & Val(a)
         Exit Sub
      End If
      
      '1)Создадим семейство шрифтов
      a = GdipCreateFontFamilyFromName(StrConv("Times New Roman", vbUnicode), hFontCollection, hFontFamily) '"Times New Roman"
      If (a <> Ok) Then
         Debug.Print "error: GdipCreateFontFamilyFromName(): " & Val(a)
         Exit Sub
      End If
   
      '2)Созадим шрифт
      a = GdipCreateFont(hFontFamily, FontSize, FontStyleRegular, UnitPoint, hFont)
      If (a <> Ok) Then
         Debug.Print "error: GdipCreateFont(): " & Val(a)
         Exit Sub
      End If
      
      If GdipCreateStringFormat(0, 0, hStrFormat) = 0 Then
          GdipSetStringFormatFlags hStrFormat, StringFormatFlagsNoWrap
          GdipSetStringFormatTrimming hStrFormat, StringTrimmingEllipsisCharacter
          GdipSetStringFormatAlign hStrFormat, StringAlignmentCenter
      End If
   
      '3)Создадим цвет шрифта
      lRes = GdipCreateSolidFill(ConvertColor(brushColor, brushAlpha), hBrush)
   
      '4)Создадим прямоугольник для вывода шрифта
      recText.Left = dX1п
      recText.Top = dY1п
      recText.Width = Width
      recText.Height = Height
   
      '5)Начертим текст
      a = GdipDrawString(hGraphics, StrConv(Text, vbUnicode), Len(Text), hFont, recText, hStrFormat, hBrush)
      If (a <> Ok) Then Debug.Print "error: GdipDrawString(): " & Val(a)

      '6)Освободим ресурсы
      GdipDeleteFont hFont
      GdipDeleteFontFamily hFontFamily
      GdipDeleteBrush hBrush
      GdipDeleteGraphics hGraphics
   End If
End Sub
Но на строке "a = GdipDrawString(hGraphics, StrConv(Text, vbUnicode), Len(Text), hFont, recText, hStrFormat, hBrush)"
Excel закрывается. Почему это происходит?
МишаИнженер вне форума  
 
Непрочитано 01.03.2023, 13:33
#3
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


Offtop: все ещё уверены
Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
Пока меня все устраивает в VBA: быстро открывается, легко программировать и т.д.
?)

С одной стороны, конечно, прокачиваете навыки низкоуровневого программирования, с другой стороны - себестоимость разработки ПО стремится в небеса.
Сергей812 вне форума  
 
Автор темы   Непрочитано 01.03.2023, 15:04
#4
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,079


Что обозначает строка:
Код:
[Выделить все]
    // Все строки - в кодировке Unicode
    WCHAR welcome[]=L"Welcome, GDI+ !";
welcome[] - это значит массив? Зачем квадратные скобки?
Желающие могут попробовать функцию GdipDrawString в действии при нажатии на кнопку "Начертить конструкцию"
Только чтобы Excel сразу не "вылетал" поставьте точку останова в модуле "mod_GDIPlus" как показано на картинке.
Миниатюры
Нажмите на изображение для увеличения
Название: Точка останова.jpg
Просмотров: 20
Размер:	168.1 Кб
ID:	253773  
Вложения
Тип файла: zip Матрица (56КЭ) (v2).zip (261.2 Кб, 14 просмотров)

Последний раз редактировалось МишаИнженер, 01.03.2023 в 15:17.
МишаИнженер вне форума  
 
Непрочитано 01.03.2023, 15:09
#5
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
Что обозначает строка:
Где? И в самой строке вообще ничего не напрягает?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 01.03.2023, 15:16
#6
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,079


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Где? И в самой строке вообще ничего не напрягает?
Этот код отсюда:
Код:
[Выделить все]
void OnPaint(HDC hdc, const RECT& rc)
{
    // Все строки - в кодировке Unicode
    WCHAR welcome[]=L"Welcome, GDI+ !";

    // Создаем контекст рисования и устанавливаем 
    // пиксельную систему координат
    Graphics g(hdc);
    g.SetPageUnit(UnitPixel);
    RectF bounds(0, 0, float(rc.right), float(rc.bottom));

    // Загружаем фоновое изображение и растягиваем его на все окно
    Image bg(L"BACKGRND.gif");
    g.DrawImage(&bg, bounds);

    // Создаем кисть с градиентом на все окно и полупрозрачностью
    LinearGradientBrush brush(bounds, Color(130, 255, 0, 0), Color(255, 0, 0, 255), 
            LinearGradientModeBackwardDiagonal); 
    
    // Готовим формат и параметры шрифта
    StringFormat format;
    format.SetAlignment(StringAlignmentCenter);
    format.SetLineAlignment(StringAlignmentCenter);
    Font font(L"Arial", 48, FontStyleBold);

    // Выводим текст приветствия, длина -1 означает, 
    // что строка заканчивается нулем
    g.DrawString(welcome, -1, &font, bounds, &format, &brush);
}
Со страницы: http://rsdn.org/?article/gdi/gdiplus1.xml
МишаИнженер вне форума  
 
Непрочитано 01.03.2023, 15:24
#7
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


А тот факт, что плюсы слегка, совсем чуть-чуть, отличаются от VBA, не мешает?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 01.03.2023, 15:31
#8
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А тот факт, что плюсы слегка, совсем чуть-чуть, отличаются от VBA, не мешает?
да чуть-чуть осталось.. изучить плюсы, чтобы потом сишный код реализовать в легком и удобном VBA)
Сергей812 вне форума  
 
Автор темы   Непрочитано 01.03.2023, 17:57
#9
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,079


Из описания функции GdipDrawString на сайте Microsoft получается, что 2 параметр функции это динамический массив типа String. Размерность этого массива указывается в 3 параметре функции:
Цитата:
Status DrawString(
[in] const WCHAR *string,
[in] INT length,
[in] const Font *font,
[in, ref] const RectF &layoutRect,
[in] const StringFormat *stringFormat,
[in] const Brush *brush
);
Параметры
тип строки [in]
: const WCHAR*
Указатель на строку с широкими символами, которую нужно нарисовать.
длина [в]
Тип: INT
Целое число, определяющее количество символов в строковом массиве. Параметр length может быть установлен в значение -1, если строка завершается нулем.
Размерность массива начинается с нуля, поэтому если строка состоит из 1 символа, то длина этого массива равна -1.
А какая длина массива если в строка 2 символа: 2 или 1?
В общем декларация функции GdipDrawString в виде:
Код:
[Выделить все]
Public Declare PtrSafe Function GdipDrawString Lib "GdiPlus.dll" (ByVal hGraphics As LongPtr, Text As String, Length As LongPtr, Font As LongPtr, layoutRect As RECTF, StringFormat As LongPtr, ByVal mBrush As LongPtr) As Status
неправильная!!!
Параметр Text должен быть массивом! Поэтому правильно должно быть так:
Код:
[Выделить все]
Public Declare PtrSafe Function GdipDrawString Lib "GdiPlus.dll" (ByVal hGraphics As LongPtr, Text() As String, Length As LongPtr, Font As LongPtr, layoutRect As RECTF, StringFormat As LongPtr, ByVal mBrush As LongPtr) As Status
Но Excel все равно "вылетает". Или функцию GdipDrawString НЕЛЬЗЯ ПРАВИЛЬНО ДЕКЛАРИРОВАТЬ НА VBA и как следствие: на VBA нет способа рисовать текст на форме или есть какая то ошибка в коде VBA.
В любом случае вызывает недоумение количество кода, которое надо написать чтобы вывести простую цифру на форму!
Это придумали не для того чтобы сделать жизнь людей легче!
В этом скрыт другой замысел: сделать жизнь людям более сложной и запутанной!
МишаИнженер вне форума  
 
Непрочитано 01.03.2023, 18:11
#10
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


Потому что это VBA) В тех же .Net WinForms есть класс Graphics, который инкапсулирует поверхность рисования GDI+. В нем есть куча методов, например, нарисовать текст DrawString. Реализация этого класса составляет примерно 4500 строк, причем это не вызов самих API функций GDI+ - а обращение к внутренним классам .Net Framework. Так что у вас впереди еще долгий путь реализовать хотя бы часть этого функционала на VBA...
Сергей812 вне форума  
 
Непрочитано 03.03.2023, 15:13
1 | #11
Нубий-IV

Инженер-философ
 
Регистрация: 24.04.2019
Хабаровск
Сообщений: 1,867


Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
Но Excel все равно "вылетает"
"В программе партии был глючный указатель (с)". Добро пожаловать в мир программирования Pure C/C++!

Например, в объявлении GdipCreateFontFamilyFromName у выходного параметра hFontFamily пропущен модификатор ByRef. Без него параметр передается по значению, то есть вместо настоящего адреса переменной записывается ее значение. И функция внутри GDI+ что-то записывает по этому "как бы адресу". Если повезет - запись произойдет в чужую память, и Windows за такие фокусы прибьет программу. А если не повезет, и значение случайно преобразуется в незащищенный адрес , то GDI+ затрет что-то внутри; вылета не будет, но что именно будет бито - неизвестно: может, какая неиспользуемая область, а может, и рабочая. Такая ошибка может привести к вылету потом, когда к битой области случится запрос; догадаться, что вылет произошел из-за вызванной час назад функции с битым указателем, практически нереально. Собственно, ловить такие глюки - любимое занятие сишников.

Такая же фигня еще как минимум с GdipCreateFont/hFont.

В объявлении типа RECTF, похоже, Double с Single перепутаны.

Сколько еще таких ляпов - даже не знаю, на моем офисе x64 оно не запускается, слишком много надо править.

Но, если продолжать мучить бейсика пурсиком, вылетов будет еще море.

Тут только один совет - собрать таблицу преобразований типов, вроде <<В Си GpFontFamily** - В бейсике ByRef LongPtr>>, и проверять по три раза каждое объявление.
Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
В любом случае вызывает недоумение количество кода, которое надо написать чтобы вывести простую цифру на форму!
В чистом WinApi тоже есть вывод текста - TextOut; может быть проще, чем еще и Gdi+ подключать.
Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
Это придумали не для того чтобы сделать жизнь людей легче!
Это придумали для легкой автоматизации офиса, и бейсик такое может. А черчение по форме - это хаки, для тех, кто знает C/WinApi, бейсик тут вообще не при чем. Родной для бейсика метод - найти элемент управления, поддерживающий черчение, и в нем работать. А нет ножек - нет конфетки.
Нубий-IV вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите найти работающий код VBA функции GdipDrawString из библиотеки GDIPlus.dll

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Какой язык перспективен для инженера-конструктора с условием The_Mercy_Seat Программирование 705 17.03.2021 14:19
Помогите найти СП 31-115-2008 Открытые физкультурно-спортивные сооружения. Часть 4. Экстремальные виды спорта Aragorn Поиск литературы, чертежей, моделей и прочих материалов 2 02.12.2010 06:58
СНиП 11-10-75. Технология укладки асфальтовой смеси. Помогите найти! Maxim-t Поиск литературы, чертежей, моделей и прочих материалов 5 23.09.2010 00:11
Помогите найти чертежи православных храмов leonbka Поиск литературы, чертежей, моделей и прочих материалов 5 12.03.2010 11:31
Помогите найти библиотеки котельного оборудования..Плиззз.. ФОльга Поиск литературы, чертежей, моделей и прочих материалов 0 23.01.2008 12:01