[RESOLVED] Hit Testing + Rotation, Scaling & More

[LaVolpe]

Just looking for some food for thought. Please refer to this image as you read the scenarios. Consider the 'white' area transparent. Sorry for the large read. Thought it would be helpful to give as much detail as I could & I'm sure I didn't predict everyone's questions in advance. This is not a priority of mine. I think it is more of a challenge than a problem...


I am upgrading a control. Rewriting it is more accurate. One of the things I am improving is the hit testing of the control. There are 4 hit test options + a user-defined option. Regardless of the option, the image within the control can be rendered with various properties and those properties can affect the hit testing algorithm:

Centered/Left Aligned, Rotated, Scaled/Stretched, X/Y Offsets, Border offsets, and Mirroring

Here are the hit test options:

Entire control dimensions with/without borders - black rectangle
Image Bounds (scaled from actual image size or stretched) - red rectangle
Trimmed Image Bounds (removes excess transparency but stays rectangle) - blue rectangle
Shaped (the cheetah image, no transparent pixels) - this would be a Windows region

Here are permanent cached dimensions

the scaled image bounds (white area of the picture)
the control dimensions (area enclosed by black rectangle)

I'm obviously interested in speed. Hit tests should be accurate and fast IMO. The 1st hit test option above is a no-brainer. The other areas are dynamic and can change due to animation, resizing, mirroring, rotation, etc. For a quickie on how key properties affect those hit test areas:
Rotation: Red/Blue rectangles are rotated, Shape/Region is rotated; sizes may alter slightly
Scaling: Red/Blue rectangles change size & position depending on centering. Same for Shape/Region
Mirroring: Red rectangle does not change, but Blue rectangle & Shape/Region position can change
Optional Offsets/Borders: Red/Blue rectangles & Shape/Region change positions

The Image Bounds hit test option requires no extra work and its size is cached, not its position. But the last two require the image to be touched. To trim an image (Blue Rectangle), the image pixels are scanned to find the tightest rectangle encompassing all non-transparent pixels. And to create a shaped region, every pixel must be touched to determine what is added to the region. So, these last two options are the speed bumps.

I'll now cut to the chase. I've pretty much made up my mind to perform hit tests by not trying to calculate all the possible sizes/positions/angles that the rectangles and region can be in and using some sort of Point In Polygon algo to determine hit tests for rectangles. This wouldn't help much for regions anyway. What I've fixated on was rotating/scaling/shifting the X,Y coordinate passed for hit testing to the pertinent hit test area as if it were not rotated/scaled/shifted.

I'm happy with the result except for 1 specific case. Touching the image when some properties change.

For the Trimmed (Blue Rectangle) option, I've chosen to cache the trimmed dimensions for the full size image which means image has to be touched once. When scaling occurs, I scale that rectangle based on the full-size & scaled-size ratios. Works well, caching just 4 extra points (Single vartype). Mirroring can effect positioning, but I've got that down too

For the Shaped/Region option, here's where I'd like some thoughts. Obviously, I'd like to touch the image just once. Rotation, mirroring, and offsets/shifting are handled without ever touching the image again. But scaling is a concern. Windows regions are lots of rectangles (Long vartype). APIs exist that will scale a region so one doesn't have to retrieve & process the region rects. Scaling causes rounding due to Long vartypes. Rounding results in loss of accuracy for the hit tests, especially with small areas in the region that can get basically zeroed out.

I am against caching the full-size region just to scale it, as needed, when the image scales. That requires keeping 2 regions and each region can contain 100's/1000's of rectangle structures. I don't like the idea of retrieving & processing each rectangle or doing hit testing on each. Ideas? Currently, I'm stuck with re-scanning the image whenever scale changes to re-create the region (on demand). Not a horrible predicament, but would like better.

[DataMiser]

I don't do much with graphics but the first thing that comes to mind is getpixel. Would this work for your needs? Would it be fast enough?

[LaVolpe]

See, I knew I wouldn't predict everyone's questions. And I failed to give you a key piece of info. The image can contain transparency. In either case, the answer is no, unfortunately. GetPixel will always return a value, whether it is from the image or the container/another image under any transparent areas. Didn't mention this, but the control is windowless, so it doesn't even have a DC.

Edited: Also didn't mention this either... The rendered image is not cached. It is drawn from the full-size image & scaled on the fly

Though, after putting all this down in words, maybe the solution is not to try to scale, rotate, shift the point to the current image scale for regions, but rather to scale the point to the full size image/region. That would allow me to keep one region and not have to touch the image more than once. Whether the image is 1000x1000 or scaled to 100x100, theoretically, it has the same number of rectangles in the region, just scaled differently. I know that isn't exactly true because if you scale down enough, then some of the rectangles would get merged if a new region were created. But worth sleeping on.

Maybe I had a good idea & algo, but went the wrong direction: towards dynamic scale vs static actual size. It's all just a matter of relativity regarding how the space/scale the X,Y coordinate is treated in

[georgekar]

@Lavolpe,
In M2000 code there is code to make region from a bitmap (isn't mine code, the base of code,..I found it). I use that for layers (pictureboxes) as sprites. But I can't use rotation because, a transparent and rotated bitmap must have semi transparent bits. So with regions we haven't this. I change slight the code to make region so we can make a region not only using a color but using a region of colors, form that color, by setting a number only.
By this system we have a hit test when using the mouse event over the picturebox.

So if you don't use a picturebox then do this:
Use another bitmap and there draw a black region in a white background, as the region you have. You know if you have a hit when you check the normal hit with a pixel from that bitmap, at same relative coordinates. If you get white pixel then cancel the hit.

[LaVolpe]

Thank you. But I do not want to cache additional GDI resources for hit testing only.

P.S. Years ago, I developed what I think, is one of the fastest bitmap to region creators in VB.

Regions can contain transparent areas. Regions can be rotated with API, don't have to do it manually.

I think I may have solved my problem/challenge. Will test it later & post back, resolve, if it is suitable for my needs

[Tanner_H]

Maybe too late if you already have a solution (or maybe this is your solution!), but why not use a GDI+ region instead of a GDI region?

GdipIsVisibleRegionPoint asks for four inputs: a region handle, an (x, y) coord to test, and a graphics container. The graphics container contains any translations you want applied (rotation, mirroring, etc).

The nice thing about this solution is not having to permanently apply any rotation/mirroring/scaling transforms to the region itself, which reduces the risk of precision loss due to repeat transforms.

[LaVolpe]

Think I have a good solution where I only need to touch the image once for regions...

1) Create region based off of full-scale, unscaled, image
2) Do hit test on bounding scaled, rotated, shifted rectangle using method described in post#1 for rects
3) If bounding hit test succeeds, scale point to actual size image & test for point in region

This solution does require me to cache or recalc the scale ratio between full-size & rendered-size. But that's a small trade-off IMO vs dealing with scaling/rotating regions or recreating regions due to scaling.

[georgekar]

You don't have to use more gdi32 recourses. You have to hold only an array of dib pixels. This is not the same as with the use of a DC.
If you have an example with the api rotation of a region...make it public...here.

[LaVolpe]

You don't have to use more gdi32 recourses. You have to hold only an array of dib pixels. This is not the same as with the use of a DC.
If you have an example with the api rotation of a region...make it public...here.

Considering your pixel array, but gonna be a conflict for me: potentially 10s of 1000s of pixels (and compressing to 1-bit could be time consuming) or significantly less rectangle structures? I'm interested and have to play with it a bit.

