Solved

Rotate Image 90 degrees FAST using win api

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

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…
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…
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…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

910 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

23 Experts available now in Live!

Get 1:1 Help Now