tile form?

Is there a way to tile a form with a picture (with the picture in the picturebox)?

I tried that, the only solution I can see is to use lots of pic boxes the size of the image, with 0 borders, and tile them yourself.... time consuming, probably drains performance.... so I didnt do it

[kedaman]

Use bitblt in a y loop inside a x loop to draw the tiles over the form, heres the dec:

Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (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

try it

I tried
put this in a module

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
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

those are the declares...
put this in a module too, it doesnt matter if its the same module:

Public Function TileImage(RefForm As Form, ImageToTile As PictureBox) As Boolean
On Error GoTo error_TileImage
Dim lngBitmapHandle As Long
Dim lngFormHeight As Long
Dim lngFormWidth As Long
Dim lngPictureHeight As Long
Dim lngPictureWidth As Long
Dim lngPrevScale As Long
Dim lngRet As Long
Dim lngSourceDC As Long
Dim lngX As Long
Dim lngY As Long

If Not RefForm Is Nothing And Not ImageToTile Is Nothing Then

With ImageToTile
    lngPrevScale = .ScaleMode
    .ScaleMode = vbPixels
    lngPictureHeight = .ScaleHeight
    lngPictureWidth = .ScaleWidth
    .ScaleMode = lngPrevScale
End With

With RefForm
    lngPrevScale = .ScaleMode
    .ScaleMode = vbPixels
    lngFormHeight = .ScaleHeight
    lngFormWidth = .ScaleHeight
    .ScaleMode = lngPrevScale
End With

lngSourceDC = CreateCompatibleDC(RefForm.hdc)
lngBitmapHandle = SelectObject(lngSourceDC, ImageToTile.Picture.Handle)

For lngX = 0 To lngFormWidth Step lngPictureWidth
    For lngY = 0 To lngFormHeight Step lngPictureHeight
        lngRet = BitBlt(RefForm.hdc, lngX, lngY, lngPictureWidth, lngPictureHeight, lngSourceDC, 0, 0, SRCCOPY)
    Next lngY
Next lngX

lngRet = SelectObject(lngSourceDC, lngBitmapHandle)
lngRet = DeleteDC(lngSourceDC)

TileImage = True

Else
TileImage = False
End If
Exit Function
error_TileImage:
If Not RefForm Is Nothing Then
    RefForm.Tag = Err.Number & "  " & Err.Description
    End If
    TileImage = False
End Function

put this in the declarations section of your form.

Sub SetTile()
On Error GoTo error_SetTile

Dim blnRet As Boolean
blnRet = TileImage(Me, picTile)
Screen.MousePointer = vbDefault
Exit Sub
error_SetTile:
Screen.MousePointer = vbDefault

End Sub

and in the form load put this

SetTile

add a picturebox called picTile, set autosize to true, and have no borders, and set it out of site.

viola
it works good.. but it doesnt redraw itself when you resize, I tried setting autoredraw to true... no luck
I tried putting

SetTile

in the forms resize, but still no luck, if you maximize it, about 1/3 of the it is blank...

Well I found something. For all you people that want to know how to do this also, here you are:

Sub PictureTile(Frm As Form, Pic As PictureBox)
    Dim i As Integer
    Dim t As Integer
    Frm.AutoRedraw = True
    Pic.BorderStyle = 0


    For t = 0 To Frm.Height Step Pic.ScaleHeight


        For i = 0 To Frm.Width Step Pic.ScaleWidth
            Frm.PaintPicture Pic.Picture, i, t
        Next i
    Next t
End Sub

usage:

'put this in Form_Activate, Form_Paint, or Form_Resize
PictureTile Me, Picture1

Thanks for the help anyway.

if your looking for performance and speed, than you better use mine, API is a hell of alot faster, when it deals with images... Vb and API encryption can be the same, I have seen some cases where Vb was faster, it really depends on what kind of encryption....
but, I would like to find someone to prove me wrong:
Graphics handling is MUCH MUCH faster, literaly by centiseconds(its alot if you are building a game) in API, than VB.....
if you build a counter using queryperformancecounter or whatever the call is, and test out the time, you will find API to be much better...

just my $0.02

[kedaman]

Paintpicture is faster in stretching images than stretchblt. bitblt is faster than painpicture in copying images. Also Dennis, you don't need to create your own DC's, and you only need to declare two variables.

just my mk0.02

[Zaf Khan]

Check out the sample
http://home.clara.net/doczaf/code/vbsample3.htm

The routine will work for any object which supports a paint event

DocZaf

That's cool, the code is easier to understand to.
Only thing I can't stand.
My name is spelled the traditional way, with two Ts!!
Heh, sorry, it just pisses me off when people only put 1 t, lol.

[Zaf Khan]

sorry maTThew,

I tried to skimp on the keystrokes and now its cost me!!!
{;->

Dennis- great code example. (I changed frm to object so I could tile in pictureboxes too Also, the bug where it doesn't tile the entire thing is in the RefForm object. You have scale height for both form width and height.

However I have one problem... its a little slow. My app requires something a little bit quicker/optimized to redraw the entire area, since my app requires that I do it A LOT.

Also, where do I get the DC's since kedaman said "you don't need to create your own DC's." I'll repaste the code so you don't have to scroll up

Public Function TileImage(RefForm As Form, ImageToTile As PictureBox) As Boolean
On Error GoTo error_TileImage
Dim lngBitmapHandle As Long
Dim lngFormHeight As Long
Dim lngFormWidth As Long
Dim lngPictureHeight As Long
Dim lngPictureWidth As Long
Dim lngPrevScale As Long
Dim lngRet As Long
Dim lngSourceDC As Long
Dim lngX As Long
Dim lngY As Long

If Not RefForm Is Nothing And Not ImageToTile Is Nothing Then

With ImageToTile
    lngPrevScale = .ScaleMode
    .ScaleMode = vbPixels
    lngPictureHeight = .ScaleHeight
    lngPictureWidth = .ScaleWidth
    .ScaleMode = lngPrevScale
End With

With RefForm
    lngPrevScale = .ScaleMode
    .ScaleMode = vbPixels
    lngFormHeight = .ScaleHeight
    lngFormWidth = .ScaleHeight
    .ScaleMode = lngPrevScale
End With

lngSourceDC = CreateCompatibleDC(RefForm.hdc)
lngBitmapHandle = SelectObject(lngSourceDC, ImageToTile.Picture.Handle)

For lngX = 0 To lngFormWidth Step lngPictureWidth
    For lngY = 0 To lngFormHeight Step lngPictureHeight
        lngRet = BitBlt(RefForm.hdc, lngX, lngY, lngPictureWidth, lngPictureHeight, lngSourceDC, 0, 0, SRCCOPY)
    Next lngY
Next lngX

lngRet = SelectObject(lngSourceDC, lngBitmapHandle)
lngRet = DeleteDC(lngSourceDC)

TileImage = True

Else
TileImage = False
End If
Exit Function
error_TileImage:
If Not RefForm Is Nothing Then
    RefForm.Tag = Err.Number & "  " & Err.Description
    End If
    TileImage = False
End Function

Any ideas that you have that would make this code faster would help me out a lot!!!

[HeSaidJoe]

'will an image box do

Private Sub Form_Paint()
'tile an image on a form

'1) Place an image control on a form and give it a picture
'2) Set the forms AutoRedraw to False
'3) Place this code in the Form Paint Event

Dim intX As Integer
Dim intY As Integer

For intX = 0 To Me.Width Step Image1.Width
        For intY = 0 To Me.Height Step Image1.Height
            PaintPicture Image1, intX, intY
        Next intY
Next intX
End Sub

Originally posted by kedaman
Paintpicture is faster in stretching images than stretchblt.

I must disagree with you on this, Kedaman. StretchBlt is about 5 times faster than PaintPicture. The reason being is that you are accessing the API call directly from the
library. In Visual Basic, when you draw a Line, you are, in reality, using the LineTo API Function. When you draw a
Rectangle, you are using the Rectangle API function. When you stretch a picture using PaintPicture, you are using the
StretchBlt API function. You get the picture, right? Anyhow, PaintPicture, is slower because it's already
integrated in the Visual Basic langauge, hence you would have to go through Visual Basic then the DLL and back to
accomplish the task, whereas when you use StretchBlt, you are accessing it directly through the library.

This was posted a while ago, you don't need to post anymore about it.

Posted: 05-27-2000 08:57 AM

..unless you want to make a new topic about tiling an image, it's fine with me .

[kedaman]

Megatron, Save this as a form, and run it. press painpicture button and stretchblt button and tell me what you get

VERSION 5.00
Begin VB.Form FrmMain 
   Caption         =   "Testengine"
   ClientHeight    =   7290
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5445
   LinkTopic       =   "Form1"
   ScaleHeight     =   486
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   363
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame1 
      Caption         =   "Color"
      Height          =   1215
      Left            =   120
      TabIndex        =   1
      Top             =   2160
      Width           =   3615
      Begin VB.TextBox Text2 
         Height          =   285
         Left            =   3000
         TabIndex        =   8
         Text            =   "600"
         Top             =   720
         Width           =   495
      End
      Begin VB.TextBox Text1 
         Height          =   285
         Left            =   2400
         TabIndex        =   7
         Text            =   "800"
         Top             =   720
         Width           =   495
      End
      Begin VB.CommandButton Command5 
         Caption         =   "Paintpicture"
         Height          =   375
         Left            =   2400
         TabIndex        =   6
         Top             =   240
         Width           =   1095
      End
      Begin VB.CommandButton Command4 
         Caption         =   "Bitblt"
         Height          =   375
         Left            =   1200
         TabIndex        =   5
         Top             =   720
         Width           =   1095
      End
      Begin VB.CommandButton Command3 
         Caption         =   "StretchBlt"
         Height          =   375
         Left            =   1200
         TabIndex        =   4
         Top             =   240
         Width           =   1095
      End
      Begin VB.CommandButton Command1 
         Caption         =   "Pset"
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton Command2 
         Caption         =   "Setpixelv"
         Height          =   375
         Left            =   120
         TabIndex        =   2
         Top             =   720
         Width           =   975
      End
   End
   Begin VB.PictureBox Picture1 
      BorderStyle     =   0  'None
      Height          =   1500
      Left            =   2880
      ScaleHeight     =   1500
      ScaleWidth      =   1500
      TabIndex        =   0
      Top             =   360
      Width           =   1500
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private 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

Private Sub Command1_Click()
    t = GetTickCount
     For n = 0 To 10000
        Picture1.PSet (Rnd * Picture1.ScaleWidth, Rnd * Picture1.ScaleHeight), Rnd * &H1000000
    Next n
    MsgBox (GetTickCount - t) / 10 & "µs"
End Sub

Private Sub Command2_Click()
    t = GetTickCount
     For n = 0 To 10000
        SetPixelV Picture1.hdc, Rnd * Picture1.ScaleWidth / 15, Rnd * Picture1.ScaleHeight / 15, Rnd * &H1000000
    Next n
    Picture1.Refresh
    MsgBox (GetTickCount - t) / 10 & "µs"
    Picture1.Picture = Picture1.Image
End Sub

Private Sub Command3_Click()
    t = GetTickCount
    For n = 0 To 1000
        StretchBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth / 15, Picture1.ScaleHeight / 15, Picture1.hdc, Picture1.ScaleWidth / 15, Picture1.ScaleHeight / 15, -Picture1.ScaleWidth / 15, -Picture1.ScaleHeight / 15, vbSrcCopy
    Next n
    Picture1.Refresh
    MsgBox (GetTickCount - t) * Val(Text1) * Val(Text2) / 10000000 & "ms  for " & Text1 & " * " & Text2
End Sub

Private Sub Command4_Click()
    t = GetTickCount
    For n = 0 To 10000
        BitBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth / 15, Picture1.ScaleHeight / 15, Picture1.hdc, 0, 0, vbSrcCopy
    Next n
    Picture1.Refresh
    MsgBox (GetTickCount - t) * Val(Text1) * Val(Text2) / 100000000 & "ms  for " & Text1 & " * " & Text2
End Sub

Private Sub Command5_Click()
    Picture1.Picture = Picture1.Image
    t = GetTickCount
    For n = 0 To 1000
        Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.ScaleWidth / 15, Picture1.ScaleHeight / 15, Picture1.ScaleWidth / 15, Picture1.ScaleHeight / 15, -Picture1.ScaleWidth / 15, -Picture1.ScaleHeight / 15, vbSrcCopy
    Next n
    Picture1.Refresh
    MsgBox (GetTickCount - t) * Val(Text1) * Val(Text2) / 10000000 & "ms  for " & Text1 & " * " & Text2
End Sub

[HeSaidJoe]

Picture1.PSet (Rnd * Picture1.ScaleWidth, Rnd * Picture1.ScaleHeight), Rnd * & H100 0000

error...expected expression [&] H100 0000

[kedaman]

Not my fault, HSJ, it just put the " " in there like it put's a smiley instead of &)

Yup, that is a bug. Anything...

1000000
1010101
1000100
1111000
1110000

with a 1 and a 0 will space in between somewhere. But it's something we all can live with, right?

And..it also spaces the code. [code ]

[kedaman]

hmm, i mean hmm, once in a while i loose some of my time on problems like this, but on the other hand i loose time on this site more than loosing sleep for the last month

[Zaf Khan]

Sub Object_Paint(objSource as Object,objTarget as Object)
'This routine tiles an image (objSource) all over the target object (objTarget)

'objTarget could be Form1
'objSource could be Picture1

Dim X as Integer
     'Set vertical loop
     For Y = 0 To objTarget.Height Step picSource.Height
          'Set horizontal loop
          For X = 0 To objTarget.Width Step picSource.Width
               'Draw the image at location x,y
               objTarget.PaintPicture picSource, X, Y
          'Draw next horizontal image until row is drawn
          Next X
     'Draw next vertical image until all columns drawn
     Next Y

End Sub

[Edited by Zaf Khan on 08-05-2000 at 07:43 PM]

Kedaman, I have done tests on this before and StretchBlt was proven to be 5 times faster.
It took StretchBlt 4.9ms average to draw a picture; and it took PaintPicture 21.9ms
average to draw the same picture.

[HeSaidJoe]

Zaf Khan

 Dim X as Integer
     'Set vertical loop
     For Y = 0 To objTarget.Height Step picSource.Height
          'Set horizontal loop
          For X = 0 To objTarget.Width Step picSource.Width
               'Draw the image at location x,y
               objTarget.PaintPicture picSource, X, Y
          'Draw next horizontal image until row is drawn
          Next X
     'Draw next vertical image until all columns drawn
     Next Y
'<<<<<<<<<<<<<<<<<<<<<<<<  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>
HeSaidJoe
 
Dim intX As Integer
Dim intY As Integer

For intX = 0 To Me.Width Step Image1.Width
        For intY = 0 To Me.Height Step Image1.Height
            PaintPicture Image1, intX, intY
        Next intY
Next intX

[parksie]

If there's enough demand, I might put a VB/API comparison benchmark together...anyone want one? Ya know, just for comparing times on different computers.

[kedaman]

MEg, it could be hardware, for instance bitblt runs more than ten times slower on my laptop. Did you run the test? What results?

[Zaf Khan]

HeSaidJoe

Sub Object_Paint(objSource as Object,objTarget as Object)
'This routine tiles an image (objSource) all over the target object (objTarget)

'objTarget could be Form1
'objSource could be Picture1

Dim X as Integer
     'Set vertical loop
     For Y = 0 To objTarget.Height Step picSource.Height
          'Set horizontal loop
          For X = 0 To objTarget.Width Step picSource.Width
               'Draw the image at location x,y
               objTarget.PaintPicture picSource, X, Y
          'Draw next horizontal image until row is drawn
          Next X
     'Draw next vertical image until all columns drawn
     Next Y

End Sub

When using the PAINTPICTURE method, if the keyword is not pre-fixed with an object name - an object that must support the paintpicture method) then the method is implied towards the form that contains the code (MDI Form? ...I can't remember), if the code is in a module and not in a form, AND the code is not pre-fixed with an object name of an object that supports the method then an error occurs.

When pre-fixing the keyword with an object name that does support the paint picture method (Form's, Picturebox's and CUSTOM controls, then the object background can be tiled.

And finally, not everyone is over the moon with naming conventions

DocZaf
{;->

[kedaman]

You specified your own results as 1:5, can you write down the exact figures? I need to know if this is caused by hardware or what, also turn of autoredraw and write down following results too