Regarding example of rotating a region with APIs? Don't have sample on this PC. However, if you are familiar with the Matrix object in GDI+, the XForm UDT in Windows is very similar. You would fill out the 1st 4 XFORM members and pass it to ExtCreateRegion API. Note that there is a step required before hand, need to get the rectangles from the region first via the GetRegionData API. Calling ExtCreateRegion creates a new region

Tip: The XFORM members must be declared as Single, not Double. You will find various examples of it declared incorrectly

[LaVolpe]

George, I did find an example in some other old code I have.

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ExtCreateRegion Lib "gdi32.dll" (ByRef lpXform As Any, ByVal nCount As Long, lpRgnData As Any) As Long
Private Declare Function GetRegionData Lib "gdi32.dll" (ByVal hRgn As Long, ByVal dwCount As Long, ByRef lpRgnData As Any) As Long
Private Type XFORM  ' used for stretching/skewing a region
    eM11 As Single  ' note: some versions of this UDT have
    eM12 As Single  ' the elements as double -- wrong!
    eM21 As Single
    eM22 As Single
    eDx As Single
    eDy As Single
End Type


Public Function RotateRegion(hRgn As Long, Angle As Single, bDestroySrcRgn As Boolean) As Long

    Dim uXF As XFORM
    Dim d2R As Single, rData() As Byte, rSize As Long
    
    d2R = 3.14159265358979 / 180!  ' tip: PI = Atn(1)*4
    uXF.eM11 = Cos(Angle * d2R)
    uXF.eM12 = Sin(Angle * d2R)
    uXF.eM21 = -uXF.eM11
    uXF.eM22 = uXF.eM12
    
    rSize = GetRegionData(hRgn, rSize, ByVal 0&)
    ReDim rData(0 To rSize - 1)
    Call GetRegionData(hRgn, rSize, rData(0))
    RotateRegion = ExtCreateRegion(uXF, rSize, rData(0))
    
    If bDestroySrcRgn Then DeleteObject hRgn
    
End Function

Edited
You may wonder why I was avoiding rotating the region? Let's look at this example and it will be self-evident:

A simple rectangle region (50x100) consists of 48 bytes of memory: a 32 byte header + 16 bytes to describe the area of the region. Since the region is just a rectangle, only need 16 bytes (or 1 regional rectangle) to describe the entire region.

Now what happens when we rotate it 45 degrees? That simple regional rectangle became 105 rectangles, for a total of 1,712 bytes of memory.

[georgekar]

This is from M2000,and this has a cDiBSection as input...a backcolor that will be total transparent and a Range as optional. If we use range then we make total transparent more pixels.
See the CombineRgn. We do an OR operation so all small regions became a big one...It is not as fast I want, but is not a slow operation.

Public Function fRegionFromBitmap(picSource As cDIBSection, Optional lBackColor As Long = &HFFFFFF, Optional RANGE As Integer = 0) As Long
Dim lReturn   As Long
Dim lRgnTmp   As Long
Dim lSkinRgn  As Long
Dim lStart    As Long
Dim lRow      As Long
Dim lCol      As Long
'............
Dim bDib() As Byte
Dim tSA As SAFEARRAY2D
    With tSA
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = picSource.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = picSource.BytesPerScanLine()
        .pvData = picSource.DIBSectionBitsPtr
    End With
    CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4
'.........................
Dim BR As Integer, BG As Integer, BBb As Integer, ba$
ba$ = Hex$(lBackColor)
ba$ = Right$("00000" & ba$, 6)
BR = Val("&h" & Mid$(ba$, 1, 2))
BG = Val("&h" & Mid$(ba$, 3, 2))
BBb = Val("&h" & Mid$(ba$, 5, 2))

'..................................
Dim mmx As Long, mmy As Long, cc As Long

Dim GLHEIGHT, GLWIDTH As Long
    GLHEIGHT = picSource.Height
    GLWIDTH = picSource.Width
lSkinRgn = CreateRectRgn(0, 0, 0, 0)
  mmy = GLHEIGHT
    For lRow = 0 To GLHEIGHT - 1
        lCol = 0
        mmx = 0
      mmy = mmy - 1
        Do While lCol < GLWIDTH
            ' Skip all pixels in a row with the same
            ' color as the background color.
            '
            Do While lCol < GLWIDTH
            If Abs(bDib(mmx, mmy) - BR) > RANGE Or Abs(bDib(mmx + 1, mmy) - BG) > RANGE Or Abs(bDib(mmx + 2, mmy) - BBb) > RANGE Then Exit Do
                lCol = lCol + 1
                mmx = mmx + 3
            Loop

            If lCol < GLWIDTH Then
                '
                ' Get the start and end of the block of pixels in the
                ' row that are not the same color as the background.
                '
                lStart = lCol
                Do While lCol < GLWIDTH
                If Not (Abs(bDib(mmx, mmy) - BR) > RANGE Or Abs(bDib(mmx + 1, mmy) - BG) > RANGE Or Abs(bDib(mmx + 2, mmy) - BBb) > RANGE) Then Exit Do

                mmx = mmx + 3
                    lCol = lCol + 1
                Loop
                If lCol > GLWIDTH Then lCol = GLWIDTH
                '
              
                lRgnTmp = CreateRectRgn(lStart, lRow, lCol, lRow + 1)
                lReturn = CombineRgn(lSkinRgn, lSkinRgn, lRgnTmp, RGN_OR)
                Call DeleteObject(lRgnTmp)
            End If
        Loop
    Next

    CopyMemory ByVal VarPtrArray(bDib), 0&, 4
fRegionFromBitmap = lSkinRgn

End Function

So I finish with that
Call SetWindowRgn(hwnd, myrgn, True)
So my sprite has a region to define the form of the picturebox..

So I have to make a new region and set this new to window, and now I can rotate it....I will try

[georgekar]

I use this to reset the region

Sub RsetRegion(ob As Control)
With ob

Call SetWindowRgn(.hwnd, (0), False)
End With
End Sub

[georgekar]

A quick adaptation to M2000
I add a parameter (you see the ",20" in player command). I didn't rotate the bitmap, so iI draw on player bitmap by using the layer interface...to send a gradient command (so here I draw one color, from qbcolor(10) to qbcolor(10)).

We see 3 things.
1st the region 0,0 stay there after rotation...(this is bad)
2nd the region because of 1st draw the form rectangle...so we need to move 0,0 to proper position, as left and top most, and after we have to set window region
3rd As I suspected maths are fault. This is as an isometric display, not a rotated one..
So I have to work on it...
This is a good start....

[LaVolpe]

If interested, here is a very fast bitmap to region class. The code has a routine to work around Win98 errors and that can be removed if no longer needed. Win98 is kinda gone for the most part. The only public function has an option to create the region & apply it directly to a window or return the region created. Regions applied to windows must not be destroyed. Read the comments in the code, lots of them

The routine below does not work with 32 bit alpha channel bitmaps. I have a separate routine for that.

Option Explicit

Private Declare Function IsWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function CombineRgn Lib "gdi32.dll" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetGDIObject Lib "gdi32.dll" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetDIBits Lib "gdi32.dll" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long 'also used in clsBarColors
Private Declare Function SetWindowRgn Lib "user32.dll" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetRect Lib "user32.dll" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function ExtCreateRegion Lib "gdi32.dll" (ByRef lpXform As Any, ByVal nCount As Long, lpRgnData As Any) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type BITMAPINFOHEADER '40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors() As Long
End Type
Private Const BI_RGB As Long = 0&
Private Const OBJ_REGION As Long = 8&
Private rgnRects() As RECT
Private gpBytes() As Byte

