Rotate a Picture in Buffer

>is there a way to 'increase the size of the picture when displaying in the picturebox control?
Yes you can use Stretchblt to increase the size of the picture
This sample will double the size of the picture displayed......

Call StretchBlt(hdcDest, 0, 0, VIEWFINDER_WIDTH*2, VIEWFINDER_HEIGHT*2, hdcSrc, 0, 0, VIEWFINDER_WIDTH, VIEWFINDER_HEIGHT, &HCC0020)

> The problem is that I want to 'rotate' the picture BEFORE it is displayed... is there a way to rotate the data before I display it in the picturebox control?

Yes you can easily rotate picture before displaying it..... Please tell me if you want to rotate in increments of 90(90,180 270)  or any arbitrary angle.....
 

The best technique I have found to rotate images at any arbitrary angle is posted on visualbasicforum.com by Billsoo

Quote from the original website and author......

Here is a simple program that rotates an image using 3 methods. pset/point, getpixel/setpixel and direct memory read/writes. I've included a simple frame counter so you can compare the methods.

The technique works by making an array point to the picture bitmap. You can then read and write to the array to modify the picture. There are basically 3 steps to set this up:

1) get the bitmap information from the picture
2) Copy the bitmap info to a SafeArray2D structure. This structure is how VB stores dynamic arrays
3) Assign a dynamic array to point to the SafeArray structure. This essentially makes the array take over all the safearray attributes, including the pointer to the bitmap data.

On my system (a P3-500), I get about 1 fps with pset/point, 2-3 fps using getpixel/setpixel and 6-7 fps using direct memory access. An improvement of around 3x.

However, since the technique is so heavily dependant on arrays, it is very responsive to removing array bounds checks etc.

If you set the compiler so that it removes all safety checks (the vbp included does this) and compile the project, the executable will run at around 24 fps with direct memory while the other methods are still around 3 or less fps. This is an improvement of 8x.

Currently, the technique as shown works only on 256 colour bitmaps because it uses arrays of bytes. It could be modified to use 16 bit high colour by using arrays of integers. You could also modify it to use true 24 bit colour by using an array of UDT of 3 bytes each.

Add this into a module.......

'Copied from a module by Simon Price and slightly modified
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type

Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type

Public Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type


Public ViewSA As SAFEARRAY2D
Public TextureSA As SAFEARRAY2D

Public ViewBMP As BITMAP
Public TextureBMP As BITMAP

Sub LoadPicArray2D(p As StdPicture, sa As SAFEARRAY2D, bmp As BITMAP, data() As Byte)
   
GetObjectAPI p, Len(bmp), bmp                    'retrieve bitmap information about p
If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then 'only works on 1 byte per pixel (256 colour) maps
    MsgBox " 8-Bit Bitmaps Only!", vbCritical
Exit Sub
End If


' make the local matrix point to bitmap pixels
With sa
  .cbElements = 1
  .cDims = 2
  .Bounds(0).lLbound = 0
  .Bounds(0).cElements = bmp.bmHeight
  .Bounds(1).lLbound = 0
  .Bounds(1).cElements = bmp.bmWidthBytes
  .pvData = bmp.bmBits
End With
' copy bitmap data into byte array
CopyMemory ByVal VarPtrArray(data), VarPtr(sa), 4
End Sub

Sub PicArrayKill(data() As Byte)
' MUST be called to free up memory
CopyMemory ByVal VarPtrArray(data), 0&, 4
End Sub

1)  Draw two picture boxes on the form
2)  Draw three option buttons on the form and name them   optPset , optGetPixel and  optMem
3)  Draw a timer and set its interval to 1000
4)  A button and name it RotateButton
5)  A checkbox and name it chkSwirl

Now paste the following code into General section

Option Explicit
Dim nFrames As Integer
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

Private ViewData() As Byte 'View bitmap array
Private TextureData() As Byte 'Textures bitmap array


Private Sub Form_Load()
'Initialize by setting the arrays to point to the picture memory
LoadPicArray2D Picture1.Picture, TextureSA, TextureBMP, TextureData()
LoadPicArray2D Picture2.Picture, ViewSA, ViewBMP, ViewData()
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Release the memory. REQUIRED
PicArrayKill TextureData()
PicArrayKill ViewData()
End
End Sub

