• Gdzie bitmapa przechowuje wszystkie dane
Na stronie Struktura bitmapy opisałem dość dokładnie strukturę pliku bitmapy. Na samym początku pliku w 14 bajtowym nagłówku BITMAPFILEHEADER znajduje się najważniejsza, dwuznakowa sygnatura pliku 'BM' (w zapisie heksadecymalnym &H424D). Znajdziemy tam jeszcze informacje o wielkości pliku i przesunięcie (offset) do bajtów bitmapy. Pozostałe informacje, takie jak rozmiar struktury nagłówka, szerokość i wysokość bitmapy, głębia kolorów, typ kompresji, rozdzielczość pozioma i pionowa zawarte są w 40 bajtowym nagłówku BITMAPINFOHEADER. Skoro już wiemy gdzie szukać informacji dotyczących bitmapy, to możemy zacząć realizować cel, jakim jest sprawdzenie czy plik *.bmp jest nieskompresowaną bitmapą o 24-bitowej głębi kolorów.
Funkcja sprawdzająca 24-bitową bitmapę.
Przed przystąpieniem do sprawdzania właściwości bitmapy, musimy sprawdzić, za pomocą funkcji plikFileExist(...), czy plik istniej na dysku. Jeżeli plik istnieje, to proforma sprawdzamy, czy zawiera co najmniej 58 bajtów (tyle zajmuje jednopikselowa 24-bitowa bitmapa). Potem otwieramy plik do odczytu i kolejno sprawdzamy poszczególne wymagane przeze mnie atrybuty. Najpierw wczytujemy dwa pierwsze bajty i porównujemy je z sygnaturą pliku 'BM'. Następnie do zmiennej bih zadeklarowanej jako As BITMAPINFOHEADER wczytujemy 40 bajtów z pliku, począwszy od 15 bajtu (1 bajt za 14 bajtowym nagłówkiem BITMAPFILEHEADER). Pozostaje tylko sprawdzenie, czy poszczególne elementy struktury w zmiennej bih spełniają zadane warunki.
⊗ Public Function bmpIsBmp24bit(sFileBmpPath As String) As Boolean
-
'Sprawdza czy plik jest nieskompresowaną bitmapą o 24-bitowej głębi kolorów
i kierunku czytania bajtów obrazu „z dołu do góry”.
Korzystając funkcji plikFileExist(...), sprawdza, czy plik istniej na dysku. Jeżeli plik istnieje,
sprawdzana jest wielkość pliku, która nie może być mniejsza od 58 bajtów (tyle zajmuje jednopikselowa
24-bitowa bitmapa). Potem plik bitmapy otwierany jest do odczytu i dwa pierwsze bajty pliku
przypisane zostają do zmiennej iBmpSignature typu Integer, której wartość musi być równa
&H424D, co odpowiada sygnaturze 'BM'. Następnie do zmiennej bih zadeklarowanej
jako As BITMAPINFOHEADER wczytywanych jest 40 bajtów z pliku, począwszy od 15 bajtu
(1 bajt za 14 bajtowym nagłówkiem BITMAPFILEHEADER). Potem kolejno sprawdzane są elementy
struktury BITMAPINFOHEADER, które muszą spełniać zadane warunki:
- bih.biSize = 40 'nagłówek bitmapy BITMAPINFOHEADER musi być 40-bajtowy
- bih.biHeight >= 0 'bitmapa musi być „z dołu do góry”
- bih.biBitCount = 24 'bitmapa musi mieć 24 bitową głębię kolorów
- bih.biCompression = 0 'bitmapa nie może być skompresowana
- argumenty:
- sFileBmpPath
- pełna ścieżka do pliku bitmapy
- zwraca:
-
Przy powodzeniu, gdy sprawdzany plik jest nieskompresowaną bitmapą o 24-bitowej głębi kolorów o kierunku czytania bajtów obrazu „z dołu do góry”, zwraca TRUE. Przy niepowodzeniu, gdy plik nie spełnia jakiegokolwiek wymaganego warunku, funkcja generuje błąd wykonania i zwraca FALSE.
- autor: Zbigniew Bratko
- data: 04.02.2019
Option Compare Database Option Explicit Public Function bmpIsBmp24bit(sFileBmpPath As String) As Boolean Dim bih As BITMAPINFOHEADER Dim ff As Integer Dim iBmpSignature As Integer Dim lFileSize As Long Const cProcName As String = "Funkcja bmpIsBmp24bit(...)" If Not plikFileExist(sFileBmpPath) Then Err.Raise errFileNotExist, cProcName, _ errBmpDescription(errFileNotExist) End If 'sprawdź, wielkość bitmapy If FileLen(sFileBmpPath) < cBmpMinSize Then Err.Raise errBmpTooSmall, cProcName, _ errBmpDescription(errBmpTooSmall) End If 'otwórz plik i wczytaj dwa pierwsze bajty (sygnatura pliku) ff = FreeFile Open sFileBmpPath For Binary Access Read Lock Write As #ff Get #ff, , iBmpSignature If iBmpSignature <> cBmpIntSignature Then Close #ff Err.Raise errBmpFailSignature, cProcName, _ errBmpDescription(errBmpFailSignature) End If 'wczytaj nagłówek BitmapInfoHeader i zamknij plik Get ff, cBmpBfhSize + 1, bih 'bytBih() Close #ff 'sprawdź, czy nagłówek bitmapy jest 40-bajtowy If bih.biSize <> cBmpBihSize Then Err.Raise errBihFailSize, cProcName, _ errBmpDescription(errBihFailSize) End If 'sprawdź głębię kolorów If bih.biBitCount <> cBmpBitCount24 Then Err.Raise errBmpOnlyBitCount24, cProcName, _ errBmpDescription(errBmpOnlyBitCount24) End If 'sprawdź, czy bitmapa jest skompresowana If bih.biCompression <> cBmpNotCompressed Then Err.Raise errBmpIsCompressed, cProcName, _ errBmpDescription(errBmpIsCompressed) End If 'sprawdź, czy bitmapa jest "z dołu do góry" If bih.biHeight < 0 Then Err.Raise errBmpIsTopDown, cProcName, _ errBmpDescription(errBmpIsTopDown) End If bmpIsBmp24bit = True End Function
Słów kilka o stałych, zmiennych, strukturach i funkcjach.
Niby tak proste zadanie jak sprawdzenie 24-bitowej bitmapy, rozrosło się do dość pokaźnych rozmiarów. Mam zamiar kontynuować temat przetwarzania 24-bitowej bitmap w MS Access, więc jest to jedyna okazja bym uporządkował nieco funkcje i procedury operujące na bitmapach. Na początek utworzyłem kilka modułów standardowych:
- bas_apiFun - deklaracje wszystkich funkcji API
- bas_apiStruct - deklaracje wszystkich struktur API
- bas_bmpFun - własne funkcje graficzne
- bas_Const - deklaracje stałych
- bas_Err - obsługa błędów
- bas_plikiFun - własne funkcje dotyczące przetwarzania plików
i mam nadzieję, że w miarę przybywania przykładów i rozrastanie się modułów, jakoś utrzymam logiczny porządek we wszystkich utworzonych i tworzonych modułach☺
Option Compare Database Option Explicit ' 14 bajtowy nagłówek pliku bitmapy. ' Zawiera informacje o rodzaju, rozmiarze i układzie pliku bitmapy (DIB). Public Type BITMAPFILEHEADER bfType As Integer 'sygnatura BM (0x4D42) hex. &H424D bfSize As Long 'całkowity rozmiar pliku w bajtach bfReserved1 As Integer 'zarezerwowany - zazwyczaj równy ZERO bfReserved2 As Integer 'zarezerwowany - zazwyczaj równy ZERO bfOffBits As Long 'przesunięcie (w bajtach) do bajtów obrazu bitmapy End Type ' 40 bajtowy nagłówek informacyjny bitmapy. ' Zawiera dane o właściwości bitmapy i organizacja jej kolorów. Public Type BITMAPINFOHEADER biSize As Long 'rozmiar struktury biWidth As Long 'szerokość mapy bitowej w pikselach biHeight As Long 'wysokość mapy bitowej w pikselach. Dla dodatniej wartość biHeight, 'bitmapa jest typu „z dołu do góry” i jej punkt początkowy 'znajduje się w lewym dolnym rogu. Dla ujemnych biHeight 'bitmapa jest typu „z góry na dół” i jej początek 'znajduje się w lewym górnym rogu. biPlanes As Integer 'liczba warstw koloru, zawsze = 1 biBitCount As Integer 'liczba bitów koloru na jeden piksel (1,4,8,16,24,32) biCompression As Long 'typ kompresji: BI_RGB = 0 (bez kompresji), BI_RLE8, BI_RLE4, 'BI_BITFIELDS, BI_JPEG, BI_PNG biSizeImage As Long 'wielkość mapy bitowej w bajtach, jeżeli bitmapa jest 'nieskompresowana (element biCompression równy jest BI_RGB) 'wartość biSizeImage może być ustawiona na ZERO biXPelsPerMeter As Long 'rozdzielczość pozioma pixel/metr - zazwyczaj ZERO, 'wartość 2835 odpowiada rozdzielczości 72 dpi, 'wartość 11811 odpowiada rozdzielczości 300 dpi biYPelsPerMeter As Long 'rozdzielczość pionowa pixel/metr - opis jw. biClrUsed As Long 'liczba użytych kolorów (liczba pozycji w tablicy kolorów), 'dla biClrUsed=0 używana jest maksymalna ilość kolorów 'określona przez wartości pola biBitCount biClrImportant As Long 'liczba kolorów znaczących, zazwyczaj ZERO tzn. że wszystkie 'kolory są potrzebne do wyświetlenia bitmapy 'biClrUsed - dla 1-bitowych DIB = 0 lub 2 'biClrUsed - dla 4-bitowych DIB = 0 lub 16, jeżeli 2-15 to wskazuje liczbę pozycji 'w tablicy kolorów 'biClrUsed - dla 8-bitowych DIB = 0 lub 256, jeżeli 2-255 to wskazuje liczbę pozycji 'w tablicy kolorów 'biClrUsed - dla 16, 24, 32 bitowych DIB zwykle wynosi ZERO End Type
Option Compare Database Option Explicit Public Const cAccVersion2007 As Long = 12 'numer wersji MS Access 2007 '+-----------------------------------------------+ '| Const - Bitmap | '+-----------------------------------------------+ Public Const cBmpIntSignature As Integer = &H4D42 'sygnatura bitmapy "BM" jako liczba Integer Public Const cBmpSignatureBM As String = "BM" 'sygnatura bitmapy "BM" jako ciąg znaków Public Const cBmpBfhSize As Long = 14 'wielkość nagłówka BitmaFileHeader Public Const cBmpBihSize As Long = 40 'wielkość nagłówka BitmapInfoHeader Public Const cBmpOffsetToBits As Long = 54 'przesunięcie do bajtów obrazu bitmapy Public Const cBmpBitCount24 As Long = 24 'głębia kolorów - bitów na piksel Public Const cBmpBitCount32 As Long = 32 'głębia kolorów - bitów na piksel Public Const cBmpNotCompressed As Long = 0 'nieskompresowana bitmapa BI_RGB = 0& Public Const cBmpMinSize As Long = 58 'minimalny rozmiar bitmapy 24bit (14+40+4) Public Const cBmpDIBMinSize As Long = 44 'minimalny rozmiar DIB bitmapy 24bit (40+4)
Option Compare Database Option Explicit '+---------------------------------------------+ '| Errors - własna obsługa niektórych błędów | '+---------------------------------------------+ 'inny, nieprzewidziany błąd Public Const errOthUnexpected As Long = vbObjectError + 1 '----------------------------------------------------------------- 'dolna granica zakresu numerów błędów dotyczących plików Private Const errFileError As Long = vbObjectError + 100 'nazwa pliku zawiera nieprawidłowe znaki Public Const errFileBadName As Long = errFileError + 1 'plik istnieje na dysku Public Const errFileExist As Long = errFileError + 3 'plik nie istnieje na dysku Public Const errFileNotExist As Long = errFileError + 4 '-------------------------------------------------------------------- 'dolna granica zakresu numerów błędów dotyczących argumentów funkcji Private Const errArgsError As Long = vbObjectError + 200 'argument musi być tablicą Public Const errArgIsNotArray As Long = errArgsError + 1 'tablica jest niezainicjowana Public Const errArrayNotInitialized As Long = errArgsError + 2 'nieprawidłowa wartość argumentu Public Const errArgFailValue As Long = errArgsError + 3 '-------------------------------------------------------------------- 'dolna granica zakresu numerów błędów dotyczących bitmap Private Const errBmpError As Long = vbObjectError + 300 'błąd formatu pliku (nieprawidłowa sygnatura pliku) Public Const errBmpFailSignature As Long = errBmpError + 1 'błąd formatu nagłówka BitmapInfoHeader Public Const errBihFailFormat As Long = errBmpError + 2 'błąd formatu nagłówka BitmapInfoHeader Public Const errBihFailSize As Long = errBmpError + 3 'brak nagłówka BitmapInfoHeader Public Const errBihNotExist As Long = errBmpError + 4 'nagłówek musi być tablicą jednowymiarową Public Const errBihOneDimension As Long = errBmpError + 5 'obsługiwana jest tylko 24 i 32-bitowa głębia kolorów Public Const errBmpBitCount As Long = errBmpError + 6 'obsługiwana jest tylko 24 głębia kolorów Public Const errBmpOnlyBitCount24 As Long = errBmpError + 7 'obsługiwana jest tylko 24 głębia kolorów Public Const errBmpIsCompressed As Long = errBmpError + 8 'obsługiwana jest tylko bitmapa z 'dołu do góry' Public Const errBmpIsTopDown As Long = errBmpError + 9 'Plik bitmapy jest zbyt mały (min. 58 bajtów) Public Const errBmpTooSmall As Long = errBmpError + 10 'PictureData: DIB jest zbyt mały (min. 44 bajty) Public Const errBmpDibTooSmall As Long = errBmpError + 11 '-------------------------------------------------------------------- 'dolna granica zakresu numerów błędów dotyczących Właściwości Private Const errPrpError As Long = vbObjectError + 1000 'nie można ustawić właściwości „Picture Property Storage Format” '(Format przechowywania właściwości obrazów) Public Const errPropertyStorage As Long = errPrpError + 1 'nieoczekiwany błąd ustawienia właściwości Format przechowywania 'właściwości obrazów (Picture Property Storage Format)" Public Const errPropertyStorageFail As Long = errPrpError + 2 ' zwraca opis błędu własnego o numerze lErrNo Public Function errBmpDescription(lErrNo As Long) As String Dim sErrDscr As String Select Case lErrNo '------------------------- errFileError = vbObjectError + 100 Case errFileBadName sErrDscr = "Pełna nazwa pliku zawiera nieprawidłowy znak" Case errFileExist sErrDscr = "Plik docelowy istnieje." Case errFileNotExist sErrDscr = "Plik nie istnieje na dysku." '------------------------- errArgsError = vbObjectError + 200 Case errArgIsNotArray sErrDscr = "Argumentem funkcji musi być tablicą." Case errArrayNotInitialized sErrDscr = "Tablica nie jest zainicjowana." Case errArgFailValue sErrDscr = "Nieprawidłowa wartość argumentu." '------------------------- errBmpError = vbObjectError + 300 Case errBmpFailSignature sErrDscr = "Niewłaściwa sygnatura pliku bitmapy." Case errBihFailFormat sErrDscr = "Błąd formatu nagłówka BitmapInfoHeader" Case errBihFailSize sErrDscr = "Nagłówek BitmapInfoHeader musi mieć wielkość 40 bajtów""" Case errBihNotExist sErrDscr = "Niezainicjowany nagłówek BitmapInfoHeader bitmapy." Case errBihOneDimension sErrDscr = "Nagłówek BitmapInfoHeader " & _ "musi być tablicą jednowymiarową." Case errBmpBitCount sErrDscr = "Obsługiwana jest tylko bitmapa" & vbNewLine & _ "o 24 lub 32-bitowej głębi kolorów." Case errBmpOnlyBitCount24 sErrDscr = "Obsługiwana jest tylko bitmapa" & vbNewLine & _ "o 24-bitowej głębi kolorów." Case errBmpIsCompressed sErrDscr = "Bitmapa skompresowana nie jest obsługiwana." Case errBmpIsTopDown sErrDscr = "obsługiwana jest tylko bitmapa z 'dołu do góry'." Case errBmpTooSmall sErrDscr = "Plik bitmapy jest zbyt mały." & vbNewLine & _ "Minimalna wielkość to " & cBmpMinSize & " bajtów." Case errBmpDibTooSmall sErrDscr = "Tablica Image.PictureData" & vbNewLine & _ "musi zawierać minimum " & cBmpDIBMinSize & " bajtów." Case Else sErrDscr = "Nieprzewidziany błąd Aplikacji." & vbNewLine & _ "Zanotuj nr błędu i opis" & vbNewLine & _ "i skontaktuj się z Administratorem." End Select errBmpDescription = sErrDscr End Function
' Public Function plikFileExist(sFullPath As String) As Boolean
' Funkcja plikFileExist (...) sprawdza, czy w lokalizacji na którą wskazuje argument sFullPath,
' będący pełna ścieżką do pliku, znajduje się wskazany plik. Funkcja pobiera położenie pierwszego
' wystąpienie znaku ':' oraz położenie ostatniego wystąpienia znaku '\' w pełnej ścieżce
' do pliku sFullPath. Jeżeli znaki te ':' i '\' nie występują, lub gdy znak '\' znajduje się
' na końcu ścieżki funkcja kończy działanie.
' Jeżeli wszystko jest w porządku, funkcja sprawdza, począwszy od znaku po pierwszym
' wystąpieniu znaku ':', czy którykolwiek ze znaków cBadChars = ":/*?<"">|" występuje
' w pełnej ścieżce do pliku.
' Jeżeli którykolwiek nieprawidłowy znak zostaje znaleziony, funkcja generuje błąd wykonania
' informując, że w ścieżce do pliku został znaleziony nieprawidłowy znak. Następnie z pełnej
' ścieżki do pliku pobrana zostaje nazwa pliku wraz z rozszerzeniem która zostaje porównana
' z nazwą pliku jaka została zwrócona przez funkcję Dir.
' argumenty:
' sFullPath
' pełna ścieżka do pliku
'zwraca:
' Przy powodzeniu, jeżeli plik znajduje się na dysku, zwraca TRUE. Przy niepowodzeniu,
' gdy plik nie został znaleziony, lub pełna ścieżka do pliku zawiera nieprawidłowy znak,
'funkcja zwraca FALSE.
'autor: Zbigniew Bratko
'data: 04.02.2019
'
Public Function plikFileExist(sFullPath As String) As Boolean
Dim lInStr As Long
Dim lInStrRev As Long
Dim sFileName As String
Dim sBadChars() As Byte
Dim i As Integer
Const cBadChars As String = ":/*?<"">|"
Const cProcName As String = "Funkcja fileNameFileFromPath(...)"
Const cAttribFile As Long = vbNormal Or vbReadOnly Or vbHidden Or vbArchive
' pobierz położenie pierwszego wystąpienia znaku ":"
lInStr = InStr(1, sFullPath, ":", vbBinaryCompare)
' pobierz położenie ostatniego wystąpienia znaku "\"
lInStrRev = InStrRev(sFullPath, "\", -1, vbBinaryCompare)
' jeżeli nie ma znaku ";" lub "\", lub znak "\" jest na końcu ścieżki to wyjdź
If lInStr = 0 Or lInStrRev = 0 Or lInStrRev = Len(sFullPath) Then Exit Function
'przygotuj tablicę z kodami ASCII nieprawidłowych znaków
sBadChars() = StrConv(cBadChars, vbFromUnicode)
lInStr = lInStr + 1
' sprawdzaj w pętli, od znaku po pierwszym wystąpieniu ':',
' czy ścieżka pliku zawiera nieprawidłowy znak
For i = LBound(sBadChars) To UBound(sBadChars)
If InStr(lInStr, sFullPath, Chr$(sBadChars(i)), vbBinaryCompare) Then
Err.Raise errFileBadName, cProcName, _
"Pełna nazwa pliku zawiera nieprawidłowy znak [ " & Chr$(sBadChars(i)) & " ]."
End If
Next
'wyodrębnij nazwę pliku z rozszerzeniem ze ścieżki
sFileName = Mid$(sFullPath, lInStrRev + 1)
' porównaj, czy funkcja Dir zwróciła taką samą nazwę pliku sFileName
If StrComp(Dir(sFullPath, cAttribFile), sFileName, vbTextCompare) = 0 Then
plikFileExist = True
End If
End Function