rotating bitmaps without pixellation

this is a question i posted september of last year.  i was only able to study the answer this week, so pls bear with me.

hwn,

i 'm using vb picturebox control to hold the bitmap.  can you elaborate on this antialiasing algorithm?

waty,

i 'm trying the code, but i can't make the image appear on the
PictureBox.i  've adjusted the code, making the rotated bitmap
appear on a new picturebox.  also, the lwidth and llength parameters on the sub, should i pass the scalewidth and scaleheight of the source picbox?

for the radian value, i am converting the degrees value to radians using the following formula:
radian = degree * PI / 180
 
%%%%%%%%%%% HISTORY %%%%%%%%%%%%%%%
'm trying to rotate a bitmap to 45 degrees but am having problems because it pixellates (which is ugly).

any help is appreciated, and since i haven't asked a question in a while, i'll be generous with the points.

thanks in advance

_____________________________________ responses received
waty
                              Date: Friday, September 03 1999 - 07:06AM PDT

'
#VBIDEUtils#************************************************************

' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 30/11/98
' * Time             : 13:27
' * Module Name      : RotateBitmap_Module
' * Module Filename  : RotateBitmap.bas
'
**********************************************************************

' * Comments         : Rotate a bitmap
' *
' *
'
**********************************************************************


Option Explicit

Public Const IMAGE_BITMAP = &O0         ' used with LoadImage to load a bitmap
Public Const LR_LOADFROMFILE = 16       ' used with LoadImage
Public Const LR_CREATEDIBSECTION = 8192 ' used with LoadImage
Public Const SRCCOPY = &HCC0020         ' (DWORD) dest = source
Public Const PI = 3.14159

Type BITMAP '14 bytes
   bmType         As Long
   bmWidth        As Long
   bmHeight       As Long
   bmWidthBytes   As Long
   bmPlanes       As Integer
   bmBitsPixel    As Integer
   bmBits         As Long
End Type

Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz
As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As
Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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
Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal
nCount As Long, lpObject As Any) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As
Long, ByVal nHeight As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Sub RotateBitmap(hBitmapDC As Long, lWidth As Long, lHeight As Long, lRadians As
Long)
   '
#VBIDEUtils#************************************************************

   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 30/11/98
   ' * Time             : 13:27
   ' * Module Name      : RotateBitmap_Module
   ' * Module Filename  : RotateBitmap.bas
   ' * Procedure Name   : RotateBitmap
   ' * Parameters       :
   ' *                    hBitmapDC As Long
   ' *                    lWidth As Long
   ' *                    lHeight As Long
   ' *                    lRadians As Long
   '
**********************************************************************

   ' * Comments         : Rotate a bitmap
   ' *
   ' *
   '
