Bitmap Handling

[Judd]

I expect I need some API functions here.....

Further to my Naked Ladies

http://forums.vb-world.net/showthread.php?threadid=16840

If I load a bitmap strip from a resource, how do I programatically chop it up into 16x16 squares?

Cheers

:cool:

Dan

[Stevie-O]

To break it up into 16x16 squares, you need to create two memory-based device contexts using CreateCompatibleDC(0), and one bitmap for every square. Then you use BitBlt to copy the various 16x16 sections from the source bitmap to your destination bitmaps.

[Judd]

....so what am I doing wrong?


Dim hDestDC As Long
Dim hSrcDc As Long
Dim res As Long
Dim ipics As Integer
Dim i As Integer

Set Picture2.Picture = LoadResPicture(101, vbResBitmap)
ipics = Picture2.Width / (16 * Screen.TwipsPerPixelX)
hSrcDc = Picture2.hdc

Picture3(0).Width = 16 * Screen.TwipsPerPixelX
Picture3(0).Height = 16 * Screen.TwipsPerPixelY

For i = 1 To ipics - 1
Load Picture3(i)
Picture3(i).Left = Picture3(i).Left + (280 * i)
Picture3(i).Visible = True
hDestDC = Picture3(i).hdc

res = BitBlt(hSrcDc, 0, 0, 240, 240, hDestDC, (0 + (240 * i) - 240), 0, &HCC0020)

Next i


My creation of the control array works, and Bitblt returns 1, but no pictures are copied??? (SRCCOPY is what I was trying for)

Can you help?

:cool:

Dan

[Edited by Judd on 05-18-2000 at 06:30 AM]

[Fox]

...so BitBlt does it's job. I'd say you swapped src and dst DCs... try this:

res = BitBlt(hDestDc, 0, 0, 240, 240, hSrcDC, (0 + (240 * i) - 240), 0, vbSrcCopy)


btw: Be sure you set AutoRedraw to false, else you bliting would be redrawn by vb ;)

[Judd]

Thanks Fox....but it still isn't working....

[Stevie-O]

API calls are fun =)

Rule #2 of good programming: *NEVER* use weird constants like &HC0EDBABE&, always use a constant name.

(Rule #1 is don't program in VB... just kidding!)


A helpful hint, by the way: if you only get to choose among a relatively small number of items for a variable, use an Enum instead of a constant. That makes VB pop up a list of available choices for a parameter - making Enums the perfect option for flags and 'what type' parameters. However, be sure to know that an Enum is the same as a Long -- an important detail when you're doing Types for windows functions.

--------- now back to our show ---------

Okay, your code is SEVERELY flawed.


ipics = Picture2.Width / (16 * Screen.TwipsPerPixelX)

Flaw #1: Picture2.Width isn't the width of the image, it's the width of the picture box. You want the width of the image - Picture2.Picture.Width. And there you are, assuming everybody's using Twips. Me.ScaleX(16,vbPixels,Me.ScaleMode) is WAY more reliable.


Picture3(i).Left = Picture3(i).Left + (280 * i)


Flaw #2: 280? Hardcoding abritrary constants like that will case problems. I don't use vbTwips scalemode - I use vbPixels. I think what you want is really Picture3(i-1).Left + Picture3(i-1).Width.


res = BitBlt(hSrcDC, 0, 0, 240, 240, hDestDC, (0 + (240 * i) - 240), 0, &HCC0020)


Flaw #3: This is where your everything-is-in-twips idea REALLY brings you down. You know your destination bitmap is 16x16 pixels. This BitBlt statement tells GDI to copy a 240x240-pixel bitmap - in the wrong direction, no less, but someone already pointed that out.

Flaw #4: Not so obvious is the fact that you're copying from a screen DC. What does that mean? It means that you're blitting from one part of the screen (Picture2) to another part of the screen (Picture3(i)). That's okay...unless either one is covered up at all. Then you'll be copying portions of other windows, etc. What fun ;)

Okay, I'm done shooting you down. Here's some workable code:

Put this section in a module. I call mine OLEModule.bas.


Option Explicit

' OLE-Specific module ****

' * TYPES *

Type PICTDESC_BITMAP
cbSizeOfStruct As Long
picType As Long
hbitmap As Long
hpal As Long
End Type

Type aGUID
Data1 As Long
Data2 As Integer
data3 As Integer
data4(0 To 7) As Byte
End Type

' * DECLARES *

Declare Function OleCreatePictureIndirect Lib "olepro32" (pPictDesc As Any, riid As aGUID, ByVal fOwn As Long, ppvObj As Object) As Long


Function BitmapToPicture(ByVal hBmp As Long, _
Optional ByVal hpal As Long = 0, _
Optional ByVal fDestroyhBmp As Boolean = True) _
As IPicture
' Fill picture description
Dim ipic As IPicture, picdes As PICTDESC_BITMAP, iidIPicture As aGUID
With picdes
.cbSizeOfStruct = Len(picdes)
.picType = vbPicTypeBitmap
.hbitmap = hBmp
.hpal = hpal
End With
' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
With iidIPicture
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
' Create picture from bitmap handle
OleCreatePictureIndirect picdes, iidIPicture, fDestroyhBmp, ipic
' Result will be valid Picture or Nothing—either way set it
Set BitmapToPicture = ipic
End Function


I have this code in my APIModule.bas:



Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hGdiObj As Long) As Long

Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long



