Access

  MS Access 2010+  |  Bitmapa *.bmp  |   VBA 7.0

• Memory Device Context - pamięciowy kontekst urządzenia.

GDI - kontekst pamięciowy Przykład bmpMalowaniePoEkranie pokazuje, że malowanie w kontekście okna Windows w środowisku VBA, do niczego dobrego i trwałego nie prowadzi. Spróbuję utworzyć tzw. pamięciowy kontekst urządzenia (DC), przekazując jako wzorzec dowolny, istniejący kontekst urządzenia (w tym wypadku będzie to kontekst ekranu). Użyję do tego celu funkcji API CreateCompatibleDC (hdc), która tworzy kompatybilny pamięciowy kontekst urządzenia (DC) zgodny z kontekstem urządzenia o przekazanym uchwycie hdc. Do uzyskanego kontekstu, załaduję z zasobów dyskowych, za pomocą funkcji LoadImage(...) przykładową, 24 bitową, nieskompresowaną bitmapę.

Struktura BITMAP - 24 bajtowa struktura informacyjna bitmapy

Praktycznie mógłbym rozpocząć malowanie po bitmapie, ponieważ wiem jakie podstawowe właściwości ma załadowana bitmapa. Ale nie zawsze tak będzie, więc przed przystąpieniem do malowania po bitmapie pobiorę najistotniejsze dane bitmapy za pomocą funkcji GetObject(...) do zdefiniowanej poniżej struktury BITMAP.

Public Type BITMAP
	bmType         As Long        'typ bitmapy, musi być równy Zero
	bmWidth        As Long        'szerokość bitmapy w pikselach, musi być większa od Zera
	bmHeight       As Long        'wysokość bitmapy w pikselach, musi być większa od Zera
	bmWidthBytes   As Long        'określa liczbę bajtów w każdej linii skanowania. Wartość ta musi 
                                'być liczbą parzystą, gdyż długość linii jest dopełniana do "słowa"
	bmPlanes       As Integer     'liczba warstw koloru
	bmBitsPixel    As Integer     'liczba bitów koloru na jeden piksel (głębia kolorów)
	bmBits         As Long        'wskaźnik do tablicy bajtów obrazu bitmapy
End Type

Operacje graficzne na pamięciowym kontekście urządzenia.

Aby móc wykonywać operację graficzne na bitmapie, uaktywnię ją w roboczym kontekście urządzenia, używając funkcji SelectObject(...), która zwróci mi uchwyt wcześniej aktywnej bitmapy. Bitmapa jest już uaktywniona, mogę więc wykonywać dowolne operacje graficzne na mojej bitmapie. Tak jak w przykładzie bmpMalowaniePoEkranie namaluję na bitmapie, w jej lewym górnym rogu, zielony kwadrat o wymiarach 100 x 100 pikseli. Nie będę sprawdzał wymiarów bitmapy .bmWidth i .bmHeight, czy są większe od 100, ponieważ jest to testowa bitmapa i znam jej dokładne wymiary. Do malowania użyję najprostszej (ale i bardzo wolnej) funkcji SetPixel(...).

Option Compare Database
Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" ( _
          ByVal hdc As LongPtr) As LongPtr
  Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" ( _
          ByVal hInst As LongPtr, _
          ByVal lpszName As String, _
          ByVal uType As Long, _
          ByVal cxDesired As Long, _
          ByVal cyDesired As Long, _
          ByVal fuLoad As Long) As LongPtr
  Private Declare PtrSafe Function GetObject _
          Lib "gdi32" Alias "GetObjectA" ( _
          ByVal hObject As LongPtr, _
          ByVal nCount As Long, _
          ByRef lpObject As Any) As Long
  Private Declare PtrSafe Function SelectObject _
          Lib "gdi32" ( _
          ByVal hdc As LongPtr, _
          ByVal hObject As LongPtr) As LongPtr
  Private Declare PtrSafe Function SetPixel Lib "gdi32" ( _
          ByVal hdc As LongPtr, _
          ByVal x As Long, _
          ByVal y As Long, _
          ByVal crColor As Long) As Long
  Private Declare PtrSafe Function DeleteObject Lib "gdi32" ( _
          ByVal hObject As LongPtr) As Long
  Private Declare PtrSafe Function DeleteDC Lib "gdi32" ( _
          ByVal hdc As LongPtr) As Long
  Private Type BITMAP
     bmType         As Long
     bmWidth        As Long
     bmHeight       As Long
     bmWidthBytes   As Long
     bmPlanes       As Integer
     bmBitsPixel    As Integer
     bmBits         As LongPtr
  End Type
