Bitmap Handling

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

Further to my Naked Ladies

http://forums.vb-world.net/showthrea...threadid=16840

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

Cheers

:cool:

Dan

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.

....so what am I doing wrong?

Code:

---

        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]

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

Code:

---

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 ;)

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

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.

Code:

---

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.

Code:

---

  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.

Code:

---

  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.

Code:

---

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:

Code:

---


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:

Code:

---


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:

Code:

---

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 =)

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

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

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 :)