How can you rotate an image for like 90 degrees?
Thanx
Printable View
How can you rotate an image for like 90 degrees?
Thanx
This is not mine, i found it somewhere but i can't remember
VB Code:
Option Explicit Const SRCCOPY = &HCC0020 Const Pi = 3.14159265359 Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long ' Add three command buttons and two pictureboxes. 'Load a bitmap into picture1 in design mode. 'Set both box to the same size. 'Routines execute 3 times faster than routines found in Microsoft's Knowledge Base. Dim x! Sub Form_Load() Picture1.ScaleMode = 3 Picture2.ScaleMode = 3 x! = 0.1 End Sub Sub Command1_Click() Dim px% Dim py% Dim retval% 'flip horizontal 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 Sub Command2_Click() Dim px% Dim py% Dim retval% 'flip vertical 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 Command3_Click() Dim y! Dim s$ s$ = Text1.Text y! = Val(Replace(s$, ",", ".")) * Pi / 180 'rotate 45 degrees Picture2.Cls Call bmp_rotate(Picture1, Picture2, y!) End Sub Sub bmp_rotate(pic1 As PictureBox, pic2 As PictureBox, ByVal theta!) ' bmp_rotate(pic1, pic2, 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 Dim pic1hdc& Dim pic2hdc& Dim c0& Dim c1& Dim c2& Dim c3& Dim xret& Dim t% 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
Thanks! It works:)