Задача, получить в Image1 рисунок Checkbox-a

[Avtopic]

Здравствуйте!
Моя задача получить в Image1 рисунок Checkbox-a в состоянии Checked. В прикрепленном файле то, что я смог сделать с помощью API.
(Не буду делать вид, что очень понимаю, что там к чему, но кое-что понимаю.)
Все это слишком длинный и много (код) для такой маленькой цели.
Вопрос такой: как получить вышеуказанные рисунки проще, допустим, может, кто знает, как положит в Image “Face” ID=220 (Это Checkbox), или какой не будь другой вариант.
Все это происходит в VBA Excel. Пуст, задача не удивляет. Ну, очень нужно…
Спасибо заранее!

[GSerg]

Во-первых. Я в шоке, я никогда такого не видел, и вообще не знал, что можно так

Во-вторых... Это у тебя ThunderDFrame. А в моём экселе - ThunderXFrame. А что будет в следующем, я не знаю.

И в-третьих... http://bbs.vbstreets.ru/viewtopic.php?p=6581282#6581282

[Avtopic]

Ой, я забил этот ThunderDFrame удалить из кода.

И

Код: Выделить всё

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

тоже лишнее.

Я их вставил, чтобы вставить hForm в hDCMemory = CreateCompatibleDC(hForm) но, в VBA почему-то не работает, а потом нашел в хелпе

· hForm
Identifies the device context. If this handle is NULL, the function creates a memory device context compatible with the application’s current screen.

И когда вместо hForm передал 0, заработал в VBA.

Это я для вас пишу, для меня это пака китайский…
За ссылку спасибо. Пока не смотрел, но если Gserg дает ссылку то это стопроцентно.

[Avtopic]

Как только увидел в коде Me.AutoRedraw = True и разговор идет про VB, понял что это не будет работать.

Таких примеров нашел много, но не работает в VBA. в VB работает, а VBA нет
Добавил туда hForm = GetDC(hForm) чтобы получить Me.hDC но ничего не получилось
Только догадки: В маем примере передаю готовый рисунок, а в вашем попытка рисовать. Сколько искал не нашел чтоб в VBA кто-то смог рисовать...

[GSerg]

Блин, я фигею...
Чел... копипастить код - занятие малопродуктивное.

У тебя в коде две части. Рисование и создание stdpicture. Почему бы тебе не выкинуть своё рисование и не вставить моё, сохранив остальное?

[Igor_123]

а... это ...

Код: Выделить всё

Sub Макрос3()
'
' Макрос3 Макрос
' Макрос записан 13.02.2006 (Igor)
'

'
Dim o As CommandBarButton

Set o = Application.CommandBars("Visual Basic").Controls.Add(Type:=msoControlButton, _
        ID:=220, Before:=8)
SavePicture o.Picture, "c:\1.bmp"
End Sub

и там файл 1.бмп, а в нем рисунок Checkbox-a
Только "Как художник, художнику" (С) И. Угольников
а к чему такая проктология??? объясните нам

[GSerg]

Да так... работает быстрее в разы и панель не дёргается... мне нравится...

[Avtopic]

To GSerg
Блин, я фигею
понял…

копипастить код...
не понял…

занятие малопродуктивное…
не согласен…

Почему бы тебе не выкинуть своё рисование
согласен…

и не вставить моё, сохранив остальное?
не понял…, вернее не знаю как, но поиски продолжаются.
А если серьезно, злится не надо.

Какое значение имеет, как я его там нарисую-Ну не стоит этот маленький квадратик так много Declare Function-s в коде.
Ищу решение попроще.
Точно помню, встречал на форумах, где-то, Image-у передавали рисунок после CopyFace…

To Igor_123
к чему такая проктология??? объясните нам

Объясняю:
Имею свой класс. Динамический добавляет FlexGrid, textbox, combobox, и Image.
Методами этого класса в FlexGrid можно вводить, Копировать области, соответственно вставлять в другое место, колонки имеют тип данных и т.д. Один из типов колонки ест- Yes/NO (“Boolean”).
Так вот если Yes CellPicture = Image_Checked.Picture
а если NO то CellPicture = Image_UnCheck.Picture
я не хочу чтобы, используя этот класс мне нужно било таскать вместе с ним еще два bmp файла, и при добавлении нового объекта
внутри же рисуется вышеуказанные рисунки. К стати все классно работает, если б не упомянутая вами, “проктология” в коде. И выше, как раз этот ID=220 тоже упоминал. И если б ваш "о" (CommandBarButton) имел бы свойство Picture, вместо
SavePicture o.Picture, "c:\1.bmp"
я бы написал
Image1.Picture = o.Picture
И бил бы счастлив, но в маем Excele Vba не видит этого свойство.

[GSerg]

копипастить код...
не понял…

Это когда взял целиком и ткнул F5... Не надо так...

занятие малопродуктивное…
не согласен…

Ну почему же...

и не вставить моё, сохранив остальное?
не понял…, вернее не знаю как, но поиски продолжаются.
А если серьезно, злится не надо.

Да, какой-то я злой в последнее время

Код: Выделить всё

Option Explicit

Private Declare Function LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As Any, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 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 Const OBM_CHECK As Long = 32760
Private Const IMAGE_BITMAP As Long = 0

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 Sub Form_Load()
  Dim Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID
  Dim hBmp As Long
 
  hBmp = LoadImage(0, OBM_CHECK, IMAGE_BITMAP, 0, 0, 0)

  IID_IDispatch.Data1 = &H20400
  IID_IDispatch.Data4(0) = &HC0
  IID_IDispatch.Data4(7) = &H46

  Pic.Type = 1 ' Type of Picture (bitmap)
  Pic.hBmp = hBmp ' Handle to bitmap
  'Create the picture

  OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic
 
  Set Me.Iamge1.Picture = IPic
End Sub

И бил бы счастлив, но в маем Excele Vba не видит этого свойство.

Это не всегда значит, что его нет... но сейчас вроде точно нет...

[Avtopic]

А, я понял
Копипастить=Copy&Paste
Сразу не понял, наверно потому что Excel у меня Английский

Клянусь, я не Копипастил. я взял пример "Stretch Desktop Picture” из Api-Guid 3.7 и оттуда выкинул по моим подсчетам аж 50% кода. Правда, руки чуть-чуть дрожали

Спасибо!

[Igor_123]

Те-же рисунки можно положить в ресурсы и брать оттуда по мере необходимости. Или в ImageList.
А как быть с пользовательскими типами данных?

Посмотри это http://www.rsdn.ru/article/files/components/PGXP.xml может будет интересно