Results 1 to 4 of 4

Thread: Super fast running image rotation

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Resolved Super fast running image rotation

    This is the first method, which is slower and has no extra white edges. The second method is faster

    Code:
    Private Type Bitmap
       bmType As Long 'Image type: 0 means bitmap
       bmWidth As Long 'Image width (pixels)
       bmHeight As Long 'image height (pixels)
       bmWidthBytes As Long 'The number of bytes per line of image
       bmPlanes As Integer 'The number of layers of the image
       bmBitsPixel As Integer 'The number of bits of the image
       bmBits As Long 'Bitmap memory pointer
    End Type
    Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
    Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
    Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
    Dim ctP180 As Double
    'Need to place the following 6 controls on the form, all controls do not need to set any properties (including position and size), all adopt the default settings:
    'Command1, Command2, Label1, Picture1, Text1, Combo1
    Private Sub Form_Load()
       Me.Caption = "Picture Rotation-Fast"
       Text1.Text = App.Path & "\cat.jpg"
       Command1.Caption = "Open": Command2.Caption = "Rotate"
       Label1.Caption = "Rotation Angle": Label1.BackStyle = 0
       Me.ScaleMode = 3: Picture1.ScaleMode = 3
       Picture1.AutoSize = True: Picture1.AutoRedraw = True
       Picture1.ToolTipText = "Double-click to restore the original graphic"
       
       ctP180 = 4 * Atn(1) 'Pi
       
       For i = -18 To 18
          If i < 0 Then
             Combo1.AddItem i * 10 & "degree"
          Else
             Combo1.AddItem "" & i * 10 & "degree"
          End If
       Next
       Combo1.Text = "30 degrees"
       
       'Set the control position, which can actually be done when designing the form
       Dim W1 As Long
       W1 = Me.TextWidth("A")
       Command1.Move W1, W1, W1 * 6, W1 * 3: Text1.Move W1 * 8, W1, W1 * 80, W1 * 3
       Command2.Move W1, W1 * 5, W1 * 6, W1 * 3: Label1.Move W1 * 8, W1 * 5.5, W1 * 11, W1 * 3
       Combo1.Move W1 * 16, W1 * 5, W1 * 12
       Picture1.Move W1, W1 * 9, W1 * 40, W1 * 40
       Picture1.Picture = LoadPicture(Text1.Text)
       'Call RndImg(Picture1)'Draw some images randomly
    End Sub
    
    Private Sub RndImg(Kj As Object)
       'Draw some images randomly
       Dim i As Long
       Randomize
       Kj.DrawWidth = 3
       For i = 1 To 100
          Kj.Line (Kj.ScaleWidth * Rnd, Kj.ScaleHeight * Rnd)-Step(50, 50), &HFFFFFF * Rnd, BF
          Kj.Circle (Kj.ScaleWidth * Rnd, Kj.ScaleHeight * Rnd), 30 * Rnd, &HFFFFFF * Rnd
       Next
       Kj.Font.size = 24: Kj.Font.Bold = True
       Kj.CurrentX = 10: Kj.CurrentY = 10: Kj.ForeColor = &H777777
       Kj.Print Me.Caption
       Kj.CurrentX = 11: Kj.CurrentY = 11: Kj.ForeColor = RGB(0, 110, 110)
       Kj.Print Me.Caption
       Kj.Line (0, 0)-(Kj.ScaleWidth - 1, Kj.ScaleHeight - 1), 255, B
       Kj.DrawWidth = 1: Picture1.ForeColor = 0 'Restore to default settings
       Picture1.Font.size = 9: Picture1.Font.Bold = False
       Kj.Picture = Kj.Image
    End Sub
    
    Private Sub Command1_Click()
       'Open picture file
       Dim F As String
       On Error GoTo Err1
       F = Trim(Text1.Text)
       Picture1.Picture = LoadPicture(F)
       Exit Sub
    Err1:
       MsgBox "Unable to read file:" & vbCrLf & F, vbInformation
    End Sub
    
    Private Sub Combo1_Click()
       Call Command2_Click
    End Sub
    
    Private Sub Command2_Click()
       'Rotate the picture
       Dim W1 As Long, H1 As Long, B1() As Byte, Bs1 As Long, BytesW1 As Long, Ps1 As Long
       Dim W2 As Long, H2 As Long, B2() As Byte, Bs2 As Long, BytesW2 As Long, Ps2 As Long
       Dim S1 As Long, S2 As Long, x As Long, y As Long, x1 As Long, y1 As Long
       Dim CenX1 As Long, CenY1 As Long, CenX2 As Long, CenY2 As Long
       Dim KjFocus As Control, ToJ As Single
       
       ToJ = Val(Combo1.Text) / 180 * ctP180 'Rotation angle to radians
       
       Set KjFocus = Me.ActiveControl 'memory the control with focus
       Command1.Enabled = False: Command2.Enabled = False: Combo1.Enabled = False
       
       'The following statement seems dispensable, but actually has two functions: restore the original image and size of the control before rotating
       Picture1.Picture = Picture1.Picture
       
       'Image data before rotation: width, height, color array, total bytes, bytes per row, bytes per pixel
       GetBmpDat Picture1, W1, H1, B1, Bs1, BytesW1, Ps1
       CenX1 = Int(W1 * 0.5): CenY1 = Int(H1 * 0.5) 'Image center point before rotation
       
       'Calculate the height and width of the control after rotation, and set the ScaleMode of the form and picture to 3 (pixels) in advance
       W2 = Abs(W1 * Cos(ToJ)) + Abs(H1 * Sin(ToJ)) 'After rotating: image width
       H2 = Abs(H1 * Cos(ToJ)) + Abs(W1 * Sin(ToJ)) 'After rotating: image height
       x = Picture1.Width - Picture1.ScaleWidth 'Picture frame border: width
       y = Picture1.Height - Picture1.ScaleHeight 'Picture frame border: height
       Picture1.Move Picture1.Left, Picture1.Top, x + W2, y + H2
       
       'The function of the Picture1.Cls statement below is not to clear the image, but to update the control
       'Image property, so that the image data can be obtained correctly when calling GetBmpDat
       Picture1.Cls
       Picture1.Line (0, 0)-(W2, H2), &HFFFFFF, BF
    
       'Image data after rotation: width, height, color array, total bytes, bytes per row, bytes per pixel
       GetBmpDat Picture1, W2, H2, B2, Bs2, BytesW2, Ps2
       CenX2 = Int(W2 * 0.5): CenY2 = Int(H2 * 0.5) 'After rotation: image center point
    
       'Display information
       Picture1.CurrentX = 5: Picture1.CurrentY = 5
       Picture1.Print "Processing, please wait..."
       Me.Refresh
       
       W1 = W1 - 1: H1 = H1 - 1
       For x = 0 To W2 - 1
       For y = 0 To H2 - 1
          Zhuan -ToJ, CenX2, CenY2, x, y, x1, y1 'Use x1, y1 to get the rotated coordinates
          x1 = x1 - CenX2 + CenX1: y1 = y1 - CenY2 + CenY1 'converted to the coordinates before rotation
          
          S2 = XYtoIndex(x, y, BytesW2, Ps2) 'After rotation: the index of the pixel in the array B2
          If x1 < 0 Or x1 > W1 Or y1 < 0 Or y1 > H1 Then
             B2(S2 + 2) = 255: B2(S2 + 1) = 255: B2(S2) = 255 'Exceed the original image area, set to white
          Else
             S1 = XYtoIndex(x1, y1, BytesW1, Ps1) 'Before rotation: the index of the pixel in the array B1
             B2(S2 + 2) = B1(S1 + 2): B2(S2 + 1) = B1(S1 + 1): B2(S2) = B1(S1) 'Red, Green and Blue
          End If
       Next
       Next
       SetBitmapBits Picture1.Image, Bs2, B2(0) 'Set the image of Picture1 to the rotated binary array B2()
       Command1.Enabled = True: Command2.Enabled = True: Combo1.Enabled = True
       On Error Resume Next
       KjFocus.SetFocus 'Restore the control with focus
    End Sub
    
    Private Sub GetBmpDat(Kj As Control, W As Long, H As Long, B() As Byte, Bs As Long, BytesW As Long, Ps As Long)
       'Get the image data of the control Kj
       Dim MapInf As Bitmap
       GetObject Kj.Image, Len(MapInf), MapInf 'Use MapInf to get the image information of Kj
       W = MapInf.bmWidth: H = MapInf.bmHeight 'Image width, height (pixels)
       BytesW = MapInf.bmWidthBytes 'The number of bytes occupied by each line
       Ps = BytesW \ W 'The number of bytes per pixel (usually 4)
       Bs = W * H * Ps 'Total number of bytes = width * height * bytes per pixel
       ReDim B(0 To Bs - 1)
       GetBitmapBits Kj.Image, Bs, B(0) 'Read the color values ??of all pixels of the Kj image into the binary array B()
    End Sub
    
    Private Function XYtoIndex(x As Long, y As Long, BytesW As Long, Ps As Long) As Long
       'Return the number position of the image coordinates x,y in the color array.
       'BytesW: the number of bytes occupied by each line of image, Ps: the number of bytes occupied by each pixel (usually 4)
       XYtoIndex = y * BytesW + x * Ps
    End Function
    
    Private Sub Zhuan(ToJ As Single, x0 As Long, y0 As Long, ByVal x As Long, ByVal y As Long, x1 As Long, y1 As Long)
       'Rotate the point x, y clockwise around x0, y0 by ToJ radians, and use x1, y1 to return the rotated position
       'Note: To set the pi ratio in advance ctP180 = 4 * Atn(1)
        Dim S As Single, J As Single
       
        x = x - x0: y = y - y0
        S = Sqr(x ^ 2 + y ^ 2) 'The distance between X,Y and x0,y0
        If S = 0 Then J = 0 Else J = y / S 'Sine of the angle between the horizontal line
    
        If Abs(J) >= 1 Then
           If J > 0 Then J = ctP180 * 0.5 Else J = -ctP180 * 0.5
           'Special case at 90 degrees
        Else
           J = Atn(J / Sqr(-J * J + 1)) 'The angle between the horizontal line
        End If
       
        If x < 0 Then J = -ctP180 - J
        x1 = x0 + S * Cos(J + ToJ): y1 = y0 + S * Sin(J + ToJ) 'Return to the rotated position
    End Sub
    
    Private Sub Picture1_DblClick()
     
      'The following statement seems dispensable, but actually has two functions: restore the original image and size of the control before rotating
       Picture1.Picture = Picture1.Picture
    End Sub
    Last edited by xiaoyao; Sep 5th, 2021 at 05:35 AM.

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Image rotation BY VB6

    This method is very fast, but there are white edges. How to remove the surrounding blank pixels?
    cairo-vb6/modGDIPlus.bas at master · javiercrowsoft/cairo-vb6 · GitHub
    https://github.com/javiercrowsoft/ca...modGDIPlus.bas

    BY GDIPLUS
    FORM1.FRM
    Code:
    Dim pen As Long
    
    Dim Bitmap As Long
    Dim Img2X As Single, Img2Y As Single, Img2W As Single, Img2H As Single
    
    Private Sub Form_Load()
    'add control :HScroll1,picture1
    
    Me.ScaleMode = 3
    Me.AutoRedraw = True
    Picture1.AutoRedraw = True
    Picture1.Height = Picture1.Width
    HScroll1.Max = 360
    InitGDIPlus
    'IntGdiPlus
    
    'Load Bitmap from file
    GdipCreateBitmapFromFile StrPtr(App.Path & "\cat.jpg"), Bitmap
    
    Dim ImgW As Long, ImgH As Long
        Call GdipGetImageWidth(Bitmap, ImgW)
         Call GdipGetImageHeight(Bitmap, ImgH)
     Dim diagonallength As Single
     diagonallength = Sqr(ImgW * ImgW + ImgH * ImgH)
    
    
      Picture1.Height = Picture1.Width
    
     If ImgW > ImgH Then 'Horizontal view
        Img2X = 0
        Img2W = Picture1.Width * ImgW / diagonallength
        Img2H = Img2W * ImgH / ImgW
        Img2X = (Picture1.Width - Img2W) / 2
        Img2Y = (Picture1.Width - Img2H) / 2
     Else
        Img2Y = 0
        Img2H = Picture1.Width * ImgH / diagonallength
        Img2W = Img2H * ImgW / ImgH
        Img2X = (Picture1.Width - Img2W) / 2
        Img2Y = (Picture1.Width - Img2H) / 2
     End If
    GdipCreatePen1 &HFFFF0000, 1, UnitPixel, pen
    
    
    'The following is used to draw Bitmap
    HScroll1_Change
    'Sweeping the floor
    
    
    End Sub
    
    
    
    Private Sub HScroll1_Change()
    'Me.Caption = "Rotation:" & HScroll1.value & "degrees"
    Picture1.Cls
    
    Dim Graphics As Long
    GdipCreateFromHDC Picture1.hDC, Graphics
    GdipSetSmoothingMode Graphics, SmoothingModeAntiAlias
    MGdipDrawRotateImgI Graphics, Bitmap, HScroll1.value, Img2X, Img2Y, Img2W, Img2H, 0
    GdipDeleteGraphics Graphics
    Picture1.Refresh
    End Sub
    
    
    'Rotate the drawing board method, rotate the drawing surface based on the image center, and then restore the drawing surface to get the rotated image.
    Public Sub MGdipDrawRotateImgI(ByVal Graphics As Long, ByVal Bitmap As Long, _
    ByVal angle As Long, ByVal x As Long, ByVal y As Long, _
    Optional ByVal W As Long = 0, Optional ByVal H As Long = 0, _
    Optional ByVal pen As Long = 0)
    On Error GoTo ToExit
    
    Dim Gbmp As Long
    Dim bmp As Long
    Dim gW As Long
    Dim Brush As Long
    Dim matrix As Long
    
    'Create a rotation matrix
    GdipCreateMatrix matrix
    'If the width and height of the bitmap are not set, the original width and height of the bitmap are obtained
    If W = 0 Or H = 0 Then
    GdipGetImageWidth Bitmap, W
    GdipGetImageHeight Bitmap, H
    End If
    
    'Calculate the side length of the minimum square required when the bitmap is rotated
    gW = Sqr((x + W) * (x + W) + (y + H) * (y + H))
    'Create memory bitmaps and canvases used as texture brushes
    GdipCreateBitmapFromScan0 gW, gW, 0, PixelFormat32bppARGB, ByVal 0, bmp
    GdipGetImageGraphicsContext bmp, Gbmp
    GdipGraphicsClear Gbmp, &HFFFFFF
    'Draw a bitmap used as a brush in the center of the canvas
    GdipDrawImageRectI Gbmp, Bitmap, (gW - W) / 2, (gW - H) / 2, W, H
    'Create a texture brush from a bitmap
    GdipCreateTexture bmp, WrapModeTileFlipXY, Brush
    'Clear the content on the canvas
    GdipGraphicsClear Gbmp, &HFFFFFF
    'Translate the rotation center to the center of the bitmap (the rotation center is in the upper left corner of the screen by default) and store it in the matrix
    GdipTranslateMatrix matrix, -gW / 2, -gW / 2, MatrixOrderAppend
    'Rotation matrix/ABCD, important
    GdipRotateMatrix matrix, angle, MatrixOrderAppend
    'Restore matrix translation
    GdipTranslateMatrix matrix, gW / 2, gW / 2, MatrixOrderAppend
    'Apply the matrix to the canvas
    GdipSetWorldTransform Gbmp, matrix
    'Set the canvas to anti-aliasing
    GdipSetSmoothingMode Gbmp, SmoothingModeAntiAlias
    'Use the texture brush to draw a rectangle that is 2 pixels smaller than the bitmap at the position where the bitmap is drawn (the bitmap has been cleared)
    GdipFillRectangleI Gbmp, Brush, (gW - W) / 2 + 2, (gW - H) / 2 + 2, W - 4, H - 4
    'If the pen is not 0, draw the border
    If pen <> 0 Then GdipDrawRectangleI Gbmp, pen, (gW - W) / 2 + 2, (gW - H) / 2 + 2, W - 4, H - 4
    'Set the canvas to anti-aliasing
    GdipSetSmoothingMode Graphics, SmoothingModeAntiAlias
    'Finally output a new bitmap without aliasing on the screen
    GdipDrawImageRectI Graphics, bmp, -((gW - W) / 2 - x), -((gW - H) / 2 - y), gW, gW
    
    'Release resources
    GdipDisposeImage bmp
    GdipDeleteGraphics Gbmp
    GdipDeleteBrush Brush
    GdipDeleteMatrix matrix
    
    Exit Sub
    ToExit:
    MsgBox Err.description
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
    
    GdipDisposeImage Bitmap
    TerminateGDIPlus
    
    
    End Sub
    GDI.BAS
    Code:
    Public Type POINTL
       x As Long
       y As Long
    End Type
    
    Public Type POINTF
       x As Single
       y As Single
    End Type
    ***MORE CODE
    Last edited by xiaoyao; Sep 4th, 2021 at 03:24 AM.

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Super fast running image rotation

    After rotation, there is such a white edge.
    Attached Images Attached Images    
    Last edited by xiaoyao; Sep 5th, 2021 at 05:35 AM.

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Super fast running image rotation

    This is the third method,by PlgBlt API

    Code:
    Private Type POINTAPI
    
        x As Long
    
        y As Long
    
    End Type
    
    Private Declare Function PlgBlt Lib "gdi32.dll" (ByVal hdcDest As Long, ByRef lpPoint As POINTAPI, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hbmMask As Long, ByVal xMask As Long, ByVal yMask As Long) As Long
    
    Private Const PI As Double = 3.1415926
    
    
    
    Public Function TurnPic(ByVal ObjMe As Object, ByVal pObj1 As Object, ByVal pObj2 As Object, ByVal dThetaDeg As Double)
    
      Dim pt(1 To 3) As POINTAPI, p4 As POINTAPI
    
      Dim dx As Long, dy As Long
    
      Dim I As Long, offsetX As Long, offsetY As Long
    
      Dim Sida As Double
    
      Dim MaxX As Long, MaxY As Long, MinX As Long, MinY As Long
    
        
    
      Sida = dThetaDeg * PI / 180
    
        
    
      dx = ObjMe.ScaleX(pObj1.Picture.Width, vbHimetric, vbPixels)
    
      dy = ObjMe.ScaleX(pObj1.Picture.Height, vbHimetric, vbPixels)
    
        
    
      pt(1).x = dy * Sin(Sida)
    
      pt(1).y = dy - dy * Cos(Sida)
    
      pt(2).x = pt(1).x + dx * Cos(Sida)
    
      pt(2).y = pt(1).y + dx * Sin(Sida)
    
      pt(3).x = 0: pt(3).y = dy
    
        
    
      'p4不用在pt()之阵列,它是由pt(1)-pt(3)所推出
    
      p4.x = pt(3).x + dx * Cos(Sida)
    
      p4.y = pt(3).y + dx * Sin(Sida)
    
        
    
      I = PlgBlt(pObj2.hDC, pt(1), pObj1.hDC, 0, 0, dx, dy, 0, 0, 0)
    
      pObj2.Refresh
    
    End Function
    
    
    
    Private Sub Form_Load()
    'ADD Controls:
    'COMMAND1,Picture1,Picture2
    
    Me.ScaleMode = 3
    Picture1.AutoSize = True
    
    Picture1.ScaleMode = 3
    Picture2.ScaleMode = 3
    
    Picture2.AutoRedraw = True
    Picture1.AutoRedraw = True
    Picture1.Picture = LoadPicture(App.Path & "\CAT.JPG")
    End Sub
    
    Private Sub Command1_Click()
    Picture2.Width = Picture1.Width * 2
    Picture2.Height = Picture1.Height * 2
            TurnPic Me, Picture1, Picture2, 45 '调用旋转处理函数,旋转1度
    
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width