Public Function RegionFrom24bitBitmap(ByVal hBitmap As Long, _
        Optional ByVal hWndToApply As Long, _
        Optional ByVal transColor As Long = -1&, _
        Optional ByVal returnAntiRegion As Boolean) As Long

'*******************************************************
' FUNCTION RETURNS.
' 1. If hWndToApply is zero, the shaped region handle is returned
' 2. Otherwise, a non-zero value indicates region created & applied
'    to the passed window handle
'*******************************************************

' Also see CreateRegion & ImportRegion for other ways to create/re-use regions

' PARAMETERS
'=============
' hBitmap (Required) : handle to a bitmap to be used to create the region
' Optional hWndToApply : hWnd to assign the shaped region to
' Optional transColor : the transparent color, if -1, then top/left corner is used
' Optional returnAntiRegion : If False (default) then the region excluding transparent
'       pixels will be used/returned.  If True, then the region including only
'       transparent pixels will be used/returned

    ' test for required variable first
    If hBitmap = 0& Then Exit Function
    ' if applying to a window, ensure the value passed is a window
    If hWndToApply <> 0& Then
        If IsWindow(hWndToApply) = 0& Then Exit Function
    End If
    
    ' now ensure hBitmap handle passed is a usable bitmap
    Dim bmpInfo As BITMAPINFO
    If GetGDIObject(hBitmap, Len(bmpInfo), bmpInfo) = 0& Then Exit Function
    
    ' declare bunch of variables...
    Dim rectCount As Long ' number of rectangles & used to increment above array
    Dim lScanLines As Long ' used to size the DIB bit array
    Dim rtnRegion As Long ' region handle returned by this function if appropriate
    Dim dibDC As Long ' DC to use for GetDIBits
   
    On Error GoTo CleanUp
      
    With bmpInfo.bmiHeader
    
        .biHeight = Abs(.biHeight) ' per msdn the .biHeight may be negative already
        
        ' Scans must align on dword boundaries:
        lScanLines = (.biWidth * 3& + 3&) And &HFFFFFFFC
        ReDim gpBytes(0 To lScanLines - 1&, 0 To .biHeight - 1&)
        
        ' build the DIB header
       .biSize = Len(bmpInfo.bmiHeader)
       .biBitCount = 24
       .biPlanes = 1
       .biCompression = BI_RGB
       .biClrUsed = 0&
       .biClrImportant = 0&
       .biSizeImage = 0&
       .biHeight = -.biHeight
        ' ^^ most DIBs are bottom:top, by using negative Height it will load top:bottom
    End With
    
    ' get the image into DIB bits,
    dibDC = GetDC(0&)
    ' note that biHeight above was changed to negative so we reverse it form here
    If GetDIBits(dibDC, hBitmap, 0&, -bmpInfo.bmiHeader.biHeight, gpBytes(0, 0), bmpInfo, 0&) = 0& Then
        Erase gpBytes()
        ReleaseDC 0&, dibDC
        Exit Function
    End If
    ReleaseDC 0&, dibDC 'failure to release DC can leak or removes limited shared DCs
        
    ' now calculate the transparent color as needed
    If transColor = -1 Then
        ' when -1 is passed, use top left corner pixel color
        transColor = gpBytes(0, 0) Or (gpBytes(1, 0) * 256&) Or (gpBytes(2, 0) * 65536)
    Else
        ' convert vbSystemColor if possible
        If transColor < 0& Then transColor = GetSysColor(transColor And &HFF&)
        ' typical DIBs are stored as BGR vs RGB
        ' convert to BGR vs converting each bitmap pixel to RGB for comparison
        transColor = ((transColor And &HFF&) * &H10000) Or _
            (((transColor And &HFF00&) \ &H100&) * &H100&) Or _
            ((transColor And &HFF0000) \ &H10000)
    End If
        
    ' Process the bitmap bytes
    With bmpInfo.bmiHeader
     
        .biHeight = Abs(.biHeight)
         ' start with an arbritray number of rectangles
        ReDim rgnRects(0 To .biWidth * 3)
            
        ' process from top to bottom of the bitmap
        c_ScanSection24 .biWidth, .biHeight, transColor, returnAntiRegion, rectCount
        
    End With
    
    On Error Resume Next
    ' check for failure & engage backup plan if needed
    If rectCount Then
    
        ' there were regional rectangles identified, try to create the region
        rtnRegion = c_CreatePartialRegion(2&, rectCount + 1&, 0&, bmpInfo.bmiHeader.biWidth)

        ' ok, now to test whether or not we are good to go...
        ' if less than 2000 rectangles, function should have worked & if it didn't
        ' it wasn't due O/S restrictions -- failure

        If rtnRegion = 0& And rectCount > 2000& Then
            rtnRegion = c_CreateWin9xRegion(rectCount + 1&, 0&, bmpInfo.bmiHeader.biWidth)
            ' ^^ if rtnRegion is zero; windows could not create the region
        End If
    
    End If
    
CleanUp:
    
    Erase gpBytes  ' no longer needed; we can purge it now
    Erase rgnRects() ' no longer needed; we can purge it now
    
    If Err Then
        If rtnRegion <> 0& Then DeleteObject rtnRegion
        Err.Clear
        ' return value for this function is now zero
    Else
        If hWndToApply <> 0& Then
            RegionFrom24bitBitmap = SetWindowRgn(hWndToApply, rtnRegion, True)
            ' ^^ if above API call fails, return value will be zero
        Else
            RegionFrom24bitBitmap = rtnRegion
            ' ^^ return handle to the shaped region
        End If
    End If

End Function


Private Sub c_ScanSection24(ByVal Cx As Long, ByVal Cy As Long, _
                         ByVal transColor As Long, ByVal returnAntiRegion As Boolean, _
                         ByRef rectCount As Long)

' function added as an extension of the main routine; therefore, some of the
' user passed variables are also passed here too

' This function will scan a specific number of bitmap lines and can skip over
' a continguous section of pixels identified by the exclusion rectangle.
' Note the complexity below. The exlusion rectangle may not be aligned with
' any of the edges of the bitmap so we may have to process pixels left, right,
' above and below the exclusion rectangle.

' See RegionFromBitmap additional remarks about the exclusion rectangle

    Dim scanX As Long, scanY As Long    ' simple loop variables
    Dim tgtColor As Long                ' a DIB pixel color (BGR format)
    Dim rStart As Long                  ' rectangle tracking started
    Dim maxRectCount As Long            ' UBound(rgnRects)
    
    ' reset flag
    rStart = -1&
    maxRectCount = UBound(rgnRects)
    
    ' begin pixel by pixel comparisons
    For scanY = 0 To Cy - 1&
    
        For scanX = 0 To Cx - 1&
            ' my hack continued: we already saved a long as BGR, now
            ' get the current DIB pixel into a long (BGR also) & compare
            CopyMemory tgtColor, gpBytes(scanX * 3&, scanY), &H3
            
            ' test to see if next pixel is a target color
            If (transColor = tgtColor) Xor returnAntiRegion Then
            
                If rStart > -1& Then ' we're currently tracking a rectangle, so let's close it
                    ' see if array needs to be resized
                   If rectCount + 1& = maxRectCount Then
                        maxRectCount = UBound(rgnRects) + Cx
                        ReDim Preserve rgnRects(0 To maxRectCount)
                    End If
                    
                    ' add the rectangle to our array
                    SetRect rgnRects(rectCount + 2&), rStart, scanY, scanX, scanY + 1&
                    rStart = -1& ' reset flag
                    rectCount = rectCount + 1&     ' keep track of nr in use
                End If
            
            Else
                ' not a target color
                If rStart = -1& Then rStart = scanX ' set start point
            
            End If
        Next scanX
        
        If rStart > -1& Then
            ' got to end of section without hitting another transparent pixel
            ' but we're tracking so we'll close rectangle now
           
            ' see if array needs to be resized
            If rectCount + 1& = maxRectCount Then
                 maxRectCount = UBound(rgnRects) + Cx
                 ReDim Preserve rgnRects(0 To maxRectCount)
             End If
            ' add the rectangle to our array
            SetRect rgnRects(rectCount + 2&), rStart, scanY, scanX, scanY + 1&
            rStart = -1& ' reset flag
            rectCount = rectCount + 1&     ' keep track of nr in use
        End If
        
    Next scanY

