Solved

Rotate Image 90 degrees FAST using win api

Posted on 2006-11-10
7
1,416 Views
Last Modified: 2008-01-09
I have an image I have rendered (not loaded) into a PictureBox with .AutoRedraw=True.  I need to rotate that image 90 degrees clockwise and save it to disk as a two-color black-and-white .bmp or .gif file.  I need to do it FAST, so it has to be in-memory (GetPixel/SetPixel are out).

I will probably be using GetDIBits and SetDIBits, but unfortunately I am not familiar enough with the Windows API to just hammer out a function.  Any help would be appreciated.
0
Comment
Question by:dberner9
7 Comments
 
LVL 10

Expert Comment

by:Kinger247
ID: 17916890
You've probably already seen this, but ...
I've use this code in the past http://www.devx.com/vb2themax/Tip/19360
It sort of does what you asked but it'll need refining.
0
 
LVL 15

Expert Comment

by:JackOfPH
ID: 17918895
0
 
LVL 22

Expert Comment

by:danaseaman
ID: 17919689
'This rotates pic by 90 deg fast. GetBitmapPixels and SetBitmapPixels can be found at http://www.vb-helper.com/HowTo/howto_animated_shapes_picturebox.zip (see Module1.bas in the zip for GetBitmapPixels and SetBitmapPixels.  )


Public Sub RotatePicture(fr_pic As PictureBox, to_pic As _
    PictureBox)
Dim fr_pixels() As RGBTriplet
Dim to_pixels() As RGBTriplet
Dim bits_per_pixel As Integer
Dim fr_wid As Long
Dim fr_hgt As Long
Dim to_wid As Long
Dim to_hgt As Long
Dim X As Integer
Dim Y As Integer

    ' Get the picture's image.
    GetBitmapPixels fr_pic, fr_pixels, bits_per_pixel

    ' Get the picture's size.
    fr_wid = UBound(fr_pixels, 1) + 1
    fr_hgt = UBound(fr_pixels, 2) + 1
    to_wid = fr_hgt
    to_hgt = fr_wid

    ' Size the output picture to fit.
    to_pic.Width = to_pic.Parent.ScaleX(fr_hgt, vbPixels, _
        to_pic.Parent.ScaleMode) + _
        to_pic.Width - to_pic.ScaleWidth
    to_pic.Height = to_pic.Parent.ScaleY(fr_wid, vbPixels, _
        to_pic.Parent.ScaleMode) + _
        to_pic.Height - to_pic.ScaleHeight

    ' Copy the pixels rotated 90 degrees.
    ReDim to_pixels(0 To to_wid - 1, 0 To to_hgt - 1)
    For X = 0 To fr_wid - 1
        For Y = 0 To fr_hgt - 1
            to_pixels(to_wid - Y - 1, X) = fr_pixels(X, Y)
        Next Y
    Next X

    ' Display the result.
    SetBitmapPixels to_pic, bits_per_pixel, to_pixels

    ' Make the image permanent.
    to_pic.Refresh
    to_pic.Picture = to_pic.Image
End Sub
0
 
LVL 27

Accepted Solution

by:
Ark earned 435 total points
ID: 17928416
Try this:

Option Explicit

Const GM_ADVANCED As Long = 2
Const Pi          As Single = 3.141593

Private Type XForm
    eM11 As Single
    eM12 As Single
    eM21 As Single
    eM22 As Single
    eDx As Single
    eDy As Single
End Type

Private Type PointAPI
    x As Long
    y As Long
End Type

Dim RotAng     As Single

Private Declare Function SetViewportOrgEx Lib "gdi32" (ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As Any) As Long
Private Declare Function SetGraphicsMode Lib "GDI32.dll" (ByVal hDC As Long, ByVal iMode As Long) As Long
Private Declare Function GetWorldTransform Lib "GDI32.dll" (ByVal hDC As Long, ByRef lpXform As XForm) As Long
Private Declare Function SetWorldTransform Lib "GDI32.dll" (ByVal hDC As Long, ByRef lpXform As XForm) As Long
Private 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

Private Sub Command2_Click()
    Timer1.Interval = 50
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    RotAng = RotAng + 2
    Picture2.Cls
    RotatePicture Picture1, Picture2, RotAng
    Timer1.Enabled = True
End Sub

Private Sub Command1_Click()
    Timer1.Enabled = False
    Picture2.Cls
    RotatePicture Picture1, Picture2, 90
End Sub

Private Sub Form_Load()
   With Picture1
      .Appearance = 0
      .AutoRedraw = True
      .AutoSize = True
      .BorderStyle = 0
      .ScaleMode = vbPixels
      .Picture = LoadPicture("c:\windows\gone fishing.bmp")
   End With
   With Picture2
      .Appearance = 0
      .AutoRedraw = True
      .AutoSize = True
      .BorderStyle = 0
      .ScaleMode = vbPixels
   End With
   Command1.Caption = "Rotate 90"
   Command2.Caption = "Rotate"
End Sub

Private Sub RotatePicture(ByVal picSrc As PictureBox, ByVal picDest As PictureBox, _
                          ByVal Angle As Long)
    Dim AngleRad As Single
    Dim MyXForm As XForm, OldXForm As XForm
    Dim OldOrg As PointAPI
    Dim w As Long, h As Long, OldMode As Long
   
    AngleRad = (Angle / 180) * Pi
    w = picSrc.ScaleWidth
    h = picSrc.ScaleHeight
   
    With MyXForm
       .eM11 = Cos(AngleRad)
       .eM12 = Sin(AngleRad)
       .eM21 = -.eM12
       .eM22 = .eM11
    End With

    Call GetWorldTransform(picDest.hDC, OldXForm)
    Call SetViewportOrgEx(picDest.hDC, w / 2, w / 2, OldOrg)
    OldMode = SetGraphicsMode(picDest.hDC, GM_ADVANCED)
    Call SetWorldTransform(picDest.hDC, MyXForm)
    BitBlt picDest.hDC, -w / 2, -h / 2, w, h, picSrc.hDC, 0, 0, vbSrcCopy
    Call SetWorldTransform(picDest.hDC, OldXForm)
    Call SetGraphicsMode(picDest.hDC, OldMode)
    Call SetViewportOrgEx(picDest.hDC, OldOrg.x, OldOrg.y, ByVal 0&)
End Sub

1

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

803 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question