**********************************************************************


   Dim hNewBitmapDC As Long    ' DC of the new bitmap
   Dim hNewBitmap As Long      ' handle to the new bitmap
   Dim lSine As Long           ' sine used in rotation
   Dim lCosine As Long         ' cosine used in rotation
   Dim X1 As Long              ' used in calculating new
   ' bitmap dimensions
   Dim X2 As Long              ' used in calculating new
   ' bitmap dimensions
   Dim X3 As Long              ' used in calculating new
   ' bitmap dimensions
   Dim Y1 As Long              ' used in calculating new
   ' bitmap dimensions
   Dim Y2 As Long              ' used in calculating new
   ' bitmap dimensions
   Dim Y3 As Long              ' used in calculating new
   ' bitmap dimensions
   Dim lMinX As Long           ' used in calculating new
   ' bitmap dimensions
   Dim lMaxX As Long           ' used in calculating new
   ' bitmap dimensions
   Dim lMinY As Long           ' used in calculating new
   ' bitmap dimensions
   Dim lMaxY As Long           ' used in calculating new
   ' bitmap dimensions
   Dim lNewWidth As Long       ' width of new bitmap
   Dim lNewHeight As Long      ' height of new bitmap
   Dim i As Long               ' loop counter
   Dim J As Long               ' loop counter
   Dim lSourceX As Long        ' x pixel coord we are blitting
   ' from the source  image
   Dim lSourceY As Long        ' y pixel coord we are blitting
   ' from the source image

   ' create a compatible DC from the one just brought
   ' into this function
   hNewBitmapDC = CreateCompatibleDC(hBitmapDC)

   ' compute the sine/cosinse of the radians used to
   ' rotate this image
   lSine = Sin(lRadians)
   lCosine = Cos(lRadians)

   ' compute the size of the new bitmap being created
   X1 = -lHeight * lSine
   Y1 = lHeight * lCosine
   X2 = lWidth * lCosine - lHeight * lSine
   Y2 = lHeight * lCosine + lWidth * lSine
   X3 = lWidth * lCosine
   Y3 = lWidth * lSine

   ' figure out the max/min size of the new bitmap
   lMinX = Min(0, Min(X1, Min(X2, X3)))
   lMinY = Min(0, Min(Y1, Min(Y2, Y3)))
   lMaxX = Max(X1, Max(X2, X3))
   lMaxY = Max(Y1, Max(Y2, Y3))

   ' set the new bitmap width/height
   lNewWidth = lMaxX - lMinX
   lNewHeight = lMaxY - lMinY

   ' create a new bitmap based upon the new width/height of the
   ' rotated bitmap
   hNewBitmap = CreateCompatibleBitmap(hBitmapDC, lNewWidth, lNewHeight)

   ' attach the new bitmap to the new device context created
   ' above before constructing the rotated bitmap
   Call SelectObject(hNewBitmapDC, hNewBitmap)

   ' loop through and translate each pixel to its new location.
   ' this is using a standard rotation algorythmn
   For i = 0 To lNewHeight
      For J = 0 To lNewWidth
         lSourceX = (J + lMinX) * lCosine + (i + lMinY) * lSine
         lSourceY = (i + lMinY) * lCosine - (J + lMinX) * lSine
         If (lSourceX >= 0) And (lSourceX <= lWidth) And _
               (lSourceY >= 0) And (lSourceY <= lHeight) Then
            Call BitBlt(hNewBitmapDC, J, i, 1, 1, hBitmapDC, _
                  lSourceX, lSourceY, SRCCOPY)
         End If
      Next
   Next

   ' reset the new bitmap width and height
   lWidth = lNewWidth
   lHeight = lNewHeight

   ' return the DC to the new bitmap
   hBitmapDC = hNewBitmapDC

   ' destroy the bitmap created
   Call DeleteObject(hNewBitmap)

End Sub

Private Function Min(X1 As Long, Y1 As Long) As Long
   
   If X1 >= Y1 Then
      Min = Y1
   Else
      Min = X1
   End If
   
End Function

Private Function Max(X1 As Long, Y1 As Long) As Long
   
   If X1 >= Y1 Then
      Max = X1
   Else
      Max = Y1
   End If

End Function


Comment

From:                          hwn
Date: Friday, September 03 1999 - 07:07AM PDT

What size is this bitmap (just my curiosity).
You probably have to use an antialiasing algorithm
to get rid of the pixellation.
What graphical toolbox do you use
for handling the bitmap, only VB own or some
thirdparty product ?

Comment


janeaustenAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
DanAvniConnect With a Mentor Commented:
why don't you use an ActiveX?
try www.leadtools.com
they have a great image processing control that can do it.
0
 
Erick37Commented:
The following download is an example of how to use the LoadImage API to achieve antialising.  If you prefer not to load from file, you can substitute LoadImage with CopyImage, which uses a picture handle instead of a filename.  To test the function, replace the supplied test bitmap with one of your own.

http://www.vb-helper.com/Howto/alias.zip
0
 
caraf_gCommented:
<dummy comment to allow me to get this q for free when it's been answered>
0
 
watyCommented:
Here is a link you could check
http://www.advantage.co.nz/ur/rotatedemo.htm

Also, here is another module I got to rotate, flip, mirror....


' #VBIDEUtils#************************************************************
' * Programmer Name  : n/A
' * Web Site         : http://personal.inet.fi/cool/dragon/vb/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 27/08/99
' * Time             : 11:44
' **********************************************************************
' * Comments         : Bitmap Flip, Mirror, Rotate
' *
' *
' **********************************************************************

Option Explicit

Declare Function SetPixel Lib "GDI32" (ByVal hDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal crColor As Long) As Long
Declare Function GetPixel Lib "GDI32" (ByVal hDC As Integer, ByVal x As Integer, ByVal y As Integer) As Long
Declare Function StretchBlt% Lib "GDI32" (ByVal hDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&)
Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWid As Integer, ByVal nHt As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer

'BmpFlip, BmpMirror, BmpRotate
Const SRCCOPY = &HCC0020
Const Pi = 3.14159265359

Public Sub BmpMirror(Picture1 As PictureBox, Picture2 As PictureBox)
   'flip horizontal
   Picture1.ScaleMode = 3
   Picture2.ScaleMode = 3
   Picture2.Cls
   px% = Picture1.ScaleWidth
   py% = Picture1.ScaleHeight
   RetVal% = StretchBlt(Picture2.hDC, px%, 0, -px%, py%, Picture1.hDC, 0, 0, px%, py%, SRCCOPY)
End Sub

Public Sub BmpFlip(Picture1 As PictureBox, Picture2 As PictureBox)
   'flip vertical
   Picture1.ScaleMode = 3
   Picture2.ScaleMode = 3
   Picture2.Cls
   px% = Picture1.ScaleWidth
   py% = Picture1.ScaleHeight
   RetVal% = StretchBlt(Picture2.hDC, 0, py%, px%, -py%, Picture1.hDC, 0, 0, px%, py%, SRCCOPY)
End Sub

Sub BmpRotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)
   ' Rotate the image in a picture box.
   '   pic1 is the picture box with the bitmap to rotate
   '   pic2 is the picture box to receive the rotated bitmap
   '   theta is the angle of rotation

   Dim c1x As Integer, c1y As Integer
   Dim c2x As Integer, c2y As Integer
   Dim a As Single
   Dim p1x As Integer, p1y As Integer
   Dim p2x As Integer, p2y As Integer
   Dim n As Integer, r   As Integer
   Picture1.ScaleMode = 3
   Picture2.ScaleMode = 3

   c1x = pic1.ScaleWidth  2
   c1y = pic1.ScaleHeight  2
   c2x = pic2.ScaleWidth  2
   c2y = pic2.ScaleHeight  2

   If c2x < c2y Then n = c2y Else n = c2x
   n = n - 1
   pic1hDC% = pic1.hDC
   pic2hDC% = pic2.hDC
   For p2x = 0 To n
      For p2y = 0 To n
         If p2x = 0 Then a = Pi / 2 Else a = Atn(p2y / p2x)
         r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
         p1x = r * Cos(a + theta!)
         p1y = r * Sin(a + theta!)
         c0& = GetPixel(pic1hDC%, c1x + p1x, c1y + p1y)
         c1& = GetPixel(pic1hDC%, c1x - p1x, c1y - p1y)
         c2& = GetPixel(pic1hDC%, c1x + p1y, c1y - p1x)
         c3& = GetPixel(pic1hDC%, c1x - p1y, c1y + p1x)
         If c0& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2x, c2y + p2y, c0&)
         If c1& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2x, c2y - p2y, c1&)
         If c2& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2y, c2y - p2x, c2&)
         If c3& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2y, c2y + p2x, c3&)
      Next
      t% = DoEvents()
   Next
End Sub

Public Sub BmpTile(picParent As PictureBox, picTile As PictureBox)
   'This subroutine tiles a picture onto another picture.
   'call syntax: Tile Picture1, Picture2
   '             Tile (destination), (source)
   Dim TileIt As Integer
   Const SRCCOPY = &HCC0020
   Dim x As Integer, y As Integer
   Dim MaximumX As Integer, MaximumY As Integer
   MaximumX = picParent.Width + picTile.Width
   MaximumY = picParent.Height + picTile.Height
   MaximumX = MaximumX  Screen.TwipsPerPixelX
   MaximumY = MaximumY  Screen.TwipsPerPixelY
   Dim TileWidth As Integer, TileHeight As Integer
   TileWidth = picTile.Width  Screen.TwipsPerPixelX
   TileHeight = picTile.Height  Screen.TwipsPerPixelY
   For y = 0 To MaximumY Step TileHeight
      For x = 0 To MaximumX Step TileWidth
         TileIt = BitBlt(picParent.hDC, x, y, TileWidth, TileHeight, picTile.hDC, 0, 0, SRCCOPY)
      Next
   Next
End Sub

0
All Courses

From novice to tech pro — start learning today.