End Sub

Private Function c_CreateWin9xRegion(ByVal rectCount As Long, ByVal leftOffset As Long, ByVal Cx As Long, Optional ByVal xFrmPtr As Long) As Long
' Win98 has problems with regional rectangles over 4000
' So, we'll try again in case this is the prob with other systems too.
' We'll step it at 2000 at a time which is stil very fast

    Dim X As Long, Y As Long ' loop counters
    Dim win9xRgn As Long     ' partial region
    Dim rtnRegion As Long    ' combined region & return value of this function
    
    ' we start with 2 'cause first 2 RECTs are the header
    For X = 2& To rectCount Step 2000&
    
        If X + 2000& > rectCount Then
            Y = rectCount
        Else
            Y = X + 2000&
        End If
        
        ' attempt to create partial region
        win9xRgn = c_CreatePartialRegion(X, Y, leftOffset, Cx, xFrmPtr)
        
        If win9xRgn = 0& Then    ' failure
            ' clean up combined region if needed
            If rtnRegion Then DeleteObject rtnRegion
            rtnRegion = 0&
            Exit For ' abort
        Else
            If rtnRegion Then ' already started
                ' use combineRgn, but only every 2000th time
                CombineRgn rtnRegion, rtnRegion, win9xRgn, RGN_OR
                DeleteObject win9xRgn
            Else    ' first time thru
                rtnRegion = win9xRgn
            End If
        End If
    Next
    ' done; return result
    c_CreateWin9xRegion = rtnRegion

End Function

Private Function c_CreatePartialRegion(ByVal lIndex As Long, ByVal uIndex As Long, ByVal leftOffset As Long, ByVal Cx As Long, Optional ByVal xFrmPtr As Long) As Long

    ' Creates a region from a Rect() array and optionally stretches the region

    On Error Resume Next
    ' Note: Ideally, contiguous rows vertically of equal height & width should
    ' be combined into one larger row. However, thru trial & error I found
    ' that Windows does this for us and taking the extra time to do it ourselves
    ' is too cumbersome & slows down the results.
    
    ' the first 32 bytes of a region contain the header describing the region.
    ' Well, 32 bytes equates to 2 rectangles (16 bytes each), so I'll
    ' cheat a little & use rectangles to store the header
    With rgnRects(lIndex - 2&) ' bytes 0-15
        .Left = 32                      ' length of region header in bytes
        .Top = 1                        ' required cannot be anything else
        .Right = uIndex - lIndex + 1&   ' number of rectangles for the region
        .Bottom = .Right * 16&          ' byte size used by the rectangles;
    End With                            ' ^^ can be zero & Windows will calculate
    
    With rgnRects(lIndex - 1&) ' bytes 16-31 bounding rectangle identification
        .Left = leftOffset                  ' left
        .Top = rgnRects(lIndex).Top         ' top
        .Right = leftOffset + Cx            ' right
        .Bottom = rgnRects(uIndex).Bottom   ' bottom
    End With
    ' call function to create region from our byte (RECT) array
    c_CreatePartialRegion = ExtCreateRegion(ByVal xFrmPtr, (rgnRects(lIndex - 2&).Right + 2&) * 16&, rgnRects(lIndex - 2&))
    If Err Then Err.Clear

End Function

[georgekar]

I will see that (I have to make it for mine cDIBsection...to work) but as I see you work with a RECT array so you make from that a region.
The method I show you not need memory because each time OR a small one to old one..but OR is good for overlapping...Here we have added regions where no overlapping occur. So your method probably is faster.

[LaVolpe]

Yes, my method goes low level. It creates the region structure similar to how Windows creates a region. Therefore, it is very fast when sent to the API to actually create a region handle. The logic and looping is efficient also and the real speed comes by not combining multiple regions into one. Just one region in one call.

[georgekar]

ok I put your method in M2000 revision 11 (not publish yet). I didn't use the hack for BGR color because I use a range so for any R G B value the range is compare with each pixel in the bitmap (I use the cDibSection no the picture as in your code). And I make a scaleRegion function so always I make the region using the pixels in bitmap and after I do the rescale to bitmap and to region.
I am working now to find the best solution for rotate the region..(rotation may expand the frame of the sprite).
But thank you. I check the code and is fast...we can't notice any delay..Before was a problem in some cases..

[LaVolpe]

Rotation will almost always expand the image's frame. 3 ways of dealing with that:

1) Make the frame large enough to rotate at all angles: Sqr(imgW*imgW+imgH*imgH)

2) Make the image small enough to rotate at all angles within the frame
maxSize = Sqr(imgW*imgW+imgH*imgH)
proportionally scale maxSize to your frame
that scale can be applied to the image & now it should rotate freely within the frame

3) Scale the image when angle changes. Ugly solution as image changes scale during rotation

[georgekar]

I have software sprites in m2000 that have the hot spot in the center. The players (or layers if we see with the second interface) have a hot spot in the left top pixel.
Is not finished yet but now this can rotate the right way (but from the top left corner...so i try some maths...to do a perfect rotation)

Public Function RotateRegion(hRgn As Long, Angle As Single, bDestroySrcRgn As Boolean, piw As Long, pih As Long) As Long

' Lavolpe routine
    Dim uXF As XFORM
    Dim d2R As Single, rData() As Byte, rSize As Long
   Angle = (CLng(Angle!) Mod 360) / 180# * Pi

    uXF.eM11 = Cos(Pi / 4 + Angle)
    uXF.eM12 = Sin(Pi / 4 + Angle)
    uXF.eM21 = -Cos(Pi / 4 - Angle)
    uXF.eM22 = Sin(Pi / 4 - Angle)


    rSize = GetRegionData(hRgn, rSize, ByVal 0&)
    
    ReDim rData(0 To rSize - 1)
    Call GetRegionData(hRgn, rSize, ByVal VarPtr(rData(0)))
    RotateRegion = ExtCreateRegion(ByVal VarPtr(uXF), rSize, ByVal VarPtr(rData(0)))
    
    If bDestroySrcRgn Then DeleteObject hRgn
    
End Function

[LaVolpe]

Not quite my routine, my looked like this

    d2R = 3.14159265358979 / 180!  ' tip: PI = Atn(1)*4
    uXF.eM11 = Cos(Angle * d2R)
    uXF.eM12 = Sin(Angle * d2R)
    uXF.eM21 = -uXF.eM11
    uXF.eM22 = uXF.eM12

If you want to rotate from center, you'll want to move the region which can be done with OffsetRgn API or offset the hDC which can be done with SetWindowOrgEx. The GetRgnBox API will give you the bounding rectangle of the region

[LaVolpe]

Maybe too late if you already have a solution (or maybe this is your solution!), but why not use a GDI+ region instead of a GDI region?

Nice idea. Will look into it. I won't have a graphics container & could be a deal breaker (we'll see). The control only uses a graphics object in some specific scenarios. Over 95% of drawing is done with the Image handle, and being a VB control, rendering occurs on a GDI DC, creating a graphics object on demand for only that purpose & immediately released since I don't own the destination DC.

