Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Tile a picture in Picturebox w/ BitBlt

Posted on 1999-07-01
7
Medium Priority
?
460 Views
Last Modified: 2012-08-14
I need to know how to tile a picture(IPictureDisp object) in a picturebox using the BitBlt API call.  The answer must have the API declaration and an explanation of the paramaters and any other hand holding that you can provide.
0
Comment
Question by:BeauT
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
7 Comments
 
LVL 1

Expert Comment

by:wolfjjj
ID: 1521429
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Global TwipsY As Integer, TwipsX As Integer

Function MaxColors(Frm As Form) As Long
  Dim Bits As Long
  Dim Planes As Long
  Bits = GetDeviceCaps(Frm.hdc, 12)   'First get bits per pixel
  Planes = GetDeviceCaps(Frm.hdc, 14) 'Next get number of color planes
  MaxColors = (2 ^ ((Bits - 1) * Planes)) - 1 'Calculate max colors available
End Function

Sub TileBackground(DrawObj As Form, Src As Control, StartY As Long)
  Dim foo As Integer, foobar As Integer
  For foo = 0 To DrawObj.ScaleWidth Step Src.Width - TwipsX
    For foobar = StartY To DrawObj.ScaleHeight Step Src.Height
      PaintPic2Form DrawObj, Src, foo, foobar
    Next foobar
  Next foo
  If DrawObj.AutoRedraw Then DrawObj.Refresh
End Sub

Sub PaintPic2Form(dest As Form, Source As Control, dX As Integer, dy As Integer)
  Dim foo As Integer
  Dim dWidth As Integer, dHeight As Integer
  dWidth = Source.Width / Screen.TwipsPerPixelX
  dHeight = Source.Height / Screen.TwipsPerPixelY
  foo = BitBlt(dest.hdc, dX / Screen.TwipsPerPixelX, dy / Screen.TwipsPerPixelY, dWidth, dHeight, Source.hdc, 0, 0, &HCC0020)
End Sub

Sub makeBackground(theform As Form, thepic As Control)
  Screen.MousePointer = 11
  theform.Picture = LoadPicture("")
  Select Case MaxColors(theform)
  Case 16
    theform.BackColor = &H808080
  Case 256
    theform.BackColor = &H808080
  Case Else
    TileBackground theform, thepic, 0
  End Select
  Screen.MousePointer = 0
End Sub

0
 
LVL 1

Author Comment

by:BeauT
ID: 1521430
This is a really good start.  But I need a little more explanation.  Also, I was hoping for a slightly less generalized solution since I know that I will be using specifically a picturebox to tile my pictures within.  But this is definitely a very good start.
0
 
LVL 1

Expert Comment

by:wolfjjj
ID: 1521431
You just have to paste the code and go, you can change the controls to whatever you require ie a picturebox. Here is the altered code

Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Global TwipsY As Integer, TwipsX As Integer

Function MaxColors(Frm As Form) As Long
  Dim Bits As Long
  Dim Planes As Long
  Bits = GetDeviceCaps(Frm.hdc, 12)   'First get bits per pixel
  Planes = GetDeviceCaps(Frm.hdc, 14) 'Next get number of color planes
  MaxColors = (2 ^ ((Bits - 1) * Planes)) - 1 'Calculate max colors available
End Function

Sub TileBackground(DrawObj As PictureBox, Src As Control, StartY As Long)
  Dim foo As Integer, foobar As Integer
  For foo = 0 To DrawObj.ScaleWidth Step Src.Width - TwipsX
    For foobar = StartY To DrawObj.ScaleHeight Step Src.Height
      PaintPic2Form DrawObj, Src, foo, foobar
    Next foobar
  Next foo
  If DrawObj.AutoRedraw Then DrawObj.Refresh
End Sub

Sub PaintPic2Form(dest As PictureBox, Source As Control, dX As Integer, dy As Integer)
  Dim foo As Integer
  Dim dWidth As Integer, dHeight As Integer
  dWidth = Source.Width / Screen.TwipsPerPixelX
  dHeight = Source.Height / Screen.TwipsPerPixelY
  foo = BitBlt(dest.hdc, dX / Screen.TwipsPerPixelX, dy / Screen.TwipsPerPixelY, dWidth, dHeight, Source.hdc, 0, 0, &HCC0020)
End Sub

Sub makeBackground(theform As Form, thepic As Control)
  Screen.MousePointer = 11
  theform.Picture = LoadPicture("")
  Select Case MaxColors(theform)
  Case 16
    theform.BackColor = &H808080
  Case 256
    theform.BackColor = &H808080
  Case Else
    TileBackground pic1, thepic, 0
  End Select
  Screen.MousePointer = 0
End Sub

Pic1 is the PictureBox being Tiled

There ya go just paste and go.
Basically you call the makeBackground function, it calculates the number of colours in the windows settings ie 16, 256, 16 bit, 32 bit ... whatever. Next it calls the tile background routine.

This routine calculates how many copies of the picture will fit across and down the picturebox. Then runs the PaintPicToForm function which BitBlts the picture onto the other picturebox being tiles.

And yeehaah your picturebox is tiled with an image.
For anything more I'll require more points.
To simplify things just start by calling the tileBackground routine and then you can decide later what you want to happen depending on the number of colours they have setup in windows
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 1

Expert Comment

by:wolfjjj
ID: 1521432
I made a bit of a mistake in the code for the PaintPicToForm routine it should be.

Sub PaintPic2Form(dest As Object, Source As Control, dX As Integer, dy As Integer)
  Dim foo As Integer
  Dim dWidth As Integer, dHeight As Integer
  dWidth = Source.Width / Screen.TwipsPerPixelX
  dHeight = Source.Height / Screen.TwipsPerPixelY
  foo = BitBlt(dest.hdc, dX / Screen.TwipsPerPixelX, dy / Screen.TwipsPerPixelY, dWidth, dHeight, Source.hdc, 0, 0, &HCC0020)
End Sub

It's exactly the same except the pic1 as PictureBox is replaced by a pic1 as Object

You can simply copy and paste the code and it works. Just create two picture boxes on a form pic1 and pic2 and try it.
just make the call

call makeBackground(Form1,Pic2)

and it works, can't get any easier than that
0
 
LVL 1

Author Comment

by:BeauT
ID: 1521433
nothin. I added 2 pictureboxes to a form, named one of them Pic1 and one of them Pic2. Then I loaded a picture into Pic2.  In form_Load I tried
call makeBackground(Me, Pic2) and I also tried
call makeBackground(Me, Pic1) and nothing.  I cut and pasted the code just as you had it, except I had to put a private in front of each of the API declarations and made the Global variables private. But in a Form none of that should matter. I also used the new PaintPic2Form routine that posted and still nothing. Where did I go wrong?
0
 
LVL 1

Accepted Solution

by:
wolfjjj earned 240 total points
ID: 1521434
OK

With the code try just using the TileBackground routine

ie

Call TileBackground(Pic1, Pic2,0)

Just to see how it goes, if you run the MakeBackground it checks the number of colours setup in windows and if you have less than 256 for your monitor it just sets a background colour.

See how it goes, I can paste the code straight into a project and it works without any problems. Don't change any of the code from what is listed above and tell us how it went.
0
 
LVL 1

Author Comment

by:BeauT
ID: 1521435
OK, with a little modification, I got it all to work fine.  Even got it to run correctly from the makeBackground routine. Thanks alot.
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Suggested Courses

721 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question