 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Dusky_Joe
Anmeldungsdatum: 07.01.2005
Beiträge: 1007
Wohnort: Regensburg/Oberpfalz
|
 Verfasst am: 19.11.2006, 00:02 Titel: Bitmap aus aus Ressourcen Laden |
 |
|
Hallo Leute!
Über eine RC-Datei habe ich eine Bitmap in mein Programm 'eingebaut'. Jetzt
möchte ich diese in meinem Programm anzeigen. Vorzugsweise suche ich nach einer
Methode, die die Pixeldaten in ein Format bringt, mit dem PUT umgehen kann.
Bis jetzt habe ich den Handle zur Bitmap sowie die komplett ausgefüllte BITMAP-
Struktur, nur eben ohne den für mich eigentlich entscheidenden Record bmBits.
| win32.hlp hat Folgendes geschrieben: | | If hgdiobj identifies a bitmap created by any other means, GetObject returns only the width, height, and color format information of the bitmap. You can obtain the bitmap’s bit values by calling the GetDIBits or GetBitmapBits function. |
Derzeit sieht mein Programm so aus:
| Code: | #Include "windows.bi"
#Define RID_BMP 1000
Screen 14, 32
Dim As Any Ptr hBmp
Dim As Bitmap sBmp
hBmp = LoadBitmap( GetModuleHandle(NULL), Cast(ZString Ptr, RID_BMP) )
GetObject hBmp, 320 * 240 + 24, @sBmp
'' Das bild hat die Ausmaße 320x240, die zusätzlichen 24 Bytes an dieser Stelle
'' sind für den BITMAP-Strukturheader.
? sBmp.bmType
? sBmp.bmWidth
? sBmp.bmHeight
? sBmp.bmWidthBytes
? sBmp.bmPlanes
? sBmp.bmBitsPixel
? sBmp.bmBits
DeleteObject hBmp
GetKey |
Die entsprechende RC-Datei sieht folgendermaßen aus:
| Code: | #define RID_BMP 1000
RID_BMP BITMAP DISCARDABLE "D:/BASIC/freeBASIC/Projekte/Test.bmp" |
Die win32.hlp verweist auf die Funktion GetDIBits, mit der ich allderdings nicht
umgehen kann.
Ich bedanke mich schon jetzt für euere Hilfe!
Have a nice day
Ciao
_________________
fully biological degradable
Once, the big wave arrives, you've got two ways, you can go:
Either, you ride it, or you don't do.
But, if you don't ride, you'll never know wether you'd have gone wet. |
|
| Nach oben |
|
 |