That was fast. Popped up the API docs for that GDI+ function & the graphics handle is optional. I'm liking that idea more & more. Only real reason I use a region is for hit testing, not drawing/clipping

[georgekar]

This works fine if piw=pih, so if we have a square sprite. We do a 1/1.3 down scale...and we can rotate using the middle pixel as the center of rotation.

Myw and Myh are the size of the new "expanded" frame. But we need this to shrink to fit in the basic frame width sixes piw and pih.(all in pixels). With a ratio 1/1.3 we have a rotating square always in the basic frame
If piw<>pih then there is a fault in uXF.eDx and uXF.eDy. I can't figure yet...but I found...Also the factor k=5 is hypothetical as needed, but I have to find the formula to achieve the best.

Public Function RotateRegion(hRgn As Long, Angle As Single, bDestroySrcRgn As Boolean, piw As Long, pih As Long) As Long
Dim myw As Long, myh As Long, maxmy As Long
Dim K As Single, r As Single
 Angle = (CLng(Angle!) Mod 360) / 180# * Pi
myw = Int((Abs(piw * Cos(Angle!)) + Abs(pih * Sin(Angle!))))

myh = Int((Abs(piw * Sin(Angle!)) + Abs(pih * Cos(Angle!))))
If piw = pih Then
K = 1.3
myh = myh / (myw / piw) / K
myw = piw / K
r = 1 / K
Else
K = 5

If piw / pih Then
myw = myw / (myh / pih) / K
myh = pih / K
Else
myh = myh / (myw / piw) / K
myw = piw / K
End If
r = 1 / K
End If

  hRgn = ScaleRegion(hRgn, r)

Dim image_x As Long, image_y As Long
    r = Atn(myw / myh)
    K = -myw / (2# * Sin(r))
' Lavolpe routine
    Dim uXF As XFORM
    Dim d2R As Single, rData() As Byte, rSize As Long
    uXF.eM11 = Cos(Angle)
    uXF.eM12 = Sin(Angle)
    uXF.eM21 = -Sin(Angle)
    uXF.eM22 = Cos(Angle)

    uXF.eDx = CLng(myw / 2 - K * Sin(Angle! - r)) + (piw - myw) / 2
    uXF.eDy = CLng(myh / 2 + K * Cos(Angle! - r)) + (pih - myh) / 2
    rSize = GetRegionData(hRgn, rSize, ByVal 0&)
    
    ReDim rData(0 To rSize - 1)
    Call GetRegionData(hRgn, rSize, ByVal VarPtr(rData(0)))
    RotateRegion = ExtCreateRegion(ByVal VarPtr(uXF), rSize, ByVal VarPtr(rData(0)))
    
    If bDestroySrcRgn Then DeleteObject hRgn
    
End Function
Public Function ScaleRegion(hRgn As Long, Size As Single) As Long
  Dim uXF As XFORM
    Dim d2R As Single, rData() As Byte, rSize As Long

    uXF.eM11 = Size
    uXF.eM12 = 0
    uXF.eM21 = 0
    uXF.eM22 = Size

    uXF.eDx = 0
    uXF.eDy = 0
    rSize = GetRegionData(hRgn, rSize, ByVal 0&)
    
    ReDim rData(0 To rSize - 1)
    Call GetRegionData(hRgn, rSize, ByVal VarPtr(rData(0)))
    ScaleRegion = ExtCreateRegion(ByVal VarPtr(uXF), rSize, ByVal VarPtr(rData(0)))
    
     DeleteObject hRgn
End Function

I made a simple m2000 program to check the results..
I run this from IDE and it is fast..
If I uncomment the copy 3000,3000 to a$ then I have a 3000x3000 bitmap (M2000 use twips). Look the image. Because I have not yet rotate the image (only the region), I use a gradient fill to show something..using the layer interface.

refresh 200
player 0
a$=""
move 0,0
\* copy 3000,3000 to a$
copy 3000,1000 to a$
player 1, 3000,1000 use a$,1,0 size 2
layer 1 {
      gradient 10,12
}
PLAYER 1 SHOW
for i =1 to 360 {
refresh 0
player 1, 3000,1000 use a$,1,0, -I size 2
layer 1 {
      gradient 10,12
}
print i
refresh
}

[LaVolpe]

Here are some scaling functions I use in a module. The functions are for proportional scaling only, rotated or not, and have some other options. Feel free to cherry pick what you want

Examples:

1) Proportionally scale an image at 45 degrees to the frame:

GetScaledImageSizes(picW, picH, frameW, frameH, [outScaledWidth], [outScaledHeight], 45)

2) Get size of frame needed for a scaled image at -45 degrees:

GetScaledCanvasSize(picW, picH, [outFrameW], [outFrameH], -45)

Public Const gDegreeToRadian As Double = 1.74532925199433E-02 ' (Atn(1)*4)/180 or (PI/180)

Public Function GetScaledCanvasSize(ByVal Width As Single, ByVal Height As Single, _
                                    ByRef CanvasWidth As Variant, ByRef CanvasHeight As Variant, _
                                    Optional ByVal Angle As Single = 0!, _
                                    Optional ByVal SizeLimit As Long = &H3FFF&) As Boolean

    ' function calculates minimium size needed to contain an object rotated at any angle
    ' All values, except Angle, sent to this function are user-defined, i.e., pixels, twips, etc
    ' The optional SizeLimit parameter is defaulted to VB's max size, in pixels, for a control
    '   Passing zero for this parameter removes any limitation on the values returned
    
    If (Width < 1! Or Height < 1!) Then Exit Function
    
    Dim sinT As Single, cosT As Single
    Dim ctrX As Single, ctrY As Single
    Dim a As Single

    If Angle = 0! Then
        CanvasWidth = Width
        CanvasHeight = Height
    Else
        a = NormalizeRotation(Angle)
        If a < 0! Then a = 360! + a
        Select Case a
            Case Is < 91!
            Case Is < 181!: a = 180! - a
            Case Is < 271!: a = a - 180!
            Case Else: a = 360! - a
        End Select
        sinT = Sin(a * gDegreeToRadian)
        cosT = Cos(a * gDegreeToRadian)
        
        ctrX = (Width - 1!) / 2!
        ctrY = (Height - 1!) / 2!
    
        a = (-ctrX * sinT) + (-ctrY * cosT)
        a = (Width - ctrX - 1!) * sinT + (Height - ctrY - 1!) * cosT - a
        CanvasHeight = CLng(a)
        
        a = ((-ctrX * cosT) - (Height - ctrY - 1!) * sinT)
        a = (Width - ctrX - 1!) * cosT - (-ctrY * sinT - 1!) - a
        CanvasWidth = CLng(a)
    End If
    
    If SizeLimit > 0& Then
        If CanvasHeight > SizeLimit Or CanvasWidth > SizeLimit Then
            If CanvasHeight > CanvasWidth Then
                a = SizeLimit / CanvasHeight
            Else
                a = SizeLimit / CanvasWidth
            End If
            CanvasWidth = CLng(CanvasWidth * a)
            CanvasHeight = CLng(CanvasHeight * a)
        End If
    End If
    
    GetScaledCanvasSize = True
    
End Function

