На главную Наши проекты:
Журнал   ·   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.
Страницы: (2) [1] 2  все  ( Перейти к последнему сообщению )  
> Load Image1(i) и Image1(i).Picture.Handle
    При Load Image1(i) новые Image1(i) получают Picture.Handle такой же, как у начального Image1. Таким образом, весь массив Image1 указывает на одну картинку. Как создать массив Image1 с разными Picture.Handle, т.е. с отдельными изображениями (не в дизайнере) с зарезервированной областью данных под картинку?
      Например OleCreatePictureIndirect
      Вот примерПрикреплённый файлResizeImage.rar (12,8 Кбайт, скачиваний: 210) , там идет изменение картинки в Image, но ты можешь использовать функцию Conv для конвертации в StdPicture
      Сообщение отредактировано: TheTrik -
        можно было бы загружать картинку так Image1(i).Picture=LoadPicture(...), но не хочется вываливать файл и читать его. По сути, нужна ф-я CreatePicture(WidthPic, HeightPic, FillColor, ColorsInPixel) создающая пустышку Picture BMP.
          Цитата BlackSun @
          можно было бы загружать картинку так Image1(i).Picture=LoadPicture(...), но не хочется вываливать файл и читать его. По сути, нужна ф-я CreatePicture(WidthPic, HeightPic, FillColor, ColorsInPixel) создающая пустышку Picture BMP.

          Я тебе дал пример где можно из GDI-растра получить StdPicture, а создать GDI растр через CreateCompatibleBitmap, CreateDIBSection в сети куча примеров.
            похоже, создаётся BMP с 4-мя байтами на цвет, при копировании 3-х байтовый BMP искажается (видно, что закрашено 3/4 изображения). CopyDatBMP работает верно, т.к. если
            ExpandedWrap disabled
                   Set Image1(1).Picture = Conv(hBMP)
            заменить на
            ExpandedWrap disabled
                   Set Image1(1).Picture = Image1(0).Picture

            картинка нормальная.
            Прикреплённый файлПрикреплённый файлCreatePic.zip (2,96 Кбайт, скачиваний: 174)

            Добавлено
            и ещё, чем IPictureDisp отличается от StdPicture?
            Сообщение отредактировано: BlackSun -
              ExpandedWrap disabled
                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 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 Type RGBQUAD
                  rgbBlue As Byte
                  rgbGreen As Byte
                  rgbRed As Byte
                  rgbReserved As Byte
                End Type
                Private Type BITMAPINFOHEADER
                  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 BITMAPINFO
                  bmiHeader As BITMAPINFOHEADER
                  bmiColors As RGBQUAD
                End Type
                 
                Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc 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 GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
                 
                Private Function Conv(hBMP As Long) As StdPicture
                    Dim Pic As PicBmp
                    Dim IID_IDispatch As GUID
                    With IID_IDispatch
                       .Data1 = &H20400
                       .Data4(0) = &HC0
                       .Data4(7) = &H46
                    End With
                    With Pic
                       .Size = Len(Pic)
                       .Type = vbPicTypeBitmap
                       .hBMP = hBMP
                       .hPal = 0
                    End With
                    OleCreatePictureIndirect Pic, IID_IDispatch, 1, Conv
                End Function
                 
                Private Sub Form_Load()
                    Dim hBMP As Long, picDesc As BITMAP, BI As BITMAPINFO
                    Load Image1(1)
                    Image1(1).Move Image1(0).Left + Image1(0).Width + 60
                    Image1(1).Visible = True
                    hBMP = CreateCompatibleBitmap(Me.hdc, Image1(0).Width / Screen.TwipsPerPixelX, Image1(0).Height / Screen.TwipsPerPixelY)
                    
                    If hBMP <> 0 Then
                        GetObject Image1(0).Picture.Handle, Len(picDesc), picDesc
                        With BI.bmiHeader
                            .biSize = Len(BI.bmiHeader)
                            .biBitCount = picDesc.bmBitsPixel
                            .biHeight = picDesc.bmHeight
                            .biPlanes = picDesc.bmPlanes
                            .biWidth = picDesc.bmWidth
                        End With
                        SetDIBits Me.hdc, hBMP, 0, picDesc.bmHeight, ByVal picDesc.bmBits, BI, 0
                        Set Image1(1).Picture = Conv(hBMP)
                    End If
                 
                End Sub


              Добавлено
              Или так
              ExpandedWrap disabled
                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 Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
                Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
                Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
                Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
                Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
                 
                Private Function Conv(hBMP As Long) As StdPicture
                    Dim Pic As PicBmp
                    Dim IID_IDispatch As GUID
                    With IID_IDispatch
                       .Data1 = &H20400
                       .Data4(0) = &HC0
                       .Data4(7) = &H46
                    End With
                    With Pic
                       .Size = Len(Pic)
                       .Type = vbPicTypeBitmap
                       .hBMP = hBMP
                       .hPal = 0
                    End With
                    OleCreatePictureIndirect Pic, IID_IDispatch, 1, Conv
                End Function
                 
                Private Sub Form_Load()
                    Dim hBMP As Long, DC As Long, obmp As Long, ip As IPicture
                    Load Image1(1)
                    Image1(1).Move Image1(0).Left + Image1(0).Width + 60
                    Image1(1).Visible = True
                    hBMP = CreateCompatibleBitmap(Me.hdc, Image1(0).Width / Screen.TwipsPerPixelX, Image1(0).Height / Screen.TwipsPerPixelY)
                    If hBMP <> 0 Then
                        Set ip = Image1(0).Picture
                        DC = CreateCompatibleDC(Me.hdc)
                        obmp = SelectObject(DC, hBMP)
                        ip.Render DC, 0, 0, Image1(0).Width / Screen.TwipsPerPixelX, Image1(0).Height / Screen.TwipsPerPixelY, _
                                     0, Image1(0).Picture.Height, Image1(0).Picture.Width, -Image1(0).Picture.Height, ByVal 0&
                        SelectObject DC, obmp
                        DeleteDC DC
                        Set Image1(1).Picture = Conv(hBMP)
                    End If
                 
                End Sub
                не пойму, вынес первый вариант в ф-ю и увеличился размер картинки на выходе.
                ExpandedWrap disabled
                  Private Function CopyPicBMP(hDC As Long, PicSource As StdPicture) As StdPicture
                  Dim hBMP As Long, picDesc As BITMAP, BI As BITMAPINFO
                      hBMP = CreateCompatibleBitmap(hDC, PicSource.Width / Screen.TwipsPerPixelX, PicSource.Height / Screen.TwipsPerPixelY)
                      If hBMP <> 0 Then
                          GetObject PicSource.Handle, Len(picDesc), picDesc
                          With BI.bmiHeader
                              .biSize = Len(BI.bmiHeader)
                              .biBitCount = picDesc.bmBitsPixel
                              .biHeight = picDesc.bmHeight
                              .biPlanes = picDesc.bmPlanes
                              .biWidth = picDesc.bmWidth
                          End With
                          SetDIBits hDC, hBMP, 0, picDesc.bmHeight, ByVal picDesc.bmBits, BI, 0
                          Set CopyPicBMP = Conv(hBMP)
                      End If
                  End Function
                  PicSource.Width и PicSource.Height у тебя не Twip, а Himetric. Делай так
                  ExpandedWrap disabled
                    ScaleX(PicSource.Width,vbHimetric,vbPixels)
                  Аналогично по высоте
                    но ведь результат вычисления преобразуется в Long

                    Добавлено
                    понял, с какого-то перепугу меняется их значение по другой системе
                    Сообщение отредактировано: BlackSun -
                      Это разные системы координат, как сантиметры и дюймы
                        понятно, что разные. Значит, значения преобразуются при передаче объекта в функцию? А чем IPictureDisp отличается от StdPicture?

                        Добавлено
                        после
                        ExpandedWrap disabled
                                  Set Image1(1).Picture = Conv(hBMP)
                        пишу для теста
                        ExpandedWrap disabled
                                  CopyDatBMP Image1(0).Picture, Image1(1).Picture

                        получаю мусор в картинке. Значит, структура заголовка BMP в Image1(0).Picture отлична от структуры в Image1(1).Picture...
                        Сообщение отредактировано: BlackSun -
                          Цитата
                          А чем IPictureDisp отличается от StdPicture?
                          StdPicture - CoClass (компонентный класс), ты можешь создать объект StdPicture (например Set Z = New StdPicture), он реализует два интерфейса IPicture и Picture. С помощью них можно получить дополнительные свойства и методы объекта StdPicture.

                          Добавлено
                          Цитата
                          получаю мусор в картинке. Значит, структура заголовка BMP в Image1(0).Picture отлична от структуры в Image1(1).Picture...
                          Да, у тебя создается картинка совместимая с контекстом, обычно это 32bpp, а исходная у тебя 24bpp. Если ты хочешь идентичные рисунки, то делай через CreateBitmap или CreateDIBSection и задавай нужное количество бит на канал.
                            не работает
                            ExpandedWrap disabled
                              Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
                               
                              Private Function CopyPicBMP(PicSource As StdPicture, WidthPic As Long, HeightPic As Long, BitsInColor As Long) As StdPicture
                              Dim hBMP As Long
                                  hBMP = CreateBitmap(WidthPic, HeightPic, 1, BitsInColor, PicSource.Handle)
                                  If hBMP <> 0 Then
                                      Set CopyPicBMP = Conv(hBMP)
                                  End If
                              End Function
                              Ну правильно, ты пустую картинку конвертируешь.
                                CreateBitmap принимает пустой массив под буфер или массив заполненных данных BMP?

                                Добавлено
                                Заполнил внешний массив, должен быть белый цвет. Ничего.
                                ExpandedWrap disabled
                                  Dim i As Long
                                  For i = 1 To UBound(bArr)
                                   bArr(i) = 255
                                  Next
                                      hBMP = CreateBitmap(WidthPic, HeightPic, 1, BitsInColor, bArr(1))
                                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                                0 пользователей:


                                Рейтинг@Mail.ru
                                [ Script execution time: 0,0452 ]   [ 19 queries used ]   [ Generated: 4.12.22, 19:30 GMT ]