[RESOLVED] my own prcedure for rotate an image

i'm using visual basic 6...
i build these procedure:

Code:

---

Option Explicit

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

Public Sub RotateImage(PicDestiny As PictureBox, PicSource As PictureBox, Angle As Long, Optional PosX As Long = 0, Optional PosY As Long = 0)
    Dim X1 As Long
    Dim Y1 As Long
    Dim X2 As Long
    Dim Y2 As Long
    Dim X As Long
    Dim Y As Long
    Dim result As Long
    Const PI = 3.14
    'Clear the picture destiny
    PicDestiny.Cls
    Angle = Angle * (PI / 180)
    For X1 = 0 To PicSource.Width
        For Y1 = 0 To PicSource.Height
            result = GetPixel(PicSource.hdc, X1, Y1)
            If result <> -1 Then
                'Calculate the position in a circule by using the center X, Y
                X = X1 - (PicSource.Width / 2)
                Y = Y1 - (PicSource.Height / 2)
                'Calculate the new position
                X2 = (X * Cos(Angle) - Y * Sin(Angle)) + (PicSource.Height / 2)
                Y2 = (X * Sin(Angle) + Y * Cos(Angle)) + (PicSource.Width / 2)
                'After changed, put the pixel in new position in picDestiny
                SetPixel PicDestiny.hdc, X2, Y2, GetPixel(PicSource.hdc, X1, Y1)
            End If
        Next Y1
    Next X1
End Sub

---

i don't know what isn't right with these procedure...
you can see the error in an output picturebox, in bottom image...
i don't know why i can see transparent pixels...
can anyone help me fix these bug?
thanks

In your project you are already using DibSections (your greyscale code), you can use the same thing with your rotation code. The speed will increase 100 fold and the code won't change that much.

You will also get a big speed boost by storing the return of Cos(angle) and Sin(angle) in a variable. There is no point calling a slow function for every single pixel when the numbers don't change. The same logic applies to the Height and Width properties, although quite fast a locally stored variable is much faster.

You are getting blank spots because you are mapping from the source to the destination. You should map from the destination to the source. Again this will not change the code that much. This means instead of looping through the source pixels and working out where they are in the destination bitmap, you loop through the destination pixels and work out the correct source pixel. That way every pixel gets mapped.

If written correctly it's possible to write code in VB6 which is faster than the GDI+ rotation api.

If you want a high standard of rotation then you can use interpolation to map each pixel to 4 pixels instead of 1, giving a very smooth finish. It might be a bit hard for you at present.

Now matter how good a rotation algorithm data is always lost. If a Bitmap is rotated several times the image degrades. For this reason its a good idea to store the original unrotated bitmap and use that for all transformations

i'm sorry but i only catch half that you said...
and thanks for everything

i did some changes to code and i found 1 error in X1 and X2 variable:

Code:

---

Public Sub RotateImage(PicDestiny As PictureBox, PicSource As PictureBox, Angle As Long, Optional PosX As Long = 0, Optional PosY As Long = 0)
    Dim X1 As Long
    Dim Y1 As Long
    Dim X2 As Long
    Dim Y2 As Long
    Dim X As Long
    Dim Y As Long
    Dim SinAngle As Long
    Dim CosAngle As Long
    Const PI = 3.141592654
    'Clear the picture destiny
    PicDestiny.Cls
    Angle = Angle * (PI / 180)
    SinAngle = CLng(Sin(Angle))
    CosAngle = CLng(Cos(Angle))
    For X1 = 0 To PicSource.Width
        For Y1 = 0 To PicSource.Height
            If GetPixel(PicSource.hdc, X1, Y1) <> &HFFFF Then
                'Calculate the position in a circule by using the center X, Y
                X = X1 - (PicSource.Width / 2)
                Y = Y1 - (PicSource.Height / 2)
                'Calculate the new position
                X2 = (X * CosAngle - Y * SinAngle) + (PicSource.Width / 2) + PosX
                Y2 = (X * SinAngle + Y * CosAngle) + (PicSource.Height / 2) + PosY
                'After changed, put the pixel in new position in picDestiny
                SetPixel PicDestiny.hdc, X2, Y2, GetPixel(PicSource.hdc, X1, Y1)
            End If
        Next Y1
    Next X1
End Sub

---

the other changes that you said like:
"You are getting blank spots because you are mapping from the source to the destination. You should map from the destination to the source. Again this will not change the code that much. This means instead of looping through the source pixels and working out where they are in the destination bitmap, you loop through the destination pixels and work out the correct source pixel. That way every pixel gets mapped."
i don't did, because i don't understand what you mean... i'm sorry
and yes with that variable changes is more quickly.. thanks
thanks

now i can see better:

Code:

---