Public Function GetScaledImageSizes(ByVal Width As Single, ByVal Height As Single, _
                                    ByVal TargetWidth As Single, ByVal TargetHeight As Single, _
                                    ByRef ScaledWidth As Variant, ByRef ScaledHeight As Variant, _
                                    Optional ByVal Angle As Single = 0!, _
                                    Optional ByVal CanScaleUp As Boolean = True, _
                                    Optional ByVal SizeLimit As Long = &H3FFF&) As Boolean

    ' Function returns scaled (maintaining scale ratio) for passed destination width/height
    ' The CanScaleUp when set to false will not return scaled sizes > than 1:1
    ' The scaled width & height returned in the ScaledWidth & ScaledHeight parameters
    ' All values, except Angle, sent to this function are user-defined, i.e., pixels, twips, etc
    ' The optional SizeLimit parameter is defaulted to VB's max size, in pixels, for a control
    '   Passing zero for this parameter removes any limitation on the values returned
    ' If function returns false, return parameters are undefined
    
    Dim xRatio As Single, yRatio As Single
    Dim sinT As Single, cosT As Single
    Dim h1 As Long, h2 As Long, a As Single
    
    If (Width < 1! Or Height < 1!) Then Exit Function
    If (TargetWidth < 1! Or TargetHeight < 1!) Then Exit Function

    xRatio = TargetWidth / Width
    yRatio = TargetHeight / Height
    If xRatio > yRatio Then xRatio = yRatio
    
    If xRatio = 1 And Angle = 0! Then
        ScaledWidth = Width
        ScaledHeight = Height
    Else
        ScaledWidth = CLng(Width * xRatio)
        ScaledHeight = CLng(Height * xRatio)
    
        If Not Angle = 0! Then
            a = NormalizeRotation(Angle)
            If a < 0! Then a = 360! + a
            Select Case a
                Case Is < 91!
                Case Is < 181!: a = 180! - a
                Case Is < 271!: a = a - 180!
                Case Else: a = 360! - a
            End Select
            sinT = Sin(a * gDegreeToRadian)
            cosT = Cos(a * gDegreeToRadian)
    
            h1 = TargetHeight * TargetHeight / (ScaledWidth * sinT + ScaledHeight * cosT)
            h2 = TargetWidth * TargetHeight / (ScaledWidth * cosT + ScaledHeight * sinT)
            If h1 < h2 Then h2 = h1
            h1 = h2 * TargetWidth / TargetHeight
        
            xRatio = h1 / Width
            yRatio = h2 / Height
            If xRatio > yRatio Then xRatio = yRatio
            If CanScaleUp = False Then
                If xRatio > 1! Then xRatio = 1!
            End If
            ScaledWidth = CLng(Width * xRatio)
            ScaledHeight = CLng(Height * xRatio)
        End If
        
    End If
    
    If SizeLimit > 0& Then
        If ScaledHeight > SizeLimit Or ScaledWidth > SizeLimit Then
            If ScaledHeight > ScaledWidth Then
                xRatio = SizeLimit / ScaledHeight
            Else
                xRatio = SizeLimit / ScaledWidth
            End If
            ScaledWidth = CLng(ScaledWidth * xRatio)
            ScaledHeight = CLng(ScaledHeight * xRatio)
        End If
    End If
    
    GetScaledImageSizes = True

End Function

Surprised no one posted back that I failed to provide the NormalizeRotation support function...

Public Function NormalizeRotation(Angle As Single) As Single
'*************************************************************************************************
' Returns any value, normalized in the range of -359.999... to +359.999...
'*************************************************************************************************
    If Not Angle = 0! Then
        If Abs(Angle) >= 360! Then
            NormalizeRotation = (Int(Angle) Mod 360) + CCur(Angle) - Int(Angle)
        Else
            NormalizeRotation = Angle
        End If
    End If
End Function

[LaVolpe]

And here's one more that may be useful

1) Get size of frame needed to rotate an image in all possible angles

GetScaledSizeAllAngles(imgW, imgH, 0, 0, [outFrameWidth], [outFrameHeight])

2) Get maximum image size to allow rotation in all possible angles without increasing frame size

GetScaledSizeAllAngles(imgW, imgH, frameW, frameH, [outScaledWidth], [outScaledHeight])

Public Function GetScaledSizeAllAngles(ByVal Width As Single, ByVal Height As Single, _
                                       ByVal CanvasWidth As Single, ByVal CanvasHeight As Single, _
                                       ScaledWidth As Single, ScaledHeight As Single, _
                                       Optional ByVal CanScaleUp As Boolean = True) As Boolean
    
    ' function calculates maximum scaled size of an object to be rotated
    '   on a canvas without resizing the canvas
    ' All values sent to this function are user-defined, i.e., pixels, twips, etc
    ' The CanScaleUp when set to false will never return scaled sizes > than 1:1
    
    ' Note:
    '   Passing 0 for CanvasWidth and/or CanvasHeight will return the overall size
    '       of the Canvas needed to rotate passed Width/Height at any angle. In this case,
    '       the ScaledWidth,ScaledHeight parameter are equal & refer to the canvas.
    '   Passing non-zero values returns ScaledWidth,ScaledHeight relative to the passed
    '       Width,Height parameters and each are scaled individually

    If (Width < 1! Or Height < 1!) Then Exit Function
    
    Dim xyRatio As Single
    
    xyRatio = Sqr(Width * Width + Height * Height)
    If Not (CanvasHeight < 1! Or CanvasWidth < 1!) Then
        If CanvasHeight > CanvasWidth Then
            xyRatio = CanvasHeight / xyRatio
        Else
            xyRatio = CanvasWidth / xyRatio
        End If
        If CanScaleUp = False Then
            If xyRatio > 1! Then xyRatio = 1!
        End If
        ScaledWidth = Width * xyRatio
        ScaledHeight = Height * xyRatio
    Else
        ScaledWidth = xyRatio: ScaledHeight = xyRatio
    End If
    GetScaledSizeAllAngles = True

End Function

[georgekar]

I found the optimum solution...
Here is a sprite over scrolling text.


I use a very precise rotation and zoom routine, and I apply your routine after the rotation and scale. I do many tests and this is the best solution. The other thought was to make the region first, next the rotation of the region, next the scale of the region and then there are two possibilities, to rotate and resize in one operation (using the new routine-uses single floating math) and the other was to rotate bitmap in scale x1 and then I rescale it in export to picture box (where we apply the region). I make some try but..the problem was that some part of bitmap are visible....when the region zoom and scaled. not always but some times. So because I want...all time to have the best image, I change it. Is fast enough to pop a sprite at an angle. Then the sprite can stay over the screen or we can move it, or hide..

Public Sub RotateDibNew(cDIBbuffer0 As cDIBSection, Optional ByVal Angle! = 0, Optional ByVal zoomfactor As Single = 1, _
    Optional bckColor As Long = &HFFFFFF)
Angle! = -(CLng(Angle!) Mod 360) / 180# * Pi
On Error Resume Next
If cDIBbuffer0.HDIB = 0 Then Exit Sub
If zoomfactor <= 0.01 Then zoomfactor = 0.01
Dim myw As Single, myh As Single, piw As Long, pih As Long, pix As Long, piy As Long
'Dim a As Single, b As Single
Dim K As Single, r As Single
Dim BR As Byte, BG As Byte, BBb As Byte, ba$
ba$ = Hex$(bckColor)
ba$ = Right$("00000" + ba$, 6)
BR = Val("&h" + Mid$(ba$, 1, 2))
BG = Val("&h" + Mid$(ba$, 3, 2))
BBb = Val("&h" + Mid$(ba$, 5, 2))

    piw = cDIBbuffer0.Width
    pih = cDIBbuffer0.Height
    r = Atn(piw / pih) + Pi / 2!
    K = Abs((piw / Cos(r) / 2!) * zoomfactor)
 Dim cDIBbuffer1 As Object
 Set cDIBbuffer1 = New cDIBSection
