Форум программистов, компьютерный форум, киберфорум
The trick
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  

LoadPictureEx

Запись от The trick размещена 16.12.2013 в 17:39
Показов 3307 Комментарии 0
Метки vb

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
 ' © Кривоус Анатолий Анатольевич (The trick), 2013
Option Explicit
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Type PicBmp
    size As Long
    Type As Long
    hBmp As Long
    hpal As Long
    Reserved As Long
End Type
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type
 
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal FileName As Long, BITMAP As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal BITMAP As Long, hbmReturn As Long, ByVal background 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
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
 
Public Function LoadPictureEx(FileName As String) As StdPicture
    Dim Pic As PicBmp
    Dim IPic As IPicture
    Dim IID_IDispatch As GUID
    Dim SI As GdiplusStartupInput
    Dim token As Long
    Dim bmp As Long
    Dim hBmp As Long
    
    SI.GdiplusVersion = 1
    
    If GdiplusStartup(token, SI) Then Exit Function
    If GdipCreateBitmapFromFile(StrPtr(FileName), bmp) = 0 Then
        If GdipCreateHBITMAPFromBitmap(bmp, hBmp, vbBlack) = 0 Then
            GdipDisposeImage (bmp)
        End If
        GdiplusShutdown token
    Else
        GdiplusShutdown token
    End If
    
    With IID_IDispatch
       .Data1 = &H20400
       .Data4(0) = &HC0
       .Data4(7) = &H46
    End With
    With Pic
       .size = Len(Pic)          ' Length of structure.
       .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).
       .hBmp = hBmp              ' Handle to bitmap.
       .hpal = 0
    End With
    
    OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic
    
    Set LoadPictureEx = IPic
End Function
Только для картинок с палитрой, надо будет доработать код.
Использование:
Visual Basic
1
2
3
    Dim P As StdPicture
    Set P = LoadPictureEx("Имя файла")
    Me.PaintPicture P, 0, 0
Только это без прозрачности
Метки vb
Размещено в Без категории
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Всего комментариев 0
Комментарии
 
Новые блоги и статьи
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ"
Adler 06.10.2026
Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .
ИИ не может найти нужный язык в списке
Supersumestria 05.10.2026
Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .
Новая последняя моя музыка в SUNO
zorxor 05.10.2026
Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .
Программный домашний кинотеатр
russiannick 27.09.2026
Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого
zorxor 21.09.2026
Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .
Мобильное приложение ColorStep
pavlinmavlin 17.09.2026
Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .
Запрет дублирования строк в табличной части
Maks 13.09.2026
Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр.
Jin X 06.09.2026
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru