|
| | | |
 • IV.4 Bitmapa w formancie Image •
- 4.1 Jak uatrakcyjnić pokaz obrazków w formancie Image ?
- 4.2 Jak ograniczyć migotanie okna podformularza z formantem Image, podczas zmiany jego rozmiaru ?
- 4.3 Jak powiększać i przewijać bitmapę w formancie Image za pomocą własnych pasków przewijania ?
- 4.4 Jak zapisać plik jako binaria do tabeli w polu typu OLE lub Memo i jak pobrać z tego typu pola plik i zapisać na dysku ?
- 4.5 Jak z binariów reprezentujących plik *.jpg stworzyć w pamięci (bez zapisu na dysk) bitmapę (DIB), gotową do wstawienia do formantu Image jako img.PictureData oraz jak reskalować formant Image wraz ze zmianą rozmiaru formularza ?
- 4.6 Jak sprawdzić czy kursor myszy znajduje się nad wielokątem dowolnego kształtu ?
| | | | |
 |
| | |
|
4.1 Jak uatrakcyjnić pokaz obrazków w formancie Image ?
Nguyen Bang Giang na swojej stronie przedstawił przykład: Obrazy w Accessie - Nowy sposób prezentowania obrazów z możliwością przewijania.
Zainspirowany Jego pomysłem postanowiłem wykorzystać przykład:
Dziewięć wizualnych sposobów otwarcia formularza by uatrakcyjnić pokaz obrazków wyświetlanych w formancie Image.
ΔΔΔ | | | | |
|
|
| | |
|
4.2 Jak ograniczyć migotanie okna podformularza z formantem Image, podczas zmiany jego rozmiaru ?
<cyt>
... uwagi dotyczą przykładu: 4.1 Jak uatrakcyjnić pokaz obrazków ... ?
BraZby napisał ten program w Acc'97 i nie wiem jak tam, ale po konwersji do wyższych wersji praktycznie efekt nie istnieje, bo zakłóca go migotanie.
Bajerek w założeniu całkiem fajny, ale przez to migotanie nie da się oglądać ;-)
Trochę skrytykowałem, ale żeby to była krytyka konstruktywna, to podam prosty myk, który warto znać, bo całkowicie eliminuje to mrużenie. No i nie wymaga grama kodu...
Co to za hokus-pokus?
Otóż wystarczy ustawić jakąkolwiek (np. jednopokselową) bitmapę jako tło formularza (w tym przypadku podformularza) i migotania nie ma(!).
Formularz nie mruży, a przesuwanie odbywa sie gładko.
--
Krzysztof Pozorek
</cyt>
' Realizacja rozwiązanie Krzysztofa Pozorka:
Private Sub zbSetOnePixBmpBackground()
Dim pict(0 To 43) As Byte
pict( 0) = 40: pict( 1) = 0: pict( 2) = 0: pict( 3) = 0
pict( 4) = 1: pict( 5) = 0: pict( 6) = 0: pict( 7) = 0
pict( 8) = 1: pict( 9) = 0: pict(10) = 0: pict(11) = 0
pict(12) = 1: pict(13) = 0: pict(14) = 24: pict(15) = 0
pict(16) = 0: pict(17) = 0: pict(18) = 0: pict(19) = 0
pict(20) = 4: pict(21) = 0: pict(22) = 0: pict(23) = 0
pict(24) = 0: pict(25) = 0: pict(26) = 0: pict(27) = 0
pict(28) = 0: pict(29) = 0: pict(30) = 0: pict(31) = 0
pict(32) = 0: pict(33) = 0: pict(34) = 0: pict(35) = 0
pict(36) = 0: pict(37) = 0: pict(38) = 0: pict(39) = 0
pict(40) = 255: pict(41) = 0: pict(42) = 0: pict(43) = 0
......
' ustaw kolor piksela bitmapy sfSub na kolor sekcji Detale podformularza, czyli inaczej => ustaw bajty bitmapy (ByRef) na odpowiadające składowe RGB
Call zbColorToRGB(Me.sfSub.Form.Section(acDetail).BackColor, _
pict(42), pict(41), pict(40))
' aktualizuj tło sekcji Detale podformularza
Me.sfSub.Form.PictureData = pict()
End Sub
' jeżeli kolor wejściowy jest identyfikowany jako kolor systemowy, to funkcja zwraca kolor systemowy, w przeciwnym razie kolor wejściowy, w argumentach ByRef funkcja zwraca składowe RGB koloru wejściowego,
Public Function zbColorToRGB(ByVal lColor As Long, _
Optional bRedRet As Byte, _
Optional bGreenRet As Byte, _
Optional bBlueRet As Byte) As Long
Dim aRGB(0 To 3) As Byte
' kopiuj kolor do tablicy bajtów
CopyMemory aRGB(0), lColor, 4
If aRGB(3) = 128 Then
' może to być kolor systemowy o nIndex = aRGB(0)
lColor = GetSysColor(aRGB(0))
CopyMemory aRGB(0), lColor, 4
End If
' ustaw wartości opcjonalnych składowych RGB koloru, które są zwracane ByRef
bRedRet = aRGB(0): bGreenRet = aRGB(1): bBlueRet = aRGB(2)
' zwróć kolor wyjściowy
zbColorToRGB = lColor
End Function
' komentarz Krzysztofa Pozorka do w/w przykładu:
<cyt>
Na moim komputerze jest teraz całkowicie wygładzone.
Nie ma żadnych mrużeń pod Accessem 2003, gdzie było dotąd kiepsko.
(Swoja drogą zawarłeś ciekawy sposób na budowę bitmapy z niczego ;-)
</cyt>
ΔΔΔ | | | | |
|
|
| | |
|
4.3 Jak powiększać i przewijać bitmapę w formancie Image za pomocą własnych pasków przewijania ?
- Korzysta z klas pasków przewijania przedstawionych w przykładzie: własny pionowy i poziomy pasek przewijania
- Prawidłowo obsługuje 24-bitowe bitmapy do 40 MB wielkości. Powyżej tej wartości w niewielkim zakresie błędnie wskazywane jest powiększenie bitmapy
- Udało mi się załadować bitmapę wielkości 200 MB, którą można było w miarę prawidłowo powiększać i przewijać (dla tak dużych bitmap występują pewne nieprawidłowości w skali powiększenia).
- Skala powiększenia jest umowna: 100 odpowiada wartości powiększenia, gdy bitmapa jest widoczna w całości (Fit to Window).
ΔΔΔ | | | | |
|
|
| | |
|
4.4 Jak zapisać plik (jako binaria) do tabeli w polu typu OLE lub Memo i jak pobrać z tego typu pola plik i zapisać na dysku ?
' zapisuje plik do pola typu OLE lub Memo
Private Sub zbFileToTable(sFilePath As String, _
sTableName As String, _
sFieldName As String)
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim lLenFile As Long
Dim sBuff As String
Dim ff As Integer
lLenFile = FileLen(sFilePath)
If lLenFile = 0 Then Exit Sub
ff = FreeFile
Open sFilePath For Binary Access Read As #ff
sBuff = String(lLenFile, vbNullChar)
Get #ff, , sBuff
Close #ff
If Len(sBuff) = 0 Then Exit Sub
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset(sTableName, , dbAppendOnly)
With rst
.AddNew
.Fields(sFieldName) = sBuff
.Update
End With
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Sub
' przykładowe wywołanie:
Private Sub btnFileToTable_Click()
Dim i As Long
Dim sPath As String
' W A'97 pole "BinJpg" powinno być typu Memo
For i = 1 To 8
sPath = "C:\Images\MojPlik" & CStr(i) & ".jpg"
Call zbFileToTable(sPath, "tPict", "BinJpg")
Next
End Sub
' zapisuje plik z pola typu OLE lub Memo na dysk
Private Sub zbFileFromTable(sTableName As String, _
sFieldBinName As String, _
sFieldIndexName As String, _
lIDWhere As Long, _
sDstFilePath As String)
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sBuff As String
Dim ff As Integer
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("SELECT " & _
sFieldBinName & " FROM " & _
sTableName & " WHERE " & _
sFieldIndexName & " =" & lIDWhere)
If rst.EOF = False Then
sBuff = rst.Fields(sFieldBinName).Value
ff = FreeFile
Open sDstFilePath For Binary As ff
Put ff, , sBuff
Close #ff
End If
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Sub
' przykładowe wywołanie:
Private Sub btnFileFromTable_Click()
Dim i As Long
' zapisz 8 plików na dysk: 8 < ID < 17 ;
For i = 9 To 16
Call zbFileFromTable("tPict", "BinJpg", "ID", i, _
"C:\MojPlik_" & CStr(i) & ".jpg")
Next
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.5 Jak z binariów reprezentujących plik *.jpg stworzyć w pamięci (bez zapisu na dysk) bitmapę (DIB), gotową do wstawienia do formantu Image jako img.PictureData oraz jak reskalować formant Image wraz ze zmianą rozmiaru formularza ?
grupa: pl.comp.bazy-danych.msaccess
wątek: JPG z bazy danych
przedstawił: Hubert Dołęga, Zbigniew Bratko
• Problem stał się łatwy do rozwiązanie dopiero wtedy, gdy Hubert Dołęga przedstawił funkcję hdLoadJpgAPI (...) konwertującą binarną zawartość pola typu Ole lub Memo na obiekt IPicture. Po dostosowaniu funkcji hdLoadJpgAPI do potrzeb przykładu, dalsza konwersja IPicture na DIB poszła już prawie bezproblemowo ;-)
• Dodatkowo przedstawiono jak reskalować bitmapę w formancie Image (bez straty jakości obrazu) podczas zmiany rozmiaru formularza.
• UWAGA: Przykład wymaga odwołania do biblioteki OLE Automation zazwyczaj znajdującą się w lokalizacji: "C:\WINDOWS\SYSTEM\stdole2.tlb"
ΔΔΔ | | | | |
|
|
| | |
|
4.6 Jak sprawdzić czy kursor myszy znajduje się nad wielokątem dowolnego kształtu ?
Problem rozpoznania czy kursor myszy znajduje sie nad wielokątem dowolnego kształtu zasygnalizował Nguyen Bang Giang (w swoim powrocie) po dość długiej nieobecności na grupie Accessowej. Rozwiązanie dla trójkąta przedstawił na swojej stronie w przykładzie: Detekcja wyjścia wskaźnika myszy poza obszarem nieregularnym
Ja zacząłem sie zastanawiać, czy problemu tego nie można rozwiązać przy użyciu graficznych funkcji API.
W zasadzie metoda jest bardzo prosta:
Mając współrzędne wierzchołków w tablicy m_Poly() As POINTAPI rysujemy na bitmapie w formancie Image ten wielokąt
Call Polygon(m_hdc, m_Poly(0), m_lCount)
' i tworzymy region odpowiadający temu wielokątowi
m_hRegion = CreatePolygonRgn(m_Poly(0), m_lCount, ALTERNATE)
m_hRgnOld = SelectObject(m_hdc, m_hRegion)
i podczas ruchu myszy nad formantem Image sprawdzamy za pomocą funkcji API:
CBool(PtInRegion(m_hRegion, X, Y))
gdzie jest kursor myszy.
Jeszcze tylko trochę innych funkcji graficznych API, pędzli, piór, kontekstów itp. i efekt można oglądać w przykładzie poniżej.
ΔΔΔ | | | | |
|
| |
