Solved

Rotate Image 90 degrees FAST using win api

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

0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

706 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now