Zjištění informací o bitmapě

Postup:
' Struktura pro uložení infermací o  bitmapě
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 GetObjectAPI Lib "gdi32" Alias _
    "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, _
    lpObject As Any) As Long

' PICT je Picture property prvku PictureBox
' WIDTH, HEIGHT vrací velikost bitmapy
' COLORPLANES a BITSPERPIXELS vrací informace o rozlišení a barevné paletě 
'
' Příklad:
'    Dim wi As Long, he As Long, cp As Integer, bpp As Integer
'    GetBitmapInfo Picture1.Picture, wi, he, cp, bpp
'    Print "Šířka: " & wi
'    Print "Výška: " & he
'    Print "Počet barev: " & cp
'    Print "Rozlišení: " & bpp

Sub GetBitmapInfo(pict As StdPicture, Width As Long, Height As Long, _
    ColorPlanes As Integer, BitsPerPixel As Integer)

    Dim bmp As BITMAP
    GetObjectAPI pict, Len(bmp), bmp
    Width = bmp.bmWidth
    Height = bmp.bmHeight
    ColorPlanes = bmp.bmPlanes
    BitsPerPixel = bmp.bmBitsPixel

End Sub

Zpět

Autor: The Bozena