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 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
Last edited by joaquim; Aug 3rd, 2008 at 09:05 AM.
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...
Last edited by joaquim; Aug 3rd, 2008 at 09:47 AM.
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.
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.
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
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
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
[RESOLVED] my own prcedure for rotate an image
Reply With Quote
Originally Posted by Milk
