I'm using this function to tile a picture to an object, and I need this as fast as humanly possible!!
It really starts to lag when the object is full screen using any type of picture.
Ready? SPEED UP THIS CODE!!!
Please post ANY and ALL suggestions/code snippets that will speed this up!!Code:Public Sub TileImage(RefObject As Object, ImageToTile As PictureBox) Dim lngX&, lngY&, lngBitmapHandle&, lngFormHeight&, lngFormWidth& Dim lngPictureHeight&, lngPictureWidth& Dim lngPrevScale&, lngRet&, lngSourceDC& On Error GoTo Err With ImageToTile lngPrevScale = .ScaleMode .ScaleMode = vbPixels lngPictureHeight = .ScaleHeight lngPictureWidth = .ScaleWidth .ScaleMode = lngPrevScale End With With RefObject lngPrevScale = .ScaleMode .ScaleMode = vbPixels lngFormHeight = .ScaleHeight lngFormWidth = .ScaleWidth .ScaleMode = lngPrevScale End With lngSourceDC = CreateCompatibleDC(RefObject.hdc) lngBitmapHandle = SelectObject(lngSourceDC, ImageToTile.Picture.Handle) 'core tiling routine For lngY = 0 To lngFormHeight Step lngPictureHeight For lngX = 0 To lngFormWidth Step lngPictureWidth lngRet = BitBlt(RefObject.hdc, lngX, lngY, lngPictureWidth, lngPictureHeight, RefObject.hdc, 0, 0, SRCCOPY) Next lngX Next lngY lngRet = SelectObject(lngSourceDC, lngBitmapHandle) lngRet = DeleteDC(lngSourceDC) Exit Sub Err: If Not RefObject Is Nothing Then RefObject.Tag = Err.Number & " " & Err.Description Debug.Print (Err.Number & " " & Err.Description) End If End Sub
Thanks,
Joe Jordan





Reply With Quote