Public Sub RotateImage(PicDestiny As PictureBox, PicSource As PictureBox, Angle As Long, Optional PosX As Long = 0, Optional PosY As Long = 0)
    Dim X1 As Long
    Dim Y1 As Long
    Dim X2 As Long
    Dim Y2 As Long
    Dim X As Long
    Dim Y As Long
    Dim X0 As Long
    Dim Y0 As Long
    Dim SinAngle As Long
    Dim CosAngle As Long
    Const PI = 3.141592654
    'Clear the picture destiny
    PicDestiny.Cls
    Angle = -(Angle * (PI / 180))
    SinAngle = CLng(Sin(Angle))
    CosAngle = CLng(Cos(Angle))
    X0 = PicSource.Width / 2
    Y0 = PicSource.Height / 2
    For X1 = 0 To PicSource.Width
        For Y1 = 0 To PicSource.Height
            If GetPixel(PicSource.hdc, X1, Y1) <> &HFFFF Then
                'Calculate the position in a circule by using the center X, Y
                X = X1 - X0
                Y = Y1 - Y0
                'Calculate the new position
                X2 = (X1 * CosAngle - Y1 * SinAngle) + X0 + PosX 'PosX=0
                Y2 = (X1 * SinAngle + Y1 * CosAngle) + Y0 + PosY 'PosY=0
                'After changed, put the pixel in new position in picDestiny
                SetPixel PicDestiny.hdc, X2, Y2, GetPixel(PicSource.hdc, X1, Y1)
            End If
        Next Y1
    Next X1
End Sub

---

i have tested again but something isn't right... :(
heres the image...

Here is a reworking of your code, it tries to minimise unnecessary calculations eg. checks to see if X is in range before calculating Y.
Rather than looping through the source pixels it loops through the destination pixels, that way no pixels are missed.

Code:

---

Public Sub RotateImage(PicDestiny As PictureBox, PicSource As PictureBox, ByVal Angle As Single)
  Dim X1 As Long, Y1 As Long
  Dim X2 As Long, Y2 As Long
  Dim X As Long, Y As Long
  Dim CosA As Single, SinA As Single
  Dim Wdth As Long, Hght As Long
  Dim SrcOffX As Long, SrcOffY As Long
  Dim SrcHdc As Long, TgtHdc As Long
 
  PicDestiny.Cls
  'calculate negative angle in radians, negative because mapping from destination to source
  Angle = Angle * -1.74532925199433E-02 'same as Angle * (pi/180) * -1
 
  CosA = Cos(Angle)
  SinA = Sin(Angle)
 
  With PicSource 'Get the width and height in pixels
      Wdth = .ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
      Hght = .ScaleY(.ScaleHeight, .ScaleMode, vbPixels)
      'Make the target picturebox the same size as the source
      PicDestiny.ScaleMode = .ScaleMode
      PicDestiny.BorderStyle = .BorderStyle
      PicDestiny.Width = .Width
      PicDestiny.Height = .Height
  End With
 
  SrcOffX = Wdth \ 2
  SrcOffY = Hght \ 2
 
  SrcHdc = PicSource.hdc
  TgtHdc = PicDestiny.hdc
 
    For Y2 = 0 To Hght
        For X2 = 0 To Wdth
            X = X2 - SrcOffX
            Y = Y2 - SrcOffY
            X1 = (X * CosA - Y * SinA) + SrcOffX
            If X1 >= 0 Then
              If X1 < Wdth Then 'the pixel is within the horizontal range
                  Y1 = (X * SinA + Y * CosA) + SrcOffY
                  If Y1 >= 0 Then
                    If Y1 < Hght Then 'the pixel is within range
                        SetPixel TgtHdc, X2, Y2, GetPixel(SrcHdc, X1, Y1)
                    End If
                  End If
              End If
            End If
        Next X2
    Next Y2
End Sub

---

Your greyscale routine does not use the terrible Get/Setpixel but an array instead. If you can use what you have learnt with that, with this you will have something much much faster.

Quote:

---

Originally Posted by Milk

Here is a reworking of your code, it tries to minimise unnecessary calculations eg. checks to see if X is in range before calculating Y.
Rather than looping through the source pixels it loops through the destination pixels, that way no pixels are missed.

Code:

---

Public Sub RotateImage(PicDestiny As PictureBox, PicSource As PictureBox, ByVal Angle As Single)
  Dim X1 As Long, Y1 As Long
  Dim X2 As Long, Y2 As Long
  Dim X As Long, Y As Long
  Dim CosA As Single, SinA As Single
  Dim Wdth As Long, Hght As Long
  Dim SrcOffX As Long, SrcOffY As Long
  Dim SrcHdc As Long, TgtHdc As Long
 
  PicDestiny.Cls
  'calculate negative angle in radians, negative because mapping from destination to source
  Angle = Angle * -1.74532925199433E-02 'same as Angle * (pi/180) * -1
 
  CosA = Cos(Angle)
  SinA = Sin(Angle)
 
  With PicSource 'Get the width and height in pixels
      Wdth = .ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
      Hght = .ScaleY(.ScaleHeight, .ScaleMode, vbPixels)
      'Make the target picturebox the same size as the source
      PicDestiny.ScaleMode = .ScaleMode
      PicDestiny.BorderStyle = .BorderStyle
      PicDestiny.Width = .Width
      PicDestiny.Height = .Height
  End With
 
  SrcOffX = Wdth \ 2
  SrcOffY = Hght \ 2
 
  SrcHdc = PicSource.hdc
  TgtHdc = PicDestiny.hdc
 
    For Y2 = 0 To Hght
        For X2 = 0 To Wdth
            X = X2 - SrcOffX
            Y = Y2 - SrcOffY
            X1 = (X * CosA - Y * SinA) + SrcOffX
            If X1 >= 0 Then
              If X1 < Wdth Then 'the pixel is within the horizontal range
                  Y1 = (X * SinA + Y * CosA) + SrcOffY
                  If Y1 >= 0 Then
                    If Y1 < Hght Then 'the pixel is within range
                        SetPixel TgtHdc, X2, Y2, GetPixel(SrcHdc, X1, Y1)
                    End If
                  End If
              End If
            End If
        Next X2
    Next Y2