Private Sub optGetPixel_Click()
Picture2.AutoRedraw = True
End Sub

Private Sub optMem_Click()
Picture2.AutoRedraw = False
'this techique draws to the PICTURE property, not the IMAGE property
'so we can't use AutoRedraw
End Sub

Private Sub optPset_Click()
Picture2.AutoRedraw = True
End Sub

Private Sub RotateButton_Click()
Dim X&, Y&, x1&, y1&, c&, r#
Dim theta As Double
Dim iMethod%
Dim bSwirl As Boolean  'optional swirl effect flag
Static done As Boolean

If RotateButton.Caption = "&Start" Then
    RotateButton.Caption = "&Stop"
    done = False
Else
    RotateButton.Caption = "&Start"
    done = True
End If

While Not done   'main loop
    theta = theta + 5# / 180# * 3.141   'increment theta by 5 degrees
    If optPset.Value Then iMethod = 0
    If optGetPixel.Value Then iMethod = 1
    If optMem.Value Then iMethod = 2
    bSwirl = chkSwirl.Value <> 0
    'for every pixel in picture1, copy it to picture2 after moving it around theta degrees
    For X& = 0 To 199
        For Y& = 0 To 199
            If bSwirl Then
                r# = Sin(Sqr((X& - 100) * (X& - 100) + (Y& - 100) * (Y& - 100)) / 10) / 10
                x1& = 100 + (X& - 100) * Cos(theta * r#) - (Y& - 100) * Sin(theta * r#)
                y1& = 100 + (Y& - 100) * Cos(theta * r#) + (X& - 100) * Sin(theta * r#)
            Else
                x1& = 100 + (X& - 100) * Cos(theta) - (Y& - 100) * Sin(theta)
                y1& = 100 + (Y& - 100) * Cos(theta) + (X& - 100) * Sin(theta)
            End If
            If (x1& > 0) And (x1& < 200) And (y1& > 0) And (y1& < 200) Then
                Select Case iMethod  'pick a drawing method...
                    Case 0  'point and pset
                        c& = Picture1.Point(X&, Y&)
                        Picture2.PSet (x1&, y1&), c&
                    Case 1  'getpixel setpixel
                        c& = GetPixel(Picture1.hdc, X&, Y&)
                        SetPixel Picture2.hdc, x1&, y1&, c&
                    Case Else 'direct memory read/write
                        c& = TextureData(X&, Y&)
                        ViewData(x1&, y1&) = c&
                End Select
            End If
        Next Y&
    Next X&
    Picture2.Refresh       'refresh to show new image
    nFrames = nFrames + 1  'increment for frame counter
    DoEvents
Wend
End Sub

Private Sub Timer1_Timer()
Label1 = CStr(nFrames) & " fps"
nFrames = 0
End Sub



If you have troble in running the program then you can download a sample at
http://www.xtremevbtalk.com/attachment.php?s=80da5139856a95eb0b5fa438a5c6ecd8&attachmentid=429
but you will have to register......
and to rotate only in multiples of 90 you can use
http://www.xtremevbtalk.com/attachment.php?s=80da5139856a95eb0b5fa438a5c6ecd8&attachmentid=2407

Thanks for the response... Yes I want to rotate it either 90 or270...Also the image will probably be in 24 bit colour. Is there any chance you can send me the modified code using UDT?

Since you need to rotate the program that rotates the image in increments of 90, you  can use the following code directly for 24 bit pictures..... (The same from xtremevbtalk.com)If you have created an account on the xtremevbtalk.com site then you can directly download the Project from this page.....

http://www.xtremevbtalk.com/attachment.php?s=80da5139856a95eb0b5fa438a5c6ecd8&attachmentid=2407

In case you cant use the following......

1) Draw two Picture Boxes on the Form and name them "picInitial" and "picRot"
2) Set Autoredraw =True for both of them......

Option Explicit
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type
Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Private Sub Form_Load()
Dim fn As String
fn =      'Path of the Image
picInitial = LoadPicture(fn)
picRot = picInitial
picRot.Move 0, 0, picInitial.Height, picInitial.Width
End Sub