#Else
  Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
          ByVal hdc As Long) As Long
  Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" ( _
          ByVal hInst As Long, _
          ByVal lpszName As String, _
          ByVal uType As Long, _
          ByVal cxDesired As Long, _
          ByVal cyDesired As Long, _
          ByVal fuLoad As Long) As Long
  Private Declare Function GetObject _
          Lib "gdi32" Alias "GetObjectA" ( _
          ByVal hObject As Long, _
          ByVal nCount As Long, _
          ByRef lpObject As Any) As Long
  Private Declare Function SelectObject _
          Lib "gdi32" ( _
          ByVal hdc As Long, _
          ByVal hObject As Long) As Long
  Private Declare Function SetPixel Lib "gdi32" ( _
          ByVal hdc As Long, _
          ByVal x As Long, _
          ByVal y As Long, _
          ByVal crColor 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 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
#End If

Private Const IMAGE_BITMAP = 0        ' załadowana powinna być bitmapa.
Private Const IMAGE_ICON = 1          ' załadowana powinna być ikona.
Private Const IMAGE_CURSOR = 2        ' załadowany powinien być kursor.
Private Const LR_LOADFROMFILE = &H10  ' załaduj z pliku

Public Sub bmpMalowaniePoBitmapie()
#If VBA7 Then
  Dim hdc         As LongPtr
  Dim hBitmap     As LongPtr
  Dim hBitmapOld  As LongPtr
#Else
  Dim hdc         As Long
  Dim hBitmap     As Long
  Dim hBitmapOld  As Long
#End If
Dim bmBMP         As BITMAP
Dim sPath         As String
Dim x             As Long
Dim y             As Long
Dim lRet          As Long

	' będziemy pracowali na bitmapie MojaBitmapa.bmp w folderze bazy
	sPath = Application.CurrentProject.Path & "\MojaBitmapa.bmp"

	' utwórz kompatybilny kontekst urządzenia z ekranem
	hdc = CreateCompatibleDC(0)
	' załaduj bitmapę z zasobów dyskowych
	hBitmap = LoadImage(hdc, sPath, IMAGE_BITMAP, 0&, 0&, LR_LOADFROMFILE)

	' pobierz informacje o załadowanej bitmapie do struktury BITMAP
	lRet = GetObject(hBitmap, LenB(bmBMP), bmBMP)

	' wyświetl pobrane właściwości bitmapy
	With bmBMP
		Debug.Print "bmType", .bmType
		Debug.Print "bmWidth", .bmWidth
		Debug.Print "bmHeight", .bmHeight
		Debug.Print "bmWidthBytes", .bmWidthBytes
		Debug.Print "bmPlanes", .bmPlanes
		Debug.Print "bmBitsPixel", .bmBitsPixel
		Debug.Print "bmBits", .bmBits
	End With

	' by wykonywać jakiekolwiek operacje na załadowanej bitmapie,
	' musimy ją wcześniej uaktywnić w kontekście urządzenia
	hBitmapOld = SelectObject(hdc, hBitmap)

	' namaluj w górnym lewym rogu bitmapy zielony kwadrat o wym. 100 x 100 pikseli
	For x = 0 To 100
		For y = 0 To 100
			 lRet = SetPixel(hdc, x, y, vbGreen)
		Next
	Next

	' Na tym etapie kończę przetwarzanie testowej bitmapy. Pozostało tylko
	' usunięcie (zwolnienie) z pamięci wszystkich niepotrzebnych obiektów

	' uaktywnij poprzednio aktywną bitmapę
	hBitmapOld = SelectObject(hdc, hBitmapOld)
	' usuń już nieaktywną bitmapę
	lRet = DeleteObject(hBitmap)
	' usuń utworzony kontekst urządzenia
	lRet = DeleteDC(hdc)
 
End Function
Struktura BITMAP

Dane w strukturze BITMAP

Kilka uwag o procedurze bmpMalowaniePoBitmapie()

Po zakończeniu wykonywania operacji graficznych, powinienem przetworzoną bitmapę wyświetlić w formancie Image Me.imgObrazek oraz zapisać na dysk w postaci bitmapy. By to zrobić, powinienem przekonwertować bitmapę o uchwycie hBitmap która została utworzona w kontekście urządzenia hdc na tablicę bajtów obrazu Image.PictureData. Niestety, nie będzie tak łatwo. W tym konkretnym przypadku przetwarzana bitmapa jest bitmapą 32-bitową, ponieważ kompatybilny kontekst urządzenia (w tym wypadku mój ekran) ma 32-bitowa głębię kolorów. Przy takiej głębi każdy piksel opisany jest przez 4 bajty. Konieczne by było napisanie funkcji konwertującej bitmapę 32-bit na bitmapę 24-bit. Dodatkowym utrudnieniem jest nowa właściwość w Access 2007+, a mianowicie „Picture Property Storage Format” („Format przechowywania właściwości obrazów”). Więcej szczegółów o tej właściwości można znaleźć na stronie Image.PictureData

Ja ograniczam się tylko do bitmap 24-bitowych (3 bajty na piksel). więc tym problemem nie będę się zajmował.