End Sub

---

Your greyscale routine does not use the terrible Get/Setpixel but an array instead. If you can use what you have learnt with that, with this you will have something much much faster.

---

your code it's great, but i can see that i can't see the entire image in picdestination... with these new code how can i put the intire image in X and Y new position(is for try see the entire image)?
thanks

okay, you need to make picdestiny big enough. This can be calculated perfectly or you could make it big enough for any rotation the latter would be (i think?) dimensioned...

Code:

---

Sqr(SrcWidth*SrcWidth + SrcHght*SrcHght)

---

You will need two more variables TgtOffX and TgtOffY which you would use instead of SrcOffX/Y where you calculate X1 and Y1.

Quote:

---

Originally Posted by Milk

okay, you need to make picdestiny big enough. This can be calculated perfectly or you could make it big enough for any rotation the latter would be (i think?) dimensioned...

Code:

---

Sqr(SrcWidth*SrcWidth + SrcHght*SrcHght)

---

You will need two more variables TgtOffX and TgtOffY which you would use instead of SrcOffX/Y where you calculate X1 and Y1.

---

i'm sorry, but i don't understand half that you said
thanks

Try experimenting with it. Make picdestiny bigger and see what happens.

Quote:

---

Originally Posted by Milk

Try experimenting with it. Make picdestiny bigger and see what happens.

---

i try change in these lines:

Code:

---

SetPixel TgtHdc, X2+PosX, Y2+PosY, GetPixel(SrcHdc, X1, Y1)

---

i tested again, but i think that your procedure as a problem see the image:
thanks

i resolve something, but i can see a bug:

Code:

---

Public Sub RotateImage(PicDestiny As PictureBox, PicSource As PictureBox, ByVal Angle As Single, Optional ByVal PosX As Long = 0, Optional ByVal PosY As Long = 0)
  Dim X1 As Long, Y1 As Long
  Dim X2 As Long, Y2 As Long
  Dim X As Long, Y As Long
  Dim CosA As Single, SinA As Single
  Dim Wdth As Long, Hght As Long
  Dim SrcOffX As Long, SrcOffY As Long
  Dim SrcHdc As Long, TgtHdc As Long
 
  PicDestiny.Cls
  'calculate negative angle in radians, negative because mapping from destination to source
  Angle = Angle * 1.74532925199433E-02 'same as Angle * (pi/180) * -1
 
  CosA = Cos(Angle)
  SinA = Sin(Angle)
  Set PicDestiny.Picture = Nothing
  PicDestiny.Cls
  If PicSource.Height > PicSource.Width Then
        PicSource.Width = PicSource.Height
      Else
        PicSource.Height = PicSource.Width
        End If
  With PicSource 'Get the width and height in pixels
      Wdth = .ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
      Hght = .ScaleY(.ScaleHeight, .ScaleMode, vbPixels)
      'Make the target picturebox the same size as the source
      PicDestiny.ScaleMode = .ScaleMode
      PicDestiny.BorderStyle = .BorderStyle
      PicDestiny.Width = .Width
      PicDestiny.Height = .Height
  End With
 
  SrcOffX = (Wdth \ 2)
  SrcOffY = (Hght \ 2)
 
  SrcHdc = PicSource.hdc
  TgtHdc = PicDestiny.hdc
 
    For Y2 = 0 To Hght
        For X2 = 0 To Wdth
            X = X2 - SrcOffX
            Y = Y2 - SrcOffY
            X1 = (X * CosA - Y * SinA) + SrcOffX
            If X1 >= 0 Then
              If X1 < Wdth Then 'the pixel is within the horizontal range
                  Y1 = (X * SinA + Y * CosA) + SrcOffY
                  If Y1 >= 0 Then
                    If Y1 < Hght Then 'the pixel is within range
                        SetPixel TgtHdc, X2 + PosX, Y2 + PosY, GetPixel(SrcHdc, X1, Y1)
                    End If
                  End If
              End If
            End If
        Next X2
    Next Y2
    PicDestiny.Picture = PicDestiny.Image
End Sub

---

see the image:

ok... the problem is resolved...
i put in my control and is working fine...
and yes: with picturebox array autosize property to true i coud put the usercontrol with right size.
thanks