Click here to Skip to main content
14,209,923 members

Visual Basic

 
PinnedHOW TO ANSWER A QUESTION PinPopular
Chris Maunder12-Jul-09 22:40
adminChris Maunder12-Jul-09 22:40 
PinnedHow to get an answer to your question PinPopular
Chris Maunder10-Nov-05 16:30
adminChris Maunder10-Nov-05 16:30 
QuestionProblem cropping an image. SOLVED Pin
speedbump998-Jun-19 6:07
memberspeedbump998-Jun-19 6:07 
Sorry for so much code but I think you need to see all of it.
The below code works for a 32 bpp image but using a 24 bpp image. The resulting
24 bpp image is skewed; it looks like by 1 pixel. The skewing starts at the top an skews
to the right down the image. I've tried messing with indices and widths but can not
get a clue as to what's happening.
Am I missing something really simple?

Public Sub CropImage()
'Source image in a PictureBox
Dim _arRGBValues() As Byte
Dim _BMPData As Imaging.BitmapData
Dim _BMPPtr As IntPtr
Dim bmSrc As Bitmap = Me.Image.Clone()
Dim rect As New Rectangle(0, 0, bmSrc.Width, bmSrc.Height)

_BMPData = bmSrc.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmSrc.PixelFormat)

_BMPPtr = _BMPData.Scan0

If bmSrc.PixelFormat = Imaging.PixelFormat.Format24bppRgb Then
' 24bpp
Dim bytes As Integer = (bmSrc.Width * bmSrc.Height) * 3
ReDim _arRGBValues(bytes - 1)
System.Runtime.InteropServices.Marshal.Copy(_BMPPtr, _arRGBValues, 0, _arRGBValues.Length)
Else
' 32bpp
Dim bytes As Integer = (bmSrc.Width * bmSrc.Height) * 4
ReDim _arRGBValues(bytes - 1)
System.Runtime.InteropServices.Marshal.Copy(_BMPPtr, _arRGBValues, 0, _arRGBValues.Length)
End If


' Destination image
Dim arCropValues() As Byte
Dim cropData As Imaging.BitmapData
Dim cropPtr As IntPtr

' Size to src bm above - 1 pixel in width to allow for 1 pixel offset; height is the same.
Dim bmCrop As Bitmap = New Bitmap(bmSrc.Width - 1, bmSrc.Height, bmSrc.PixelFormat)

Dim cropRect As New Rectangle(0, 0, bmCrop.Width, bmCrop.Height)

cropData = bmCrop.LockBits(cropRect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmCrop.PixelFormat)
cropPtr = cropData.Scan0

If bmCrop.PixelFormat = Imaging.PixelFormat.Format24bppRgb Then
' 24bpp
Dim bytes As Integer = (bmCrop.Width * bmCrop.Height) * 3
ReDim arCropValues(bytes - 1)
System.Runtime.InteropServices.Marshal.Copy(cropPtr, arCropValues, 0, arCropValues.Length)
Else
' 32bpp
Dim bytes As Integer = (bmCrop.Width * bmCrop.Height) * 4
ReDim arCropValues(bytes - 1)
System.Runtime.InteropServices.Marshal.Copy(cropPtr, arCropValues, 0, arCropValues.Length)
End If

' Copy from source image
Dim colour As Color
' Start at column 1; 1 pixel column offset
Dim xOffset As Integer = 1
Dim yDst As Integer = 0

For ySrc As Integer = 0 To Me.Image.Height - 1

' Copy starting at bmCrop column 0
Dim xDst As Integer = 0

' Starting at bmSrc column xOffset
For xSrc As Integer = xOffset To Me.Image.Width - 1

' Get pixel
If bmSrc.PixelFormat = Imaging.PixelFormat.Format24bppRgb Then
' 24bpp
Dim index As Integer = ((ySrc * bmSrc.Width) + xSrc) * 3
Dim b As Integer = _arRGBValues(index)
Dim g As Integer = _arRGBValues(index + 1)
Dim r As Integer = _arRGBValues(index + 2)
colour = Color.FromArgb(r, g, b)
Else
' 32bpp
Dim index As Integer = ((ySrc * bmSrc.Width) + xSrc) * 4
Dim b As Integer = _arRGBValues(index)
Dim g As Integer = _arRGBValues(index + 1)
Dim r As Integer = _arRGBValues(index + 2)
Dim a As Integer = _arRGBValues(index + 3)
colour = Color.FromArgb(a, r, g, b)
End If