Private Sub picInitial_Click()
Dim bmi As BITMAPINFO
Dim bits() As RGBQUAD
Dim x As Long, y As Long
Dim aRot() As RGBQUAD
Dim mx As Long, my As Long
 
'//Redim our array to the size of the picturebox
mx = picInitial.ScaleWidth - 1
my = picInitial.ScaleHeight - 1
ReDim bits(mx, my)
ReDim aRot(my, mx)
With bmi.bmiHeader
    .biSize = 40
    .biPlanes = 1
    .biBitCount = 32
    .biCompression = 0
    .biClrUsed = 0
    .biClrImportant = 0
    .biSizeImage = (mx + 1) * (my + 1)
    .biWidth = mx + 1
    .biHeight = my + 1
End With
x = GetDIBits(picInitial.hdc, picInitial.Image.Handle, 0, my + 1, bits(0, 0), bmi, DIB_RGB_COLORS)
For x = 0 To mx
    For y = 0 To my
        aRot(my - y, x) = bits(x, y)
    Next y
Next x
With bmi.bmiHeader
    .biSize = 40
    .biPlanes = 1
    .biBitCount = 32
    .biCompression = 0
    .biClrUsed = 0
    .biClrImportant = 0
    .biSizeImage = (mx + 1) * (my + 1)
    .biWidth = my + 1
    .biHeight = mx + 1
End With
x = SetDIBits(picRot.hdc, picRot.Image.Handle, 0, bmi.bmiHeader.biHeight, aRot(0, 0), bmi, DIB_RGB_COLORS)
picInitial.Visible = False
picRot.Refresh
End Sub

The sample vb app I downloaded... it flips the image 180... how do I adjust to 90?

Are you talking about the sample Flip90.zip ? If yes then it flips it to 90 degrees.......
and as far as rotating in 180 is concerned it can be done very easily without any of this mess (Negative arguments in Bitblt)

k, the rotate works great... now back to the stretchBLT...it is giving more of a zoom look and not enlarging it...
I used:
Call StretchBlt(hdcDest, 0, 0, VIEWFINDER_WIDTH*2, VIEWFINDER_HEIGHT*2, hdcSrc, 0, 0, VIEWFINDER_WIDTH, VIEWFINDER_HEIGHT, &HCC0020)
am I just not using it correctly?

k, Now... once I have taken the pictures with the camera, I am going to display the picture in an Image control because it has the stretch.method that allows me to display the 'large' picture in a small window... is there a way to rotate an image control where as before I was rotating a Picture control?

Image Control  has a severe limitation that it doesnot have a hDC which is essential for many API that are used........

I have done a few months ago a project to rotate pictures in eVB and its picture box didnot had hDC. I used a couple of API's to get it...... I think you can also use it for Image control. Maybe this seem to be usefull to you......


