[RESOLVED] [VB6] DIBs Rotate Image-VBForums
Results 1 to 14 of 14

Thread: [RESOLVED] [VB6] DIBs Rotate Image

  1. #1

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,919

    Resolved [RESOLVED] [VB6] DIBs Rotate Image

    in a module i have the 1 DIB RotateImage() sub:
    Code:
    Option Explicit
    
    Private 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
    
    Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
    
    Private Type RGBQUAD
       rgbBlue As Byte
       rgbGreen As Byte
       rgbRed As Byte
       rgbAlpha As Byte
    End Type
    
    Private Type BITMAPINFOHEADER
       bmSize As Long
       bmWidth As Long
       bmHeight As Long
       bmPlanes As Integer
       bmBitCount As Integer
       bmCompression As Long
       bmSizeImage As Long
       bmXPelsPerMeter As Long
       bmYPelsPerMeter As Long
       bmClrUsed As Long
       bmClrImportant As Long
    End Type
    
    Private Type BITMAPINFO
       bmHeader As BITMAPINFOHEADER
       bmColors(0 To 255) As RGBQUAD
    End Type
    
    Private Declare Function GetDIBits 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 Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dWidth As Long, ByVal dHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long, ByVal RasterOp As Long) As Long
    Private Declare Function GetBitmapDimensionEx Lib "gdi32" (ByVal hBitmap As Long, lpDimension As Size) As Long
    Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
    Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
    Public Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean
    Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
    Public 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
    Public Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
    
    Private Type Size
            cx As Long
            cy As Long
    End Type
    
    Dim bitmapsize As Size
    
    Private Type Color
        Red As Long
        Green As Long
        Blue As Long
    End Type
    
    Dim bmLen As Long
    Dim bm As BITMAP
    Dim bmi As BITMAPINFO
    Dim RGBColor As Color
    
    ' added this function I use to word align any bitmap bit depth
    Private Function ByteAlignOnWord(ByVal bitDepth As Byte, ByVal Width As Long) As Long
        ' function to align any bit depth on dWord boundaries
        ByteAlignOnWord = (((Width * bitDepth) + &H1F&) And Not &H1F&) \ &H8&
    End Function
    
    
    'Rotate an image
    Public Sub RotateImage(picSource As Control, picDestiny As Control, ByVal Angle As Single, Optional ByVal PosX As Long = 0, Optional ByVal PosY As Long = 0)
        Dim X1 As Long, Y1 As Long
        Dim X2 As Long, Y2 As Long
        Dim X As Long, Y As Long
        Dim CosA As Single, SinA As Single
        Dim SrcOffX As Long, SrcOffY As Long
        Dim ImageData() As Byte
        Dim ImageDataRotated() As Byte
       
        'calculate negative angle in radians, negative because mapping from destination to source
        Angle = Angle * 1.74532925199433E-02 'same as Angle * (pi/180) * -1
       
        CosA = Cos(Angle)
        SinA = Sin(Angle)
        Set picDestiny.Picture = Nothing
       
        
        'Now we fill up the bmi (Bitmap information variable) with all of the appropriate data
        bmi.bmHeader.bmSize = 40 'Size, in bytes, of the header (always 40)
        bmi.bmHeader.bmPlanes = 1 'Number of planes (always one)
        bmi.bmHeader.bmBitCount = 24 'Bits per pixel (always 24 for image processing)
        bmi.bmHeader.bmCompression = 0 'Compression: none or RLE (always zero)
    
        'Calculate the size of the bitmap type (in bytes)
        
        bmLen = Len(bm)
    
        'Get the picture box information from SrcPictureBox and put it into our 'bm' variable
        GetObject picSource.Image, bmLen, bm
        
        'Build a correctly sized array.
        ReDim ImageData(0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
        ReDim ImageDataRotated(0 To ByteAlignOnWord(24, bm.bmWidth) - 1, 0 To bm.bmHeight - 1)
    
        'Finish building the 'bmi' variable we want to pass to the GetDIBits call (the same variable we used above)
        bmi.bmHeader.bmWidth = bm.bmWidth
        bmi.bmHeader.bmHeight = bm.bmHeight
        SrcOffX = (bm.bmWidth \ 2)
        SrcOffY = (bm.bmHeight \ 2)
    
        'Now that we've completely filled up the 'bmi' variable, we use GetDIBits to take the data from SrcPictureBox and put it into the ImageData() array using the settings we specified in 'bmi'
        GetDIBits picSource.hdc, picSource.Image, 0, bm.bmHeight, ImageData(0, 0), bmi, 0
            
        For Y2 = 0 To bm.bmHeight - 1
            For X2 = 0 To ByteAlignOnWord(bmi.bmHeader.bmBitCount, bm.bmWidth) - 3 Step 3
                X = X2 - SrcOffX
                Y = Y2 - SrcOffY
                X1 = (X * CosA - Y * SinA) + SrcOffX
                If (X1 >= 0 And X1 < bm.bmWidth) Then
                    Y1 = (X * SinA + Y * CosA) + SrcOffY
                    If (Y1 >= 0 And Y1 < bm.bmHeight) Then
                        ImageDataRotated(X2 + 2, Y2) = ImageData(X1 + 2, Y1) ' Red
                        ImageDataRotated(X2 + 1, Y2) = ImageData(X1 + 1, Y1) 'Green
                        ImageDataRotated(X2, Y2) = ImageData(X1, Y1) 'Blue
                    End If
                End If
            Next X2
        Next Y2
        'Now that we've built the temporary header, we use StretchDIBits to take the data from the ImageData() array and put it into SrcPictureBox using the settings specified in 'bmi' (the StretchDIBits call should be on one continuous line)
        StretchDIBits picDestiny.hdc, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, bm.bmWidth, bm.bmHeight, ImageDataRotated(0, 0), bmi, 0, vbSrcCopy
            
        'Since this doesn't automatically initialize AutoRedraw, we have to do it manually
        'Note: always keep AutoRedraw as 'True' when using DIB sections. Otherwise, you WILL get unpredictable results.
        If picDestiny.AutoRedraw = True Then
            picDestiny.Picture = picDestiny.Image
            picDestiny.Refresh
        End If
    End Sub
    but i don't get the right results
    can anyone help me?
    thanks
    VB6 2D Sprite control

    To live is difficult, but we do it.

  2. #2
    Lively Member Mikle's Avatar
    Join Date
    Oct 2009
    Location
    Tuapse, Russia
    Posts
    81

    Re: [VB6] DIBs Rotate Image


  3. #3

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,919

    Re: [VB6] DIBs Rotate Image

    Quote Originally Posted by Mikle View Post
    works fine
    i will try change for build a nice procedure
    but i need hask you 1 thing: can i do it without the mask picture?
    (i know, without that, i can see an "hidden" color, but i can take it off)
    thanks
    Last edited by joaquim; Nov 23rd, 2009 at 01:10 PM.
    VB6 2D Sprite control

    To live is difficult, but we do it.

  4. #4
    Lively Member Mikle's Avatar
    Join Date
    Oct 2009
    Location
    Tuapse, Russia
    Posts
    81

    Re: [VB6] DIBs Rotate Image

    Without the mask picture:
    http://tuapse-mikle.narod.ru/RotVB.zip

  5. #5

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,919

    Re: [VB6] DIBs Rotate Image

    Quote Originally Posted by Mikle View Post
    Without the mask picture:
    http://tuapse-mikle.narod.ru/RotVB.zip
    i need ask you something: what it's Timer?(i can't find these variable)
    Code:
    Rot Timer
    you code can be easy to understand, but i have some problems to understand everything, but i'm trying ctach the idea
    thanks
    Last edited by joaquim; Nov 24th, 2009 at 01:31 PM.
    VB6 2D Sprite control

    To live is difficult, but we do it.

  6. #6

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,919

    Re: [VB6] DIBs Rotate Image

    sorry ask you these
    but can you give me the project more simplificated?
    like:
    -put 2 pictureboxes in form and 1 textbox for the angle;
    -put the image(picturebox1) in variabel array(getdibits());
    -then put the result in picturebox2(SetDIBitsToDevice).
    sorry ask you these, but i have some problems for finish what i need
    thanks for everything
    VB6 2D Sprite control

    To live is difficult, but we do it.

  7. #7
    Lively Member Mikle's Avatar
    Join Date
    Oct 2009
    Location
    Tuapse, Russia
    Posts
    81

    Re: [VB6] DIBs Rotate Image


  8. #8

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    2,919

    Re: [VB6] DIBs Rotate Image

    Quote Originally Posted by Mikle View Post
    yes
    thank you very much
    thanks
    VB6 2D Sprite control

    To live is difficult, but we do it.

  9. #9
    New Member
    Join Date
    Feb 2012
    Posts
    4

    Re: [RESOLVED] [VB6] DIBs Rotate Image

    Hello MIkle,

    Thanks for you wonderfull code. It works very well and fast.

    I want to save the result to an image file or transfere it to another picturebox or image-controll.
    The picture property seems to stay empty also working with the .image property is giving me a empty white .bmp.

    Can you please give me an example on how to do that?

    Thank you in advance.

    Regards,

    Bram

  10. #10
    Lively Member Mikle's Avatar
    Join Date
    Oct 2009
    Location
    Tuapse, Russia
    Posts
    81

    Re: [RESOLVED] [VB6] DIBs Rotate Image

    Bramazzotti
    Change picOut.AutoRedraw property to True, add "Refresh" here:
    Code:
    Private Sub txt_Change()
      Rot Val(txt.Text) * 3.141593 / 180
      SetDIBitsToDevice picOut.hDC, 0, 0, Rad2, Rad2, 0, 0, 0, Rad2, ArOut(0, 0), bi32BitInfo, 0
      picOut.Refresh
    End Sub
    Saving to file:
    Code:
    Private Sub Command1_Click()
      SavePicture picOut.Image, "out.bmp"
    End Sub

  11. #11
    New Member
    Join Date
    Feb 2012
    Posts
    4

    Re: [RESOLVED] [VB6] DIBs Rotate Image

    The autoredraw=true in combination with the picout.image (not picture) did the trick.

    Thanks!

  12. #12
    New Member
    Join Date
    Feb 2012
    Posts
    4

    Re: [RESOLVED] [VB6] DIBs Rotate Image

    Mikle,

    Hope you can help me again.

    Your function works fine but generates bigger pictures as the original. Which is a side effect of rotating images.

    I only need to rotate the image with -90 (or 270).

    I have an image of 80x160 pixels which needs to be rotated, afther this it should be an image of 160x80 pixels. I have been playing with the pHeight and rad2 variables but do not seem to get it to work.

    Can you please help me on this?

    Thanks in advance!

  13. #13
    Lively Member Mikle's Avatar
    Join Date
    Oct 2009
    Location
    Tuapse, Russia
    Posts
    81

    Re: [RESOLVED] [VB6] DIBs Rotate Image

    Redim your ArOut() array manually. Rotate:
    Code:
    Public Sub Rotate90(ArIn() As Long, ArOut() As Long)
      Dim w As Long, h As Long
      Dim x As Long, y As Long
      w = UBound(ArIn(), 1) + 1
      h = UBound(ArIn(), 2) + 1
      For y = 0 To h - 1
        For x = 0 To w - 1
          ArOut(h - y - 1, x) = ArIn(x, y)
        Next x
      Next y
    End Sub
    
    Public Sub Rotate180(ArIn() As Long, ArOut() As Long)
      Dim w As Long, h As Long
      Dim x As Long, y As Long
      w = UBound(ArIn(), 1) + 1
      h = UBound(ArIn(), 2) + 1
      For y = 0 To h - 1
        For x = 0 To w - 1
          ArOut(w - x - 1, h - y - 1) = ArIn(x, y)
        Next x
      Next y
    End Sub
    
    Public Sub Rotate270(ArIn() As Long, ArOut() As Long)
      Dim w As Long, h As Long
      Dim x As Long, y As Long
      w = UBound(ArIn(), 1) + 1
      h = UBound(ArIn(), 2) + 1
      For y = 0 To h - 1
        For x = 0 To w - 1
          ArOut(y, w - x - 1) = ArIn(x, y)
        Next x
      Next y
    End Sub

  14. #14
    New Member
    Join Date
    Feb 2012
    Posts
    4

    Re: [RESOLVED] [VB6] DIBs Rotate Image

    Thank you!

    That did the trick!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.