Call cDIBbuffer1.Create(piw * zoomfactor, pih * zoomfactor)
cDIBbuffer1.GetDpiDIB cDIBbuffer0
cDIBbuffer0.needHDC
cDIBbuffer1.LoadPictureStretchBlt cDIBbuffer0.HDC1, , , , , pix, piy, piw, pih
cDIBbuffer0.FreeHDC

myw = 2 * K
myh = 2 * K

cDIBbuffer0.ClearUp
If cDIBbuffer0.Create(CLng(Fix(myw)), CLng(Fix(myh))) Then
there:
Dim bDib() As Byte, bDib1() As Byte
Dim X As Long, Y As Long
Dim lc As Long
Dim tSA As SAFEARRAY2D
Dim tSA1 As SAFEARRAY2D
On Error Resume Next
    With tSA
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = cDIBbuffer1.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = cDIBbuffer1.BytesPerScanLine()
        .pvData = cDIBbuffer1.DIBSectionBitsPtr
    End With
    
    CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4
    cDIBbuffer0.WhiteBits
    With tSA1
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = cDIBbuffer0.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = cDIBbuffer0.BytesPerScanLine()
        .pvData = cDIBbuffer0.DIBSectionBitsPtr
    End With
    CopyMemory ByVal VarPtrArray(bDib1()), VarPtr(tSA1), 4

    Dim nx As Long, ny As Long
    Dim image_x As Single, image_y As Single, temp_image_x As Single, temp_image_y As Single
    Dim x_step As Single, y_step As Single, x_step2 As Single, y_step2 As Single
    Dim screen_x As Long, screen_y As Long, mmx As Long, mmy As Long


    Dim dest As Long, pw As Long, ph As Long
   Dim sx As Single, sy As Single
    Dim xf As Single, yf As Single
    Dim xf1 As Single, yf1 As Single
    Dim pws As Single, phs As Single
    pw = cDIBbuffer1.Width
    ph = cDIBbuffer1.Height
    pws = pw
    phs = ph
    Dim pw1 As Long, ph1 As Long
    pw1 = pw - 1
    ph1 = ph - 1
    r = Atn(myw / myh)
    K = -myw / (2# * Sin(r))
   image_x = (pw / 2! - (K * Sin(Angle! - r))) * pw
   image_y = (ph / 2! + (K * Cos(Angle! - r))) * ph
   x_step2 = (Cos(Angle! + Pi / 2!) * pw)
    y_step2 = (Sin(Angle! + Pi / 2!) * ph)

    x_step = Cos(Angle!) * pw
    y_step = Sin(Angle!) * ph

    For screen_y = 0 To Fix(myh) - 1
        temp_image_x = image_x
        temp_image_y = image_y
         For screen_x = 0 To (Fix(myw) - 1) * 3 Step 3
                sx = temp_image_x / pws
                sy = temp_image_y / phs
                mmx = Fix(sx)
                mmy = Fix(sy)

                    If mmx >= 0 And mmx < pw1 And mmy >= 0 And mmy < ph1 Then
             
                      
                     
                
                       xf = (sx - CSng(mmx))
                    xf1 = 1! - xf
                      yf = (sy - CSng(mmy))
                      yf1 = 1! - yf
                          mmx = mmx * 3
                        bDib1(screen_x, screen_y) = yf1 * (xf1 * bDib(mmx, mmy) + xf * bDib(mmx + 3, mmy)) + yf * (xf1 * bDib(mmx, mmy + 1) + xf * bDib(mmx + 3, mmy + 1))
                        bDib1(screen_x + 1, screen_y) = yf1 * (xf1 * bDib(mmx + 1, mmy) + xf * bDib(mmx + 4, mmy)) + yf * (xf1 * bDib(mmx + 1, mmy + 1) + xf * bDib(mmx + 4, mmy + 1))
                        bDib1(screen_x + 2, screen_y) = yf1 * (xf1 * bDib(mmx + 2, mmy) + xf * bDib(mmx + 5, mmy)) + yf * (xf1 * bDib(mmx + 2, mmy + 1) + xf * bDib(mmx + 5, mmy + 1))
                    
                    Else
                        bDib1(screen_x, screen_y) = BR
                        bDib1(screen_x + 1, screen_y) = BG
                        bDib1(screen_x + 2, screen_y) = BBb
                    End If
            temp_image_x = temp_image_x + x_step
            temp_image_y = temp_image_y + y_step
       Next screen_x
        image_x = image_x + x_step2
        image_y = image_y + y_step2
    Next screen_y
    
    CopyMemory ByVal VarPtrArray(bDib), 0&, 4
    CopyMemory ByVal VarPtrArray(bDib1), 0&, 4
    Else
    'bbeep
    End If
Set cDIBbuffer1 = Nothing
End Sub

[georgekar]

I write a new thread about the use of the Lavolpe fast code for regions.
There is a revision 12. In revision 11 was a bug in the rotation algorithm. Because I would like to synchronize the bitmap rotation with the region rotation, I make this special rotation routine. (I have other routine that perform rotation and opacity control with transparent bits..without using alpha channel, but not for this situation).
So in revision 11 the above routine proved a big bug...because an overflow come up. I found the solution...So this is a fast rotation routine with no bugs...
The bug was from the absent of two ABS(), so some times get a negative number...and that cause the overflow. X and yf used for mixing a rotated pixel from four pixels
Here is code for one plane (8 bits, one color).
bDib1(screen_x, screen_y) = yf1 * (xf1 * bDib(mmx, mmy) + xf * bDib(mmx + 3, mmy)) + yf * (xf1 * bDib(mmx, mmy + 1) + xf * bDib(mmx + 3, mmy + 1))

           xf = Abs((sx - CSng(mmx)))
             xf1 = 1! - xf
                      yf = Abs((sy - CSng(mmy)))
                      yf1 = 1! - yf

And here all the code..We can perform zooming and rotation in one step

Public Sub RotateDibNew(cDIBbuffer0 As cDIBSection, Optional ByVal Angle! = 0, Optional ByVal zoomfactor As Single = 1, _
    Optional bckColor As Long = &HFFFFFF)
Angle! = -(CLng(Angle!) Mod 360) / 180# * Pi
On Error Resume Next
If cDIBbuffer0.HDIB = 0 Then Exit Sub
If zoomfactor <= 0.01 Then zoomfactor = 0.01
Dim myw As Single, myh As Single, piw As Long, pih As Long, pix As Long, piy As Long
'Dim a As Single, b As Single
Dim K As Single, r As Single
Dim BR As Byte, BG As Byte, BBb As Byte, ba$
ba$ = Hex$(bckColor)
ba$ = Right$("00000" + ba$, 6)
BR = Val("&h" + Mid$(ba$, 1, 2))
BG = Val("&h" + Mid$(ba$, 3, 2))
BBb = Val("&h" + Mid$(ba$, 5, 2))

    piw = cDIBbuffer0.Width
    pih = cDIBbuffer0.Height
    r = Atn(piw / pih) + Pi / 2!
    K = Abs((piw / Cos(r) / 2!) * zoomfactor)
 Dim cDIBbuffer1 As Object
 Set cDIBbuffer1 = New cDIBSection
Call cDIBbuffer1.Create(piw * zoomfactor, pih * zoomfactor)
cDIBbuffer1.GetDpiDIB cDIBbuffer0
cDIBbuffer0.needHDC
cDIBbuffer1.LoadPictureStretchBlt cDIBbuffer0.HDC1, , , , , pix, piy, piw, pih
cDIBbuffer0.FreeHDC

myw = 2 * K
myh = 2 * K

cDIBbuffer0.ClearUp
If cDIBbuffer0.Create(CLng(Fix(myw)), CLng(Fix(myh))) Then
there:
Dim bDib() As Byte, bDib1() As Byte
Dim X As Long, Y As Long
Dim lc As Long
Dim tSA As SAFEARRAY2D
Dim tSA1 As SAFEARRAY2D
On Error Resume Next
    With tSA
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = cDIBbuffer1.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = cDIBbuffer1.BytesPerScanLine()
        .pvData = cDIBbuffer1.DIBSectionBitsPtr
    End With
    
    CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4
    cDIBbuffer0.WhiteBits
    With tSA1
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = cDIBbuffer0.Height
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = cDIBbuffer0.BytesPerScanLine()
        .pvData = cDIBbuffer0.DIBSectionBitsPtr
    End With
    CopyMemory ByVal VarPtrArray(bDib1()), VarPtr(tSA1), 4

    Dim nx As Long, ny As Long
    Dim image_x As Single, image_y As Single, temp_image_x As Single, temp_image_y As Single
    Dim x_step As Single, y_step As Single, x_step2 As Single, y_step2 As Single
    Dim screen_x As Long, screen_y As Long, mmx As Long, mmy As Long


    Dim dest As Long, pw As Long, ph As Long
   Dim sx As Single, sy As Single
    Dim xf As Single, yf As Single
    Dim xf1 As Single, yf1 As Single
    Dim pws As Single, phs As Single
    pw = cDIBbuffer1.Width
    ph = cDIBbuffer1.Height
    pws = pw
    phs = ph
    Dim pw1 As Long, ph1 As Long
    pw1 = pw - 1
    ph1 = ph - 1
    r = Atn(myw / myh)
    K = -myw / (2# * Sin(r))
   image_x = (pw / 2! - (K * Sin(Angle! - r))) * pw
   image_y = (ph / 2! + (K * Cos(Angle! - r))) * ph
   x_step2 = (Cos(Angle! + Pi / 2!) * pw)
    y_step2 = (Sin(Angle! + Pi / 2!) * ph)

    x_step = Cos(Angle!) * pw
    y_step = Sin(Angle!) * ph

    For screen_y = 0 To Fix(myh) - 1
        temp_image_x = image_x
        temp_image_y = image_y
         For screen_x = 0 To (Fix(myw) - 1) * 3 Step 3
                sx = temp_image_x / pws
                sy = temp_image_y / phs
                mmx = Fix(sx)
                mmy = Fix(sy)

                    If mmx >= 0 And mmx <= pw1 And mmy >= 0 And mmy <= ph1 Then
             xf = Abs((sx - CSng(mmx)))
             xf1 = 1! - xf
                      yf = Abs((sy - CSng(mmy)))
                      yf1 = 1! - yf
                      
                        If ((mmx = pw1) Xor (mmy = ph1)) Or (mmx = pw1 And mmy = ph1) Then
                          mmx = mmx * 3
                         bDib1(screen_x, screen_y) = bDib(mmx, mmy)
                        bDib1(screen_x + 1, screen_y) = bDib(mmx + 1, mmy)
                       bDib1(screen_x + 2, screen_y) = bDib(mmx + 2, mmy)
 
              
                       Else
                          mmx = mmx * 3
                        bDib1(screen_x, screen_y) = yf1 * (xf1 * bDib(mmx, mmy) + xf * bDib(mmx + 3, mmy)) + yf * (xf1 * bDib(mmx, mmy + 1) + xf * bDib(mmx + 3, mmy + 1))
                        bDib1(screen_x + 1, screen_y) = yf1 * (xf1 * bDib(mmx + 1, mmy) + xf * bDib(mmx + 4, mmy)) + yf * (xf1 * bDib(mmx + 1, mmy + 1) + xf * bDib(mmx + 4, mmy + 1))
                        bDib1(screen_x + 2, screen_y) = yf1 * (xf1 * bDib(mmx + 2, mmy) + xf * bDib(mmx + 5, mmy)) + yf * (xf1 * bDib(mmx + 2, mmy + 1) + xf * bDib(mmx + 5, mmy + 1))
                      End If
                    Else
                        bDib1(screen_x, screen_y) = BR
                        bDib1(screen_x + 1, screen_y) = BG
                        bDib1(screen_x + 2, screen_y) = BBb
                    End If
            temp_image_x = temp_image_x + x_step
            temp_image_y = temp_image_y + y_step
       Next screen_x
        image_x = image_x + x_step2
        image_y = image_y + y_step2
    Next screen_y
    CopyMemory ByVal VarPtrArray(bDib), 0&, 4
    CopyMemory ByVal VarPtrArray(bDib1), 0&, 4
    Else

    End If

Set cDIBbuffer1 = Nothing
End Sub

[LaVolpe]

Well, once you completely debug your routines, you might want to go back & optimize them to gain a bit more speed. This tip should save off some cpu cycles:

In a loop, don't use multiple conditions in an IF statement if it can be avoided.
Instead of

If mmx >= 0 And mmx <= pw1 And mmy >= 0 And mmy <= ph1 Then

Use

If mmx >= 0 Then 
    If mmx <= pw1 Then
        If mmy >= 0 Then 
            If mmy <= ph1 Then

            End If
        End If
    End If
End If

When all the conditions are in 1 IF statement, all are calculated/processed. When they are in different IF statements, all are processed only if all are true

Don't forget to document those long calculations. If you have to go back & debug them 6 months from now, good luck on trying to remember exactly what those calcs are doing

[georgekar]

So Vb has no Short Circuit evaluation

You are right...I do an example and I found that vb execute all the parts in an AND.

Function testA(a As Long) As Long
    Debug.Print "I am A"
    testA = a
End Function
Function testb() As Long
    Debug.Print "I am b"
    testb = 1
End Function
Function All()
    If testA(1) = 0 Then
    If testb = 1 Then
        Debug.Print "ok"
    End If
    End If
End Function
Function All2()
If testA(1) = 0 And testb = 1 Then
    Debug.Print "ok"
End If

End Function

[LaVolpe]

Just FYI should someone come across this thread in the future. I have eventually decided to use GDI+ matrices for this issue. Since my project is designed around GDI+, this appears to be a suitable solution.

1. During lifetime of the image in my usercontrol, I have a cached GDI+ matrix object that contains the values for scaling, offsetting, rotation, shearing, & mirroring. This matrix is passed to GDI+ image rendering functions

GdipCreateMatrix2
GdipRotateMatrix
GdipScaleMatrix
GdipShearMatrix
GdipTranslateMatrix
note: no GDI+ method for mirroring, however, GdipCreateMatrix2(x,0,0,y,0,0) does the job 
where x & y are 1 if no mirroring or -1 if mirroring x/y axis respectively

2. To determine a hit test, I clone the cached matrix and invert it, then transform the passed mouse pointer coordinates. The result is a really accurate hit test relative to the original image bounds, independent of any scaling, rotation, etc

GdipCloneMatrix
GdipInvertMatrix
GdipTransformMatrixPoints

Edited. As a bonus, I use very similar logic to locate the pixels within an image that need to be refreshed, as needed. For example if dragging a window over a large image, don't want to keep rendering the entire image, just the pixels that were uncovered/affected. By reducing the number of pixels to be redrawn, repaints are faster overall

The immediate advantage of using the matrix is that it can be inverted, i.e., unwound. So a position within a rendered image at any scale, rotation, etc, can be unwound to the relative coordinate on the original unscaled, unrotated, etc image