It is the exact code from eVB you will need to change the declaration of the API's and then call the function......
======================================
Public Declare Function ChildWindowFromPoint Lib "Coredll" (ByVal hwnd As Long, ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Declare Function GetDC Lib "Coredll" (ByVal hwnd As Long) As Long

Function GetWindowDC(hwnd As Long, X As Integer, Y As Integer) As Long
Dim ChildWnd As Long
ChildWnd = ChildWindowFromPoint(hwnd, X, Y)
GetWindowDC = GetDC(ChildWnd)
End Function
'================================

This function will return you the hDC of any control on your form. Where X and Y are the Left and Top coordinates of the Imagebox in pixels:

Dim PicthDC
PicthDC = GetWindowDC(Form1.hWnd, Imagebox.left, imagebox.top)


Now you will be able to rotate the picture as you have done earlier...... or maybe
Please do tell me if it worked......
Cheers
Imran Arshad

before I would call a routine Rotate and passed it form,pic1, pic2... with this new code do I need to put this in the rotate routine or what?

What were pic1 and pic2 ? Perhaps Picture boxes..... If yes then in the rotation routine you will be using pic1.hDC and pic2.hDC ?
If this is the case then you will need to use ImageControl.hDC instead of it.....
Can you share the rotation routine so that I can help you better?

k, here is my Rotation routine
Public Sub Rotate(xfrm As Form, picInitial As Object, picRot As Object)
    Dim bmi As BITMAPINFO
    Dim bits() As RGBQUAD
    Dim X As Long, Y As Long
    Dim aRot() As RGBQUAD
    Dim mx As Long, my As Long
    Dim pleft As Integer
     
     
    picRot = picInitial
   pleft = (xfrm.ScaleWidth / 2) - (picInitial.Height / 2)
    picRot.Move pleft - 1200, 2400, picInitial.Height, picInitial.Width
    '//Redim our array to the size of the picturebox
    mx = picInitial.ScaleWidth - 1
    my = picInitial.ScaleHeight - 1
    ReDim bits(mx, my)
    ReDim aRot(my, mx)
    With bmi.bmiHeader
        .biSize = 40
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = 0
        .biClrUsed = 0
        .biClrImportant = 0
        .biSizeImage = (mx + 1) * (my + 1)
        .biWidth = mx + 1
        .biHeight = my + 1
    End With
    X = GetDIBits(picInitial.hdc, picInitial.Image.handle, 0, my + 1, bits(0, 0), bmi, DIB_RGB_COLORS)
    For X = 0 To mx
        For Y = 0 To my
            aRot(my - Y, X) = bits(X, Y)
        Next Y
    Next X
    With bmi.bmiHeader
        .biSize = 40
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = 0
        .biClrUsed = 0
        .biClrImportant = 0
        .biSizeImage = (mx + 1) * (my + 1)
        .biWidth = my + 1
        .biHeight = mx + 1
    End With
    X = SetDIBits(picRot.hdc, picRot.Image.handle, 0, bmi.bmiHeader.biHeight, aRot(0, 0), bmi, DIB_RGB_COLORS)
    picInitial.Visible = False
    picRot.Refresh

End Sub


Thanks

I need to be able to rotate both... the code you got me before which I use that Rotate routine allows me to rotate the picturebox control and then I stretch it using StretchBLT and that works fine...
Now on a different form, I need to pull up an image (large images) into an image control where the Stretch property = true so that I can see the large image on my form "smaller"... the only issue now is I have to rotate that image in the Image control...

OK
Let me figure it out......
I will respond in about 2 hrs time.....

Thank you.

printing images

Sorry for the delay.......
At the moment I am watching Champions League Semi Final (Chelsea vs. Monaco)
So I might not be able to respond for a while......

any ideas yet?

Let me know...

Hello!
Sorry for the delayed reply..... I just used the Idea that I suggested to you......
I somehow got the hDC of Image Control and was able to bitblt image in it. But then I realized which I should have realized a far earlier..... After I bitblt the rotated image into the Image control it didn't stretched or resized to fit into the Image control....
 And if I tried to stretch the Image Control after blitting it simply disappeared (No Autoredraw). So this technique simply failed.... Maybe some way to avoid it......
If you need I will give you the code......

Second option that came to my mind was to use paintpicture to downsize the picture using Picture box....
I will post the solution in a while......

I just purchased an Image Control from Viscom Software that does everything... The only short-fall I see with it is that it allows me to print the image but I was hoping that I could add text the printout...Any thing you know if I could do for that?
They have a PrintImage method that you pass either true or false (true = show print dialog, false=just print)... anyway you know of that I can print somethign to a printer object, etc and add text etc?
Thanks for all your help.

Add a new Picturebox on the form and name it Picture2. Its size will matter as the image will be shrinked to the size of this Picturebox......

Add these lines at the end of the Rotate routine
After these two lines
picInitial.Visible = False
picRot.Refresh


picRot.autoredraw=true 'If not already so.......
picRot.Picture = picRot.Image  'The really tricky one took along time to be sorted out
Picture2.PaintPicture picRot.Picture, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, 0, 0, picRot.ScaleWidth, picRot.ScaleHeight

This code will simply shrink what was visible in picRot Picturebox to the size of Picture2.....
Please do tell me if it worked.....
I have not tested it into your rotate function but most probably will work....
If it didnot work Please try to check if scalemode is same for all Picture boxes...

I think at this point I am going to try and use the Image Control from Viscom but I don't know if there is a way to add text to the printout or force the print data to something where I can add text to it, etc and then print...