Dusky_Joe
Anmeldungsdatum: 07.01.2005
Beiträge: 1007
Wohnort: Regensburg/Oberpfalz
|
| Verfasst am: 25.11.2006, 00:14 Titel: |
|
|
Hallo Leute!
Inzwischen habe ich das oben angesprochene Problem selbst lösen können.
Folgender Code ist dabei entstanden, vielleicht kann ihn ja jemand gebrauchen.
Leider funktioniert der Code bis jetzt nur mit Bildern, deren Breite durch vier Teilbar ist; ich muss mich mit dem padding noch genauer auseinander setzen...
However, der Code kann in eine seperate Datei gespeichert werden, und per INCLUDE eingebunden werden, das ist getestet 
Natürlich kann man sich den ersten Teil (bis END EXTERN) auch sparen, und durch das gewohnte #INCLUDE "windows.bi" ersetzen. In meinem Fall war das aber nicht möglich, da ich eine andere Include verwenden wollte, die aufgrund verschiedener Deklarationen nicht mit der windows.bi kompatibel ist...
Für die, die auf ähnliche Probleme stoßen, trotzdem aber Resourcen nutzen wollen...
Have fun with it!
| Code: | Extern "windows" Lib "kernel32"
Declare Function GetModuleHandle Alias "GetModuleHandleW" (ByVal ModuleName As WString Ptr ) As UInteger
Declare Function FindResource Alias "FindResourceW" (Byval hModule As Integer, Byval lpName As WString Ptr, Byval lpType As WString Ptr) As UInteger
Declare Function LoadResource (ByVal hModule As Integer, ByVal hResInfo As Integer ) As Any Ptr
#Define RT_BITMAP (Cast( WString Ptr, 2 ))
#Define Null Byval 0
Type BitMap
bmType As Integer
bmWidth As Integer
bmHeight As Integer
bmWidthBytes As Integer
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Any Ptr
End Type
End Extern
'----------------------------'
Declare Function GetBMP32fromRes ( ID As WString Ptr ) As Any Ptr
'............................'
#Define BID_Splash (Cast( Any Ptr, 1000 ))
Dim As Byte Ptr pPic
Screen 14, 32
pPic = GetBMP32fromRes ( BID_Splash )
If pPic Then Put (0, 0), pPic
ImgageDestroy pPic
GetKey
'............................'
Function GetBmp32fromRes ( ID As WString Ptr ) As Any Ptr
Dim As UInteger hMod, hRes
Dim As Any Ptr pRes, pPic
Dim As BITMAP PTR pBmp
Dim As UInteger pX, pY, pS
Dim As UInteger x, y, i, c, m
Dim As Ubyte r, g, b
hMod = GetModuleHandle( Null )
hRes = FindResource ( hMod, ID, RT_BITMAP )
pRes = LoadResource ( hMod, hRes )
pBmp = pRes
pX = pBmp->bmWidth
pY = pBmp->bmHeight
pPic = ImageCreate(pX, pY)
For x = 0 To pX - 1
For y = 0 To pY - 1
i = x + y * pX
b = Peek( UByte, pRes + i * 3 + 40 )
g = Peek( UByte, pRes + i * 3 + 41 )
r = Peek( UByte, pRes + i * 3 + 42 )
c = RGBA( r, g, b, 255 )
Poke UInteger, pPic + 32 + (pY - 1 - y) * pX * 4 + x * 4, c
Next
Next
Return pPic
End Function |
_________________
fully biological degradable
Once, the big wave arrives, you've got two ways, you can go:
Either, you ride it, or you don't do.
But, if you don't ride, you'll never know wether you'd have gone wet. |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 25.11.2006, 16:32 Titel: |
|
|
Hi Dusky,
ich hatte schon mit deinem ersten Progschnipsel rumgespielt, war aber zu keinem Ergebnis gekommen.
Dein 2. Prog bekomm ich auf WinME nicht lauffähig??
Aber mit FindResource und LoadResource klappt es so:
| Code: | #include "windows.bi"
#Define Mein_BMP "#1000"
Dim lpRes As BITMAPINFO Ptr
Dim As Integer Ptr image
Type RGB32 Field = 1
As Byte b,g,r,a
End Type
Dim As RGB32 Ptr imgDest
Dim As Byte Ptr resSource
Dim As Integer picsize, zeile, breite, hoehe, x, y, offs
Screen 14,32
'Pointer auf BITMAP
lpRes = LockResource(LoadResource(0, FindResource(0, Mein_BMP, RT_BITMAP)))
If lpRes = 0 Then
?"BITMAP nicht gefunden"
Sleep: End -1
Else
picsize = lpRes->bmiHeader.biSizeImage \3'da 24bpp (3Byte pro Pixel)
breite = lpRes->bmiHeader.biWidth 'Breite
hoehe = lpRes->bmiHeader.biHeight 'Höhe
If picsize = breite * hoehe Then 'ist wirklich 24bpp
image = ImageCreate(breite, hoehe)
offs = lpRes->bmiHeader.biSize 'Bitmap-Header-Offset
zeile = breite * (hoehe-1) '.bmp beginnt mit letzter Zeile
resSource = Cptr(Byte Ptr, lpRes)
imgDest = Cptr(RGB32 Ptr, image) + Iif(image[0]=7,8,1)'FB0.17?
For y = 0 To hoehe-1
For x = 0 To breite-1
imgDest[zeile+x].b = resSource[offs]
imgDest[zeile+x].g = resSource[offs+1]
imgDest[zeile+x].r = resSource[offs+2]
offs += 3
Next
zeile -= breite
Next
Put (10,10),image,Pset
ImageDestroy image
End If
End If
Sleep
|
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
Dusky_Joe
Anmeldungsdatum: 07.01.2005
Beiträge: 1007
Wohnort: Regensburg/Oberpfalz
|
| Verfasst am: 25.11.2006, 17:33 Titel: |
|
|
LockResource!
Nach so was hab ich wieder gesucht, eine Func, die einen Pointer auf den Datenbereich der BMP zurückgibt...
Nett ist ja auch, dass .biSize die Adresse des Headers ist; in der BITMAP-Struktur existiert ja auch ein .bmWidthBytes, das angeblich (also laut win32.hlp) die Bytes pro Zeile angibt. Zuerst konnte ich mit diesem Wert nichts anfangen, jedenfalls stand er in keiner Relation zur Breite des Bildes... Aber als Adresse könnte er taugen...
Werde mir das mal genauer ansehen, und auch deinen Code untersuchen. Ich find's nur komisch, dass mein 2. Code nicht funzt, da er bei mir unter XP/Home kein bisschen murkst, und brav das Bild kopiert.
Ein Gedanke, der mir noch gekommen ist:
Muss eigentlich der Speicher von irgendeiner API wieder freigegeben werden? Stichwörter wären wohl FreeResource, UnLoadResource etc...
Werde mal nach solchen Stichwörtern googlen.
Was mich auch wundert:
Der zweite Parameter von FindResource ist ein WSTRING PTR. Du übergibst hier ByVal "#1000", also keinen Ptr sondern den String selbst... naja, solange es funzt...
Danke für den Code!
Gut finde ich auch die Prüfung auf V0.17.
Zum Thema Padding auf Breite_in_Bytes = Vielfaches_von_vier hast du dir anscheinend auch noch keine Gedanken gemacht, oder?
Naja, egal, hier ist es wohl leichter, die BMPs einfach um diese max. 3 Pixel breiter zu machen
Have a nice day
Ciao
_________________
fully biological degradable
Once, the big wave arrives, you've got two ways, you can go:
Either, you ride it, or you don't do.
But, if you don't ride, you'll never know wether you'd have gone wet. |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 25.11.2006, 22:06 Titel: |
|
|
| Dusky_Joe hat Folgendes geschrieben: | ...
Nett ist ja auch, dass .biSize die Adresse des Headers ist; |
.biSize (Adresse des Headers??) war bei mir leider immer 0. Damit kam ich schon im 1.Prog nicht weiter.
| Zitat: | Was mich auch wundert:
Der zweite Parameter von FindResource ist ein WSTRING PTR. Du übergibst hier ByVal "#1000", also keinen Ptr sondern den String selbst... naja, solange es funzt... |
hatte ich in einem Profan-Code so gesehen und in FB mal ausprobiert , warum das mit der vorangestellten Raute geht ???
Unten habe ich es mal 'normal' geprogt.
| Zitat: | | Zum Thema Padding auf Breite_in_Bytes = Vielfaches_von_vier hast du dir anscheinend auch noch keine Gedanken gemacht, oder? |
erst jetzt 
| Code: | #include "windows.bi"
#Define RID_BMP 1000
Dim lpRes As BITMAPINFO Ptr
Dim As Integer Ptr image
Type RGB32 Field = 1
As Byte b,g,r,a
End Type
Dim As RGB32 Ptr imgDest
Dim As Byte Ptr resSource
Dim As Integer zeile, breite, breitbyt, hoehe, x, y, offs, j,bx
Screen 14,32
'Pointer auf BITMAP
lpRes = LockResource(LoadResource(0, FindResource(0, MAKEINTRESOURCE(RID_BMP), RT_BITMAP)))
If lpRes = 0 Then
?"BITMAP nicht gefunden"
Sleep: End -1
End If
If lpRes->bmiHeader.biCompression = 0 Then 'kein Compression
breite = lpRes->bmiHeader.biWidth 'Breite
hoehe = lpRes->bmiHeader.biHeight 'Höhe
offs = lpRes->bmiHeader.biSize 'Bitmap-Header-Offset
bx = Iif(breite And 3, (breite And -4)+4, breite) 'Breite Image (Integer)
breitbyt = lpRes->bmiHeader.biSizeImage \ hoehe 'Breite .bmp (Byte)
If lpRes->bmiHeader.biBitCount = 24 Then 'wirklich 24bpp
image = ImageCreate(breite, hoehe)
zeile = bx * (hoehe-1) 'beginnt mit unterster Zeile
resSource = Cptr(Byte Ptr, lpRes)
imgDest = Cptr(RGB32 Ptr, image) + Iif(image[0]=7,8,1)'FB0.17?
For y = 0 To hoehe-1
j = offs
For x = 0 To breite-1
imgDest[zeile+x].b = resSource[j]
imgDest[zeile+x].g = resSource[j+1]
imgDest[zeile+x].r = resSource[j+2]
j += 3
Next
offs += breitbyt
zeile -= bx
Next
Put (10,10),image,Pset
ImageDestroy image
End If
End If
Sleep |
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
Dusky_Joe
Anmeldungsdatum: 07.01.2005
Beiträge: 1007
Wohnort: Regensburg/Oberpfalz
|
| Verfasst am: 09.12.2006, 13:06 Titel: |
|
|
Habe deinen Vorschlag jetzt mal zur Function umgeschrieben. Leider funktioniert der Code bei mir immer noch nur mit BMPs, deren Breite ein Vielfaches von vier (dreifache Alliteration!) ist.
However, hier ist der Code.
Wie schon beim letzten mal habe ich nur die nötigen DECLAREs aus dem windows.wbi-Block übernommen, da sich Teile davon mit anderen Includes meines Projekts nicht verstehen.
Man kann also - wenn man sowiso die windows.bi einbinden möchte - bequem den EXTERN-Block entfernen, und durch das entsprechende #Include ersetzen.
| Code: | Extern "windows" Lib "kernel32"
'Declare Function GetModuleHandle Alias "GetModuleHandleW" (ByVal ModuleName As WString Ptr ) As UInteger
Declare Function FindResource Alias "FindResourceW" (Byval hModule As Integer, Byval lpName As WString Ptr, Byval lpType As WString Ptr) As UInteger
Declare Function LoadResource (ByVal hModule As Integer, ByVal hResInfo As Integer ) As Any Ptr
Declare Function LockResource (ByVal hResData As Any Ptr) As Any Ptr
#Define RT_BITMAP (Cast( WString Ptr, 2 ))
#Define Null Byval 0
' Type BitMap
' bmType As Integer
' bmWidth As Integer
' bmHeight As Integer
' bmWidthBytes As Integer
' bmPlanes As Integer
' bmBitsPixel As Integer
' bmBits As Any Ptr
' End Type
Type BITMAPINFOHEADER
biSize As UInteger
biWidth As Integer
biHeight As Integer
biPlanes As UShort
biBitCount As UShort
biCompression As UInteger
biSizeImage As UInteger
biXPelsPerMeter As Integer
biYPelsPerMeter As Integer
biClrUsed As UInteger
biClrImportant As UShort
End Type
Type RGB32 Field = 1
b As Byte
g As Byte
r As Byte
a As Byte
End Type
Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(1) As RGB32
End Type
End Extern
'----------------------------'
Declare Function GetBMP32fromRes ( ID As WString Ptr ) As Any Ptr
#Define BID_Splash (Cast( Any Ptr, 1022 ))
Dim As Byte Ptr pPic
'............................'
Screen 14, 32
pPic = GetBMP32fromRes ( BID_Splash )
If pPic Then Put (0, 0), pPic
ImageDestroy pPic
GetKey
'............................'
Function GetBmp32fromRes ( ID As WString Ptr ) As Any Ptr
Dim As BITMAPINFO Ptr lpRes
Dim As RGB32 Ptr imgDest
Dim As Integer Ptr image
Dim As Byte Ptr resSource
Dim As Integer zeile, breite, breitbyt, hoehe, x, y, offs, j, bx
'Pointer auf BITMAP
lpRes = _
LockResource ( _
LoadResource( 0, _
FindResource( 0, ID, RT_BITMAP ) _
) _
)
If lpRes = 0 Then
Exit Function
End If
If lpRes->bmiHeader.biCompression = 0 Then
breite = lpRes->bmiHeader.biWidth
hoehe = lpRes->bmiHeader.biHeight
offs = lpRes->bmiHeader.biSize
bx = Iif(breite And 3, (breite And -4) + 4, breite) ' Width in Pixels
breitbyt = lpRes->bmiHeader.biSizeImage \ hoehe ' Width in Bytes (Bytes per row)
If lpRes->bmiHeader.biBitCount = 24 Then ' only use 24bpp-BMPs
image = ImageCreate(breite, hoehe)
zeile = bx * (hoehe - 1) ' start with last row
resSource = Cptr(Byte Ptr, lpRes)
imgDest = Cast(RGB32 Ptr, image) + Iif(image[0] = 7, 8, 1) ' Header beginns at different offsets in
' versions before and after FB0.17
For y = 0 To hoehe - 1
j = offs
For x = 0 To breite - 1
imgDest[zeile + x].b = resSource[j ]
imgDest[zeile + x].g = resSource[j + 1]
imgDest[zeile + x].r = resSource[j + 2]
j += 3
Next
offs += breitbyt
zeile -= bx
Next
End If ' End If 24bpp
End If ' End If Compression
Function = image
End Function |
Wie man sieht, habe ich noch zwei kommentierte Deklarationen eingefügt; GetModuleHandle und der Typ BITMAP werden in dieser Func ja nicht genutzt, können in Programmen, die damit arbeiten aber evtl. von nutzen sein.
Außerdem bin ich dabei geblieben, die ID der BMP-Resource als WSTRING PTR zu übergeben - spart das MakeIntResource-Makro.
Ich danke für deine Hilfe.
Ist nach meinen Änderungen das Programm auch auf deinem System noch lauffähig?
Wie gesagt, bei mir funktionierte auch der erste Code schon tadellos...
Wie sieht denn >>Dein 2. Prog bekomm ich auf WinME nicht lauffähig??<< aus? FB compilert wahrscheinlich ohne Beanstandung, aber dann kommt ein "Programm.exe hat einen ungültigen Befehl erzeugt, und muss beendet werden", oder so? Oder kann man den Fehler im ersten Prog sogar auf einen bestimmten bereich eingrenzen?
Übrigens ganz nett, wenn man die Beispiele von uns beiden vergleicht, wie deutlich der Unterschied bei der "Formatierung" ist So hat eben doch jeder seinen Stil
_________________
fully biological degradable
Once, the big wave arrives, you've got two ways, you can go:
Either, you ride it, or you don't do.
But, if you don't ride, you'll never know wether you'd have gone wet. |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 09.12.2006, 15:06 Titel: |
|
|
Hi Dusky,
Ist nach meinen Änderungen das Programm auch auf deinem System noch lauffähig?
ja, auch mit BMPs von 53, 175, 271 Pixel Breite!!??
(Die Zeile bx = Iif(breite And 3, (breite And -4)+4, breite) is a little bit tricky  tuts aber bei mir.)
Wie sieht denn >>Dein 2. Prog bekomm ich auf WinME nicht lauffähig??<< aus? FB compilert wahrscheinlich ohne Beanstandung, aber dann kommt ein "Programm.exe hat einen ungültigen Befehl erzeugt, und muss beendet werden"...
genau so...
Übrigens ganz nett, wenn man die Beispiele von uns beiden vergleicht, wie deutlich der Unterschied bei der "Formatierung" ist So hat eben doch jeder seinen Stil
Na Gottseidank, ist ja trist wenn alles gleich aussieht
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
