Solved

Rotate Image 90 degrees FAST using win api

Posted on 2006-11-10
7
1,585 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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 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 28

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

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

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

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
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…
Suggested Courses
Course of the Month10 days, 9 hours left to enroll

631 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