Solved

Rotate Image 90 degrees FAST using win api

Posted on 2006-11-10
7
1,532 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 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 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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

734 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