I'm trying to take a screen shot and set it as background of a WPF window.
This is my code to convert screenshot to ImageSource, I'm getting a NullReferenceException when converting from bitmap. How to do this properly?
Dim screenSize = Forms.SystemInformation.PrimaryMonitorSize
Dim bitmap = New System.Drawing.Bitmap(screenSize.Width, screenSize.Height)
Dim g = System.Drawing.Graphics.FromImage(bitmap)
g.CopyFromScreen(New System.Drawing.Point(0, 0), New System.Drawing.Point(0, 0), screenSize)
g.Flush()
Dim c As ImageSourceConverter = New ImageSourceConverter()
Dim img As ImageSource = c.ConvertFrom(bitmap)
You can use the CreateBitmapSourceFromHBitmap method:
Dim hbitmap As IntPtr
Try
hbitmap = bitmap.GetHBitmap()
Dim img As ImageSource = Imaging.CreateBitmapSourceFromHBitmap(hbitmap, IntPtr.Zero, Int32Rect.Empty, BitmapSizeOptions.FromEmptyOptions())
...
Finally
If hbitmap <> IntPtr.Zero Then
DeleteObject(hbitmap)
End If
End Try
...
<DllImport("gdi32.dll")> _
Private Shared Function DeleteObject(hObject As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
Related
I want to resize an image to a max width and height and then crop it.
The resizing works. But the cropping code I found here does not.
My own existing code uses a byte array, so I need to work with that.
So the code below does resize, does NOT crop, and does save the new image. What am I doing wrong with the cropping?
Dim imgNewWidth, imgNewHeight As Integer
Dim _originalThumbWidth As Integer = 900
Dim _originalThumbHeight As Integer = 900
Dim imageURL As String = "https://med.stanford.edu/news/all-news/2021/09/cat-fur-color-patterns/_jcr_content/main/image.img.780.high.jpg/cat_by-Kateryna-T-Unsplash.jpg"
Dim localImagePath As String = Server.MapPath("images\_tmp\") + "CROPPED.jpg"
ResizeAndSaveFast(_originalThumbWidth, _originalThumbHeight, imageURL, localImagePath, "", "", imgNewWidth, imgNewHeight)
Private Function ResizeAndSaveFast(ByVal maxWidth As Integer, ByVal maxHeight As Integer, ByVal imageURL As String, ByVal saveToPath As String, ByVal userName As String, ByVal password As String,
ByRef imgNewWidth As Integer, ByRef imgNewHeight As Integer) As Boolean
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
Dim imgRequest As WebRequest = WebRequest.Create(imageURL)
Dim imgResponse As WebResponse
Dim memStream As New MemoryStream
Try
imgResponse = imgRequest.GetResponse()
Dim streamPhoto As Stream = imgResponse.GetResponseStream()
streamPhoto.CopyTo(memStream)
memStream.Position = 0
Catch ex As Exception
Return False
End Try
Dim bfPhoto As BitmapFrame = ReadBitmapFrame(memStream)
Dim newWidth, newHeight As Integer
Dim scaleFactor As Double
newWidth = bfPhoto.PixelWidth
newHeight = bfPhoto.PixelHeight
imgNewWidth = newWidth
imgNewHeight = newHeight
If bfPhoto.PixelWidth > maxWidth Or bfPhoto.PixelHeight > maxHeight Then
If bfPhoto.PixelWidth > maxWidth Then
scaleFactor = maxWidth / bfPhoto.PixelWidth
newWidth = CInt(Math.Round(bfPhoto.PixelWidth * scaleFactor, 0))
newHeight = CInt(Math.Round(bfPhoto.PixelHeight * scaleFactor, 0))
End If
If newHeight > maxHeight Then
scaleFactor = maxHeight / newHeight
newWidth = CInt(Math.Round(newWidth * scaleFactor, 0))
newHeight = CInt(Math.Round(newHeight * scaleFactor, 0))
End If
End If
imgNewWidth = newWidth
imgNewHeight = newHeight
Dim bfResize As BitmapFrame = FastResize(bfPhoto, newWidth, newHeight)
Dim baResize As Byte() = ToByteArray(bfResize)
Dim bmp As System.Drawing.Bitmap = imageFunctions.ConvertByteArrayToBitmap(baResize)
Dim CropArea As Rectangle = New Rectangle(100, 100, bmp.Width - 100, bmp.Height - 100)
Dim bm As Bitmap = New Bitmap(CropArea.Width, CropArea.Height)
Using g As Graphics = Graphics.FromImage(bm)
g.DrawImage(bm, New Rectangle(0, 0, bm.Width, bm.Height),
CropArea,
GraphicsUnit.Pixel)
End Using
bm.Save(saveToPath, ImageFormat.Jpeg)
Return True
End Function
You have a typo caused by using variable names that are too similar. As written, you have this block of code:
Dim bmp As System.Drawing.Bitmap = imageFunctions.ConvertByteArrayToBitmap(baResize)
Dim CropArea As Rectangle = New Rectangle(100, 100, bmp.Width - 100, bmp.Height - 100)
Dim bm As Bitmap = New Bitmap(CropArea.Width, CropArea.Height)
Using g As Graphics = Graphics.FromImage(bm)
g.DrawImage(bm, New Rectangle(0, 0, bm.Width, bm.Height),
CropArea,
GraphicsUnit.Pixel)
End Using
This line:
g.DrawImage(bm,
New Rectangle(0, 0, bm.Width, bm.Height),
CropArea,
GraphicsUnit.Pixel)
Should be:
g.DrawImage(bmp,
New Rectangle(0, 0, bm.Width, bm.Height),
CropArea,
GraphicsUnit.Pixel)
In your code, you created the variable bmp to store the non-cropped bitmap. In other words, your source data.
You then declare bm to store the cropped bitmap, your destination. The Graphics object g is created using the destination.
in your call to g.DrawImage, the first argument should be the source data, bmp. Instead you have the destination, bm there.
I haven't tested, but I think you should be using a different variable in this line of code.
g.DrawImage(bmp, New Rectangle(0, 0, bm.Width, bm.Height),
CropArea,
GraphicsUnit.Pixel)
I have some images that I'am trying to print out. Those images can come in varying format, from different DPI's to different formats (JPEG, PNG, etc.)
Now what I've done for now, is to load the image into my application and try and
convert the dpi to say 96. However in this process i get an OutOfMemoryException, and I'm not sure how to continue.
Private Sub PrintImage(Optional providedPrintDialog As PrintDialog = Nothing)
Dim objPrintDialog As PrintDialog
If providedPrintDialog IsNot Nothing Then
objPrintDialog = providedPrintDialog
Else
objPrintDialog = New PrintDialog()
End If
Dim myPanel As New StackPanel
myPanel.Margin = New Thickness(15)
Dim myImage As New Controls.Image
Dim tempBitmapImage = ConvertBitmapToXDPI(Me.SelectedFileViewModel.File.GetPath, 96)
Dim tempBitmapImageWidth As Integer = CInt(objPrintDialog.PrintableAreaWidth)
' A4 max width = 793
If tempBitmapImage.Width > tempBitmapImageWidth Then
myImage.Stretch = System.Windows.Media.Stretch.Uniform
Else
myImage.Stretch = System.Windows.Media.Stretch.None
End If
myImage.Source = tempBitmapImage
myPanel.Children.Add(myImage)
myPanel.Measure(New System.Windows.Size(objPrintDialog.PrintableAreaWidth, objPrintDialog.PrintableAreaHeight))
myPanel.Arrange(New Rect(New System.Windows.Point(0, 0), myPanel.DesiredSize))
objPrintDialog.PrintVisual(myPanel, "Billede") ' <- OutOfMemoryException thrown here
End Sub
Private Function ConvertBitmapToXDPI(path As String, newDpi As Integer) As BitmapSource
Using bitmap As Bitmap = DirectCast(System.Drawing.Image.FromFile(path), Bitmap)
Dim bitmapData = bitmap.LockBits(New System.Drawing.Rectangle(0, 0, bitmap.Width, bitmap.Height), System.Drawing.Imaging.ImageLockMode.[ReadOnly], bitmap.PixelFormat)
Dim bmSource = BitmapSource.Create(
bitmapData.Width,
bitmapData.Height, 96, 96, PixelFormats.Bgr24, Nothing,
bitmapData.Scan0,
bitmapData.Stride * bitmapData.Height,
bitmapData.Stride)
bitmap.UnlockBits(bitmapData)
Return bmSource
End Using
End Function
There is no need to do any DPI conversion. Just create a DrawingVisual and draw a BitmapImage into it with an appropriate size:
Dim image As New BitmapImage()
image.BeginInit()
image.CacheOption = BitmapCacheOption.OnLoad
image.UriSource = New Uri(path)
image.EndInit()
image.Freeze()
Dim size As New Size()
If image.Width < printDialog.PrintableAreaWidth Then
size.Width = image.Width
size.Height = image.Height
Else
size.Width = printDialog.PrintableAreaWidth
size.Height = size.Width / image.Width * image.Height
End If
Dim visual As New DrawingVisual()
Using dc As DrawingContext = visual.RenderOpen()
dc.DrawImage(image, New Rect(size))
End Using
printDialog.PrintVisual(visual, "Billede")
The code below is throwing error:
System.Runtime.InteropServices.COMException: Exception from HRESULT:
0x80072EE4
on code line:
Dim bdDecoder As BitmapDecoder = BitmapDecoder.Create(streamPhoto, BitmapCreateOptions.PreservePixelFormat, BitmapCacheOption.None)
Why? The requested URL exists and returns a 200. Google is not helping on this one.
Private Sub ResizeAndSave(ByVal imageURL As String)
Dim imgRequest As WebRequest = WebRequest.Create(imageURL)
Dim imgResponse As WebResponse = imgRequest.GetResponse()
Dim strThumbnail As String = "success.png"
Dim streamPhoto As Stream = imgResponse.GetResponseStream()
Dim memStream As New MemoryStream
streamPhoto.CopyTo(memStream)
Dim bfPhoto As BitmapFrame = ReadBitmapFrame(memStream)
Dim nThumbnailSize As Integer = 200, nWidth As Integer, nHeight As Integer
If bfPhoto.Width > bfPhoto.Height Then
nWidth = nThumbnailSize
nHeight = CInt(bfPhoto.Height * nThumbnailSize / bfPhoto.Width)
Else
nHeight = nThumbnailSize
nWidth = CInt(bfPhoto.Width * nThumbnailSize / bfPhoto.Height)
End If
Dim bfResize As BitmapFrame = FastResize(bfPhoto, nWidth, nHeight)
Dim baResize As Byte() = ToByteArray(bfResize)
Dim saveToPath As String = Server.MapPath(ConfigurationManager.AppSettings("products_photospath")) + "\49\" + strThumbnail
File.WriteAllBytes(saveToPath, baResize)
Console.WriteLine("Resize done!!!")
End Sub
Private Shared Function FastResize(bfPhoto As BitmapFrame, nWidth As Integer, nHeight As Integer) As BitmapFrame
Dim tbBitmap As New TransformedBitmap(bfPhoto, New ScaleTransform(nWidth / bfPhoto.Width, nHeight / bfPhoto.Height, 0, 0))
Return BitmapFrame.Create(tbBitmap)
End Function
Private Shared Function ToByteArray(bfResize As BitmapFrame) As Byte()
Using msStream As New MemoryStream()
Dim pbdDecoder As New PngBitmapEncoder()
pbdDecoder.Frames.Add(bfResize)
pbdDecoder.Save(msStream)
Return msStream.ToArray()
End Using
End Function
Private Shared Function ReadBitmapFrame(streamPhoto As Stream) As BitmapFrame
Dim bdDecoder As BitmapDecoder = BitmapDecoder.Create(streamPhoto, BitmapCreateOptions.PreservePixelFormat, BitmapCacheOption.None)
Return bdDecoder.Frames(0)
End Function
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
ResizeAndSave("http://cdn2.emobassets.eu/media/catalog/product/1/1/1116220.jpg")
End Sub
UPDATE 1
Ok, images are now saved. But the resize only works correctly on the example .png file, and NOT on the .jpg file.
The Dell logo is saved in 200x199 px preserving transparancy, which is perfect.
The other file 1116220.jpgis saved in 625x441px...why is that not respecting the desired max width/height of 200px?
I checked into the code and the only difference I can spot is that for the png file the dimensions are a round number:
bfPhoto.Width 2000
bfPhoto.Height 1994
After FastResize executes that becomes
bfResize.Width 200
bfResize.Height 199
Where for the jpg the dimensions are
bfPhoto.Width 982,719970703125
bfPhoto.Height 695,039978027344
After FastResize executes that becomes
bfResize.Width 200
bfResize.Height 141,119995117188
So I tried to see if it was related to that image and tried with another jpg file: https://upload.wikimedia.org/wikipedia/commons/d/d8/Square-1_solved.jpg
Where for the jpg the dimensions are
bfPhoto.Width 600
bfPhoto.Height 600
After FastResize executes that becomes
bfResize.Width
bfResize.Height
That does work, so now I know it's not related to the file being a .jpg. It seems to be related to the dimensions of image 1116220.jpg, but I don't know if I can work around that by scaling differently or in some other way...
My code:
Private Sub ResizeAndSave(ByVal maxWidth As Integer, ByVal maxHeight As Integer, ByVal imageURL As String)
Dim imgRequest As WebRequest = WebRequest.Create(imageURL)
Dim imgResponse As WebResponse = imgRequest.GetResponse()
Dim streamPhoto As Stream = imgResponse.GetResponseStream()
Dim memStream As New MemoryStream
streamPhoto.CopyTo(memStream)
memStream.Position = 0
Dim bfPhoto As BitmapFrame = ReadBitmapFrame(memStream)
Dim newWidth, newHeight As Integer
Dim scaleFactor As Double
If bfPhoto.Width > maxWidth Or bfPhoto.Height > maxHeight Then
If bfPhoto.Width > maxWidth Then
scaleFactor = maxWidth / bfPhoto.Width
newWidth = Math.Round(bfPhoto.Width * scaleFactor, 0)
newHeight = Math.Round(bfPhoto.Height * scaleFactor, 0)
End If
If newHeight > maxHeight Then
scaleFactor = maxHeight / newHeight
newWidth = Math.Round(newWidth * scaleFactor, 0)
newHeight = Math.Round(newHeight * scaleFactor, 0)
End If
End If
Dim bfResize As BitmapFrame = FastResize(bfPhoto, newWidth, newHeight)
Dim baResize As Byte() = ToByteArray(bfResize)
Dim strThumbnail As String = "success" + Date.Now.Second.ToString + ".png"
Dim saveToPath As String = Server.MapPath(ConfigurationManager.AppSettings("products_photospath")) + "\49\" + strThumbnail
File.WriteAllBytes(saveToPath, baResize)
End Sub
Private Shared Function FastResize(bfPhoto As BitmapFrame, nWidth As Integer, nHeight As Integer) As BitmapFrame
Dim tbBitmap As New TransformedBitmap(bfPhoto, New ScaleTransform(nWidth / bfPhoto.Width, nHeight / bfPhoto.Height, 0, 0))
Return BitmapFrame.Create(tbBitmap)
End Function
Private Shared Function ToByteArray(bfResize As BitmapFrame) As Byte()
Using msStream As New MemoryStream()
Dim pbdDecoder As New PngBitmapEncoder()
pbdDecoder.Frames.Add(bfResize)
pbdDecoder.Save(msStream)
Return msStream.ToArray()
End Using
End Function
Private Shared Function ReadBitmapFrame(streamPhoto As Stream) As BitmapFrame
Dim bdDecoder As BitmapDecoder = BitmapDecoder.Create(streamPhoto, BitmapCreateOptions.PreservePixelFormat, BitmapCacheOption.None)
Return bdDecoder.Frames(0)
End Function
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
ResizeAndSave(200, 200, "https://upload.wikimedia.org/wikipedia/commons/8/82/Dell_Logo.png")
ResizeAndSave(200, 200, "http://cdn2.emobassets.eu/media/catalog/product/1/1/1116220.jpg")
End Sub
When inside the tool I want to text included in the image between the place where I want to speak, as the following picture:
enter image description here
I tried the following code but the photo does not show the speech, but end of the sentence appears:
Dim para As New Paragraph()
Dim bitmap As New BitmapImage(New Uri("D:\Happy.png"))
Dim image As New Image()
image.Source = bitmap
image.Width = 20
para.Inlines.Add(image)
RTB.Document.Blocks.Add(para)
See this link for examples Inline Images or Other Elements.
'A RichTextBox with an image.
Private Sub ImageRTB()
'Create a new RichTextBox.
Dim MyRTB As New RichTextBox()
' Create a Run of plain text and image.
Dim myRun As New Run()
myRun.Text = "Displaying text with inline image"
Dim MyImage As New Image()
MyImage.Source = New BitmapImage(New Uri("flower.jpg", UriKind.RelativeOrAbsolute))
MyImage.Height = 50
MyImage.Width = 50
Dim MyUI As New InlineUIContainer()
MyUI.Child = MyImage
' Create a paragraph and add the paragraph to the RichTextBox.
Dim myParagraph As New Paragraph()
MyRTB.Blocks.Add(myParagraph)
' Add the Run and image to it.
myParagraph.Inlines.Add(myRun)
myParagraph.Inlines.Add(MyUI)
'Add the RichTextBox to the StackPanel.
MySP.Children.Add(MyRTB)
End Sub
The solution found and this is the code:
Dim tp As TextPointer = rtb.CaretPosition.GetInsertionPosition(LogicalDirection.Forward)
Dim bm As New BitmapImage()
bm.BeginInit()
bm.UriSource = New Uri("Happy.png", UriKind.Relative)
bm.CacheOption = BitmapCacheOption.OnLoad
bm.EndInit()
Dim img As New Image()
img.Source = bm
img.Width = 20
img.Height = 20
img.Stretch = Stretch.Fill
Dim container As New InlineUIContainer(img, tp)
thank you :)
I am trying to get all chars of Segoe UI Symbol Font.
I got them, converted to char, converted to Hex value and added to listview as items.
So, somebody else can use their hex values for XAML projects as icon.
But the problem is this in the code:
i am always getting OverFlowException at the function Convert.ToChar.
Code is running correct, but when the index variable is bigger than 65535 which is max char value, i got overflowexception.
But if you run the code, as you will see, in the Segoe UI Symbol fontfamily there are more chars which is bigger than 65535.
Maybe my method is wrong, you can advice me another method.
MainWindow.xaml file:
<Grid Loaded="Grid_Loaded">
<ListView x:Name="listview">
<ListView.View>
<GridView>
<GridViewColumn Header="HexValue" />
</GridView>
</ListView.View>
</ListView>
</Grid>
MainWindow.xaml.vb file
Class MainWindow
Public glyph As GlyphTypeface
Dim characterMap As IDictionary(Of Integer, UShort)
Private Sub Grid_Loaded(sender As Object, e As RoutedEventArgs)
SymbolleriGetir()
End Sub
Public Sub SymbolleriGetir()
Dim segoeUiSymbol As FontFamily
For Each font As FontFamily In Fonts.SystemFontFamilies
Dim fontName As String
fontName = font.Source
If fontName = "Segoe UI Symbol" Then
segoeUiSymbol = font
End If
Next
For Each typeFace As Typeface In segoeUiSymbol.GetTypefaces
typeFace.TryGetGlyphTypeface(glyph)
If glyph IsNot Nothing Then
characterMap = glyph.CharacterToGlyphMap
Else
Continue For
End If
Next
For i As Integer = 0 To characterMap.Keys.Count
Dim index As Integer = characterMap.Keys.ElementAt(i)
Dim c As Char = Nothing
c = Convert.ToChar(index)
Dim charText As String = c.ToString()
listview.Items.Add(String.Format("&#x{0:x2};", System.Convert.ToUInt32(c)))
Next
End Sub
End Class
CharacterToGlyphMap is a lookup map
(IDictionary(Of Integer, UShort))
with the UShort being the unicode char
so it is not necessary to convert.
I am no VB developer, but I just just coded this up and tested which enumerates the chars, and creates an image glyph next to each hex value:
Wingdings:
Your loaded event handler:
(I exited after 100 due to load time)
Private Sub Grid_Loaded(ByVal sender As Object, ByVal e As RoutedEventArgs)
Dim glyph As GlyphTypeface
Dim glyphIndex As UShort
Dim typeface As System.Windows.Media.Typeface = New System.Windows.Media.Typeface("Segoe UI Symbol")
If (typeface.TryGetGlyphTypeface(glyph)) Then
Dim glyphLookupMap As IDictionary(Of Integer, UShort) = glyph.CharacterToGlyphMap
Dim x As Integer = 0
For Each kvp As KeyValuePair(Of Integer, UShort) In glyphLookupMap
Dim c As Char = Convert.ToChar(kvp.Value)
Dim glyphImage As ImageSource = Nothing
If (glyphLookupMap.TryGetValue(kvp.Key, glyphIndex)) Then
glyphImage = Me.CreateGlyph(glyph, glyphIndex, kvp.Value, Brushes.Blue)
End If
Me._listview.Items.Add(Me.CreateGlyphListboxEntry(kvp.Key, glyphImage))
Dim num As Integer = x + 1
x = num
If (num > 100) Then
Exit For
End If
Next
End If
End Sub
And here would be the Glyph image creator
Private Function CreateGlyph(ByVal glyphTypeface As System.Windows.Media.GlyphTypeface, ByVal glyphIndex As UShort, ByVal charUShortVal As UShort, ByVal foreground As Brush) As System.Windows.Media.ImageSource
Dim imageSource As System.Windows.Media.ImageSource
Dim flag As Boolean = False
Dim drawingImage As System.Windows.Media.DrawingImage = Nothing
Try
Dim glyphIndexes As IList(Of UShort) = New List(Of UShort)() From
{
charUShortVal
}
Dim advanceWidths As IList(Of Double) = New List(Of Double)() From
{
glyphTypeface.AdvanceWidths(glyphIndex)
}
Dim glyphRun As System.Windows.Media.GlyphRun = New System.Windows.Media.GlyphRun(glyphTypeface, 0, False, 1, glyphIndexes, New Point(0, 0), advanceWidths, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
drawingImage = New System.Windows.Media.DrawingImage(New System.Windows.Media.GlyphRunDrawing(foreground, glyphRun))
Catch exception As System.Exception
imageSource = Nothing
flag = True
End Try
If (Not flag) Then
imageSource = drawingImage
End If
flag = False
Return imageSource
End Function
And finally the Listbox Entry creator:
Private Function CreateGlyphListboxEntry(ByVal charIntValue As Integer, ByVal glyphImage As ImageSource) As FrameworkElement
Dim result As StackPanel = New StackPanel() With
{
.Orientation = Orientation.Horizontal
}
Dim text As TextBlock = New TextBlock() With
{
.Text = String.Format("{0:X}", charIntValue),
.Foreground = Brushes.Black,
.FontSize = 17,
.Margin = New Thickness(10, 0, 10, 0)
}
result.Children.Add(text)
If (glyphImage IsNot Nothing) Then
Dim image As System.Windows.Controls.Image = New System.Windows.Controls.Image()
Dim num As Double = 32
Dim num1 As Double = num
image.Height = num
image.Width = num1
image.Stretch = Stretch.Uniform
image.Source = glyphImage
result.Children.Add(image)
End If
Return result
End Function
Hope this helps!