' Set Pixel
If bmSrc.PixelFormat = Imaging.PixelFormat.Format24bppRgb Then
' 24bpp
Dim index As Integer = ((yDst * bmCrop.Width) + xDst) * 3
arCropValues(index) = colour.B
arCropValues(index + 1) = colour.G
arCropValues(index + 2) = colour.R
Else
' 32bpp
Dim index As Integer = ((yDst * bmCrop.Width) + xDst) * 4
arCropValues(index) = colour.B
arCropValues(index + 1) = colour.G
arCropValues(index + 2) = colour.R
arCropValues(index + 3) = colour.A
End If

'Exit when hit width of the destination bitmap
xDst += 1
If xDst >= bmCrop.Width Then
Exit For
End If

Next

' Exit when hit bottom of the destination bitmap
yDst += 1
If yDst >= bmCrop.Height Then
Exit For
End If

Next


System.Runtime.InteropServices.Marshal.Copy(arCropValues, 0, cropPtr, arCropValues.Length)
' Unlock the bits.
bmCrop.UnlockBits(cropData)

Me.Image = bmCrop

End Sub

-- modified 9-Jun-19 5:35am.
AnswerRe: Problem cropping an image. more info Pin
speedbump998-Jun-19 9:46
memberspeedbump998-Jun-19 9:46 
GeneralRe: Problem cropping an image. more info Pin
Dave Kreskowiak8-Jun-19 16:29
mveDave Kreskowiak8-Jun-19 16:29 
GeneralRe: Problem cropping an image. more info Pin
speedbump998-Jun-19 23:34
memberspeedbump998-Jun-19 23:34 
AnswerRe: Problem cropping an image. Pin
Gerry Schmitz8-Jun-19 12:05
mveGerry Schmitz8-Jun-19 12:05 
QuestionHow using reflection invoke when method wants a specific object type Pin
Member 85736427-Jun-19 4:45
memberMember 85736427-Jun-19 4:45 
AnswerRe: How using reflection invoke when method wants a specific object type Pin
Richard Deeming7-Jun-19 4:53
mveRichard Deeming7-Jun-19 4:53 
GeneralRe: How using reflection invoke when method wants a specific object type Pin
Member 85736427-Jun-19 7:07
memberMember 85736427-Jun-19 7:07 
QuestionHow to change txt color in MessageBox with API Pin
MasterGamerFX30-May-19 23:44
memberMasterGamerFX30-May-19 23:44 
AnswerRe: How to change txt color in MessageBox with API Pin
Richard Deeming31-May-19 0:46
mveRichard Deeming31-May-19 0:46 
QuestionHow to clear a bindingsource without deleting from database Pin
desanti30-May-19 3:47
memberdesanti30-May-19 3:47 
AnswerRe: How to clear a bindingsource without deleting from database Pin
Richard MacCutchan30-May-19 4:01
protectorRichard MacCutchan30-May-19 4:01 
GeneralRe: How to clear a bindingsource without deleting from database Pin
desanti30-May-19 6:58
memberdesanti30-May-19 6:58 
GeneralRe: How to clear a bindingsource without deleting from database Pin
Richard MacCutchan30-May-19 7:01
protectorRichard MacCutchan30-May-19 7:01 
GeneralRe: How to clear a bindingsource without deleting from database Pin
desanti30-May-19 8:56
memberdesanti30-May-19 8:56 
GeneralRe: How to clear a bindingsource without deleting from database Pin
Richard MacCutchan30-May-19 21:44
protectorRichard MacCutchan30-May-19 21:44 
AnswerRe: How to clear a bindingsource without deleting from database Pin
Gerry Schmitz31-May-19 5:53
mveGerry Schmitz31-May-19 5:53 
QuestionVisual Basic : Entity Framework update only one table in model from database Pin
desanti30-May-19 2:20
memberdesanti30-May-19 2:20 
QuestionListView DrawItem() e.Bounds gives different Height when item is selected. SOLVED. Pin
speedbump9928-May-19 2:54
memberspeedbump9928-May-19 2:54 
AnswerRe: ListView DrawItem() e.Bounds gives different Height when item is selected. Pin
Richard MacCutchan28-May-19 6:20
protectorRichard MacCutchan28-May-19 6:20 
GeneralRe: ListView DrawItem() e.Bounds gives different Height when item is selected. Pin
speedbump9928-May-19 6:24
memberspeedbump9928-May-19 6:24 
Questionvb.net and Excel ribbon Pin
JR21218-May-19 21:07
memberJR21218-May-19 21:07 
AnswerRe: vb.net and Excel ribbon Pin
JR21210-Jun-19 10:51
memberJR21210-Jun-19 10:51 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.


Advertise | Privacy | Cookies | Terms of Service
Web01 | 2.8.190617.3 | Last Updated 10 Jun 2019
Copyright © CodeProject, 1999-2019
All Rights Reserved.
Layout: fixed | fluid