Put this code wherever you want to:



Sub BreakUpImage(orgBmp As IPictureDisp, outBmp() As IPictureDisp, Optional ByVal x As Long = 0, Optional ByVal y As Long = 0, Optional numPics As Long = 0, Optional picWidth As Long = 0, Optional picHeight As Long = 0)
Dim nBmps As Long, i As Long
Dim hDCSrc As Long, hDCDest As Long
Dim hSrcBmpOld As Long, hDestBmpOld As Long, hDestBmp As Long

' Defaults:
' If x and/or y are not specified, the splitting begins at the upper-left hand corner of orgBmp.
' If numPics is not specified, but picWidth is, numPics is assumed to be (width of orgBmp)/(picWidth)
' If picWidth is not specified, but numPics is, picWidth is assumed to be (width of orgBmp)/(numPics)
' If neither numPics nor picWidth are specified, an error is raised
' If picHeight is not specified, it is assumed to be the height of orgBmp.
' ALL arguments are specified in pixels.

If (numPics = 0) And (picWidth = 0) Then Err.Raise 513, "BreakUpImage", "Either numPics or picWidth must be specified and nonzero"
' set up some things
If (numPics = 0) Then numPics = ScaleX(orgBmp.Width, vbHimetric, vbPixels) / picWidth
If (picWidth = 0) Then picWidth = ScaleX(orgBmp.Width, vbHimetric, vbPixels) / numPics
If (picHeight = 0) Then picHeight = ScaleY(orgBmp.Height, vbHimetric, vbPixels)

ReDim outBmp(0 To numPics - 1)

hDCSrc = CreateCompatibleDC(0) ' create a memory DC that we'll be copying from
hDCDest = CreateCompatibleDC(0) ' create a memory DC that we'll be copying to

hSrcBmpOld = SelectObject(hDCSrc, orgBmp.Handle) ' make orgBmp's bitmap the drawing surface for hDCSrc

For i = 0 To numPics - 1
hDestBmp = CreateCompatibleBitmap(hDCSrc, picWidth, picHeight) ' Create a bitmap we can copy to
hDestBmpOld = SelectObject(hDCDest, hDestBmp) ' make this the drawing surface for hDCDest
BitBlt hDCDest, 0, 0, picWidth, picHeight, hDCSrc, x + i * picWidth, y, vbSrcCopy ' draw!
SelectObject hDCDest, hDestBmpOld ' we must always restore the original state
Set outBmp(i) = BitmapToPicture(hDestBmp) ' convert it
Next

SelectObject hDCSrc, hSrcBmpOld ' restore the source DC to its original state
DeleteDC hDCSrc ' and then toss em in the garbage like those bastards did to Now and Again :(
DeleteDC hDCDest
End Sub



And just so I don't have to explain how to use it, i have this sub:


Private Sub Command1_Click()
Dim Pics() As IPictureDisp
Dim ipics As Long, picH As Long
Dim i As Integer

Set Picture2.Picture = LoadPicture("C:\WINDOWS\LOGOW.SYS")
' since iPics is 0 until we assign it, BreakUpImage will use 16 as the width and conveniently
' fill iPics in for us :)
BreakUpImage Picture2.Picture, Pics(), , , ipics, 8, picH
Picture3(0).Width = ScaleX(16, vbPixels, vbTwips)
Picture3(0).Height = ScaleY(picH, vbPixels, vbTwips)
For i = 1 To ipics
Load Picture3(i)
With Picture3(i)
.Visible = True
.Left = .Left + ScaleX(20, vbPixels, vbTwips) * i
.Height = ScaleY(picH, vbPixels, vbTwips)
Set .Picture = Pics(i - 1)
.Refresh
End With
Next i
End Sub


Okay, I think that should be everything you need =)

[Judd]

That was the sound of me being shot down ;)

Perhaps I should have explained that this is not working code, just something I threw together to see how to use BitBlt - I know its sloppy :p

However:

Re Flaw#1: Point taken, but it still works when Autoresize is true

Re Flaw#2: Yes its not good practice but as I said its a 'Project1' project :p

Re Flaw#3: Ok, first I assumed BitBlt worked in pixels and used 16, 16, but it didn't seem to work (for other reasons, obviously), so I thought maybe it worked in twips, so I changed it - and that didn't work either !!!!

Re Flaw#4: Oh. I see. :D

And finally....thanks for the code :)
(AS you may have guessed, I can manage some WinAPI stuff - but I've never been near any GDI!!)

Cheers,

:cool:

Dan

[Judd]

Just for fun :p

Flaw#1: Your code also requires the DeleteDC API declaration

Flaw#2: The 6th argument to BreakUpImage should be 16 ;)

Flaw#3: You can't put the BreakUpImage code anywhere because ScaleX and Scale Y require an object. It needs to be in a form or have an object specified on those lines (e.g. Form1.ScaleX(....))

Other than that, it worked perfectly, tahanks again!

Dan

[Stevie-O]

Haha, I expected to get a few complaints...

The 6th arg to BreakUpImage was 8 because I was messing around testing it and never set it back ;)

I know that I omitted the DeleteDC declaration and the fact that you need an object for ScaleX/Y, but obviously I was right in guessing you'd be able to figure them out :)


And lastly, no problemo :)