На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! Правила раздела Visual Basic: Общие вопросы
Здесь обсуждаются вопросы по языку Visual Basic 1-6 (а так же по схожим языкам, как, например, PowerBASIC).
Вопросы по Visual Basic .NET (это который входит в состав Visual Studio 2002/2003/2005/2008+, для тех, кто не в курсе) обсуждаются в разделе .NET.

Обратите внимание:
1. Прежде чем начать новую тему или отправить сообщение, убедитесь, что Вы не нарушаете правил форума!
2. Обязательно воспользуйтесь поиском. Возможно, Ваш вопрос уже обсуждали. Полезные ссылки приведены ниже.
3. Темы с просьбой выполнить какую-либо работу за автора в этом разделе не обсуждаются. Студенты, вам сюда: ПОМОЩЬ СТУДЕНТАМ!
4. Используйте теги [ code=vba ] ...текст программы... [ /code ] для выделения текста программы подсветкой.
5. Помните, здесь телепатов нет. Формулируйте свой вопрос максимально грамотно и чётко: Как правильно задавать вопросы
6. Запрещено отвечать в темы месячной (и более) давности, без веских на то причин.

Полезные ссылки:
user posted image FAQ Сайта user posted image FAQ Раздела user posted image Кладовка user posted image Наши Исходники user posted image API-Guide user posted image Поиск по Разделу user posted image MSDN Library Online user posted image Google

Ваше мнение о модераторах: user posted image SCINER, user posted image B.V.
Модераторы: SCINER, B.V.
  
> IPictureDisp -> Byte() , как?
    Я в ступоре. Та к и не смог сделать сабж.
    Т.е. имея IPictureDisp с загруженой в него картинкой получить 24-х битный массив его изображения.
    Есть одно условие - загруженное в IPIctureDisp изображение может быть любой битности, т.е. 1, 4, 8, 24, 32.
    Постоянные вылеты с ошибкой доступа к памяти.
      Качни FreeImage отсюда FreeImage
      Там есть для VB6 пример и в модуле MFreeImage.bas реализованы функции работы с изображением. Сама библа FreeImage.dll на C++, но Wrapper на VB.
      По идее там есть все, что тебе нужно для рабты с картинкой.
        ExpandedWrap disabled
          Option Explicit
           
          'Written by SCINER: lenar2003@mail.ru
          '04/05/2007
          'GetDIBfromBitmap function
           
          Private Type BITMAPINFOHEADER '40 bytes
            biSize As Long
            biWidth As Long
            biHeight As Long
            biPlanes As Integer
            biBitCount As Integer
            biCompression As Long
            biSizeImage As Long
            biXPelsPerMeter As Long
            biYPelsPerMeter As Long
            biClrUsed As Long
            biClrImportant As Long
          End Type
           
          Private Type RGBQUAD
            rgbBlue As Byte
            rgbGreen As Byte
            rgbRed As Byte
            rgbReserved As Byte
          End Type
           
          Private Type BITMAPINFO
            bmiHeader As BITMAPINFOHEADER
            bmiColors As RGBQUAD
          End Type
           
          Private Type BITMAP
            bmType As Long
            bmWidth As Long
            bmHeight As Long
            bmWidthBytes As Long
            bmPlanes As Integer
            bmBitsPixel As Integer
            bmBits As Long
          End Type
           
          Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, _
          lpObject As Any) As Long
          Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
          Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
          Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
          Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _
          ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
          Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
          Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
           
          Private Function GetDIBfromBitmap(iPic As IPictureDisp, _
                                            Dib() As Byte, _
                                            Optional ByVal lWidth As Long = 0, _
                                            Optional ByVal lHeight As Long = 0) As Boolean
           
            Dim Bmp As BITMAP
            Dim dwHdc As Long, TmpDC As Long
            Dim hBmp As Long, OldBmp As Long
            Dim mem() As Byte
            Dim bminfo As BITMAPINFO
           
            Call GetObject(iPic, LenB(Bmp), Bmp)
            
            If lWidth = 0 Then lWidth = Bmp.bmWidth
            If lHeight = 0 Then lHeight = Bmp.bmHeight
            
            If (lWidth < 1) Or (lHeight < 1) Then Exit Function
           
            With bminfo.bmiHeader
              .biSize = 40
              .biPlanes = 1
              .biWidth = lWidth
              .biHeight = -lHeight
              .biBitCount = 24 'Bmp.bmBitsPixel
            End With
           
            dwHdc = CreateCompatibleDC(0)
            If dwHdc = 0 Then GoTo Fail
            hBmp = CreateCompatibleBitmap(dwHdc, lWidth, lHeight)
            OldBmp = SelectObject(dwHdc, iPic.Handle)
           
            'подгоним по размерам байтовый массив
            ReDim Dib(0 To 2, lWidth - 1, lHeight - 1)
           
            'захват изображения из пикчурбокса
            Call GetDIBits(dwHdc, iPic.Handle, 0, lHeight, Dib(0, 0, 0), bminfo, 0)
           
            Call SelectObject(dwHdc, OldBmp)
            Call DeleteObject(hBmp)
            Call DeleteDC(dwHdc)
           
            GetDIBfromBitmap = True
            Exit Function
           
          Fail:
              If hBmp <> 0 Then Call DeleteObject(hBmp)
              If dwHdc <> 0 Then Call DeleteDC(dwHdc)
            
          End Function
           
          Private Sub Form_Load()
            Dim Dib() As Byte
            Call GetDIBfromBitmap(Picture1, Dib)
            Stop
          End Sub
          SCINER ваш код не работает. Массив всегда возвращает UBound(Dib) = 2
          Мда...

          Добавлено
          Самый-самый простой код это

          ExpandedWrap disabled
            Public Function SavePictureAsByteArray(pPic As StdPicture, bArray() As Byte) As Boolean
                Dim PB As PropertyBag
                
                Set PB = New PropertyBag
                PB.WriteProperty "Pic", pPic
                
                bArray = MidB(PB.Contents, 51)
            End Function


          Но преобразовывает в BMP массив он только в EXE почему-то, я хз почему, но зато работает хотябы.
            О! не прошло и восемнадцати лет...
            0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
            0 пользователей:


            Рейтинг@Mail.ru
            [ Script execution time: 0,0268 ]   [ 16 queries used ]   [ Generated: 8.02.25, 13:34 GMT ]