Alpha transparent window form - vb.net

I got following code to load a PNG with alpha channel on to a form and reshape a form to match alpha channel.
Public Function applyAlphaForm(ByVal f As Form, ByVal bitmap As Bitmap, Optional ByVal opacity As Byte = 255) As Boolean
f.FormBorderStyle = FormBorderStyle.None
Dim style As Long
style = Win32.GetWindowLong(f.Handle, Win32.GWL_EXSTYLE)
If Not (style And Win32.WS_EX_LAYERED = Win32.WS_EX_LAYERED) Then
style = style Or Win32.WS_EX_LAYERED
Win32.SetWindowLong(f.Handle, Win32.GWL_EXSTYLE, style)
End If
Return SetBitmap(f, bitmap, opacity)
End Function
Public Function SetBitmap(ByVal f As Form, ByVal bitmap As Bitmap, ByVal opacity As Byte) As Boolean
f.Height = bitmap.Height
f.Width = bitmap.Width
If bitmap.PixelFormat <> PixelFormat.Format32bppArgb Then
f.BackgroundImage = bitmap
f.TransparencyKey = bitmap.GetPixel(0, 0)
Return True
End If
Dim screenDC As IntPtr = Win32.GetDC(IntPtr.Zero)
Dim memDC As IntPtr = Win32.CreateCompatibleDC(screenDC)
Dim hBitmap As IntPtr = IntPtr.Zero
Dim oldBitmap As IntPtr = IntPtr.Zero
Try
hBitmap = bitmap.GetHbitmap(Color.FromArgb(0)) 'grab a GDI handle from this GDI+ bitmap
oldBitmap = Win32.SelectObject(memDC, hBitmap)
Dim size As Win32.Size = New Win32.Size(bitmap.Width, bitmap.Height)
Dim pointSource As Win32.Point = New Win32.Point(0, 0)
Dim topPos As Win32.Point = New Win32.Point(f.Left, f.Top)
Dim blend As Win32.BLENDFUNCTION = New Win32.BLENDFUNCTION()
blend.BlendOp = Win32.AC_SRC_OVER
blend.BlendFlags = 0
blend.SourceConstantAlpha = opacity
blend.AlphaFormat = Win32.AC_SRC_ALPHA
Win32.UpdateLayeredWindow(f.Handle, screenDC, topPos, size, memDC, pointSource, 0, blend, Win32.ULW_ALPHA)
Catch ex As Exception
Finally
Win32.ReleaseDC(IntPtr.Zero, screenDC)
If hBitmap <> IntPtr.Zero Then
Win32.SelectObject(memDC, oldBitmap)
Win32.DeleteObject(hBitmap)
End If
Win32.DeleteDC(memDC)
End Try
Return True
End Function
Nice and easy but if I put some control (button, text box ...) on the form, they will disappear. I guest that UpdateLayeredWindow will paint over the form hDC so we can't see anything behind it. So how to draw some form control on the form? I've try to loop through all control and render to png bitmap before calling api but that will be static image.

So I guest I have to create two from, a background form alpha transparent and a foreground form with control on it. The control form will only display the area of control.

Related

Cropped image from storageFile becomes null in Release Mode but works on Debug mode

I have a problem with a function that extracts a cropped image from a StorageFile and save it to another file.
I'm using visual studio 2017, target version 10.0.16299 for the uwp app.
In debug mode, it works.
In release mode, variable pixels becomes null (please, see the code!!)
why??
Private Shared Async Function GetPixelData(decoder As BitmapDecoder, startPointX As UInteger, startPointY As UInteger, width As UInteger, height As UInteger, scaledWidth As UInteger,
scaledHeight As UInteger) As Task(Of Byte())
Dim transform As New BitmapTransform()
Dim bounds As New BitmapBounds()
bounds.X = startPointX
bounds.Y = startPointY
bounds.Height = height
bounds.Width = width
transform.Bounds = bounds
transform.ScaledWidth = scaledWidth
transform.ScaledHeight = scaledHeight
Dim pix As PixelDataProvider = Await decoder.GetPixelDataAsync(BitmapPixelFormat.Bgra8, BitmapAlphaMode.Straight, transform, ExifOrientationMode.IgnoreExifOrientation, ColorManagementMode.ColorManageToSRgb)
Dim pixels As Byte() = pix.DetachPixelData()
Return pixels
End Function
' Get cropped image from storage file and save on new storagefile
Public Shared Async Function SaveCroppedBitmapAsync(originalImageFile As StorageFile, newImageFile As StorageFile, startPoint As Point, cropSize As Size) As Task
Dim startPointX As UInteger = CUInt(Math.Floor(startPoint.X))
Dim startPointY As UInteger = CUInt(Math.Floor(startPoint.Y))
Dim height As UInteger = CUInt(Math.Floor(cropSize.Height))
Dim width As UInteger = CUInt(Math.Floor(cropSize.Width))
Using originalImgFileStream As IRandomAccessStream = Await originalImageFile.OpenReadAsync()
Dim decoder As BitmapDecoder = Await BitmapDecoder.CreateAsync(originalImgFileStream)
If startPointX + width > decoder.PixelWidth Then
startPointX = decoder.PixelWidth - width
End If
If startPointY + height > decoder.PixelHeight Then
startPointY = decoder.PixelHeight - height
End If
Using newImgFileStream As IRandomAccessStream = Await newImageFile.OpenAsync(FileAccessMode.ReadWrite)
Dim pixels As Byte() = Await GetPixelData(decoder, startPointX, startPointY, width, height, decoder.PixelWidth,
decoder.PixelHeight)
Dim encoderID As New Guid
encoderID = Guid.Empty
Select Case newImageFile.FileType.ToLower()
Case ".png"
encoderID = BitmapEncoder.PngEncoderId
Exit Select
Case ".bmp"
encoderID = BitmapEncoder.BmpEncoderId
Exit Select
Case Else
encoderID = BitmapEncoder.JpegEncoderId
Exit Select
End Select
Dim propertySet As New BitmapPropertySet()
If decoder.PixelWidth > 3000 Or decoder.PixelHeight > 3000 Then
Dim qualityValue As New BitmapTypedValue(0.4, PropertyType.Single)
propertySet.Add("ImageQuality", qualityValue)
Else
Dim qualityValue As New BitmapTypedValue(0.7, PropertyType.Single)
propertySet.Add("ImageQuality", qualityValue)
End If
Dim bmpEncoder As BitmapEncoder = Await BitmapEncoder.CreateAsync(encoderID, newImgFileStream, propertySet)
''''''''' Exception in this point, pixel becomes null!!!! why????
bmpEncoder.SetPixelData(BitmapPixelFormat.Bgra8, BitmapAlphaMode.Straight, width, height, decoder.DpiX, decoder.DpiY,
pixels)
Await bmpEncoder.FlushAsync()
End Using
End Using
End Function
Thank you!
You will get error if you specified one of encodingOptions (propertySet in your code) which is not supported by the image associated with the encoder when you create BitmapEncoder object in the code
Dim bmpEncoder As BitmapEncoder = Await BitmapEncoder.CreateAsync(encoderID, newImgFileStream, propertySet)
The propertySet you specified may be not supported. See the topic Decode and encode image metadata,
• For details on which properties are supported for which image file types, see Windows Properties, Photo Metadata Policies, and WIC image format native metadata queries.
• SetPropertiesAsync will fail with the error code 0x88982F41 if one of the requested properties is not supported by the image associated with the encoder.
You can modify your code without setting the property to make it work:
...
Dim bmpEncoder As BitmapEncoder = Await BitmapEncoder.CreateAsync(encoderID, newImgFileStream)
Try
Await bmpEncoder.BitmapProperties.SetPropertiesAsync(propertySet)
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
...
In the Try Catch part, you can see the error message in the Debug code if the requested property is not supported.

vb.net basics, How do I create a public function for handling dynamically created buttons

I'm new to vb.net. To be honest I've only been using it for a week or so. I've actually hit a wall when it comes to creating a Public Function for dynamically created buttons.
I've got a form in which I've got the following button creation code:
'Function for creating buttons
Public Sub CreateNewButton(font As String, x As Integer, y As Integer,
width As Integer, height As Integer,
name As String, text As String,
menu_type As Integer,
Optional hidden As Boolean = True,
Optional centered As Boolean = False)
'Create a button as an entity
Dim btn As Button = New Button
'Assign the location
If centered = True Then
btn.Location = New Point(x - width / 2, y - height / 2)
Else
btn.Location = New Point(x, y)
End If
'Assign other variables from function parameters
btn.Name = name
btn.Text = text
btn.Height = height
btn.Width = width
'Should the button be hidden when created?
If hidden = True Then
btn.Hide()
End If
'Change the font
If font = "Normal" Then
btn.Font = setFont(btn.Font, "Consolas", 18)
ElseIf font = "Small" Then
btn.Font = setFont(btn.Font, "Consolas", 12)
End If
'Assign the Handlers and non-function variables
btn.BackColor = Color.Gray
btn.Anchor = AnchorStyles.None
Me.Controls.Add(btn)
AddHandler btn.Click, AddressOf ButtonOnMouseClick
AddHandler btn.MouseHover, AddressOf ButtonOnMouseHover
AddHandler btn.MouseLeave, AddressOf ButtonOnMouseLeave
End Sub
So basically, it works like a charm when being used in this form. But when I've tried using it in a different form I realized that I had to create the same function again. This process would become tedious if I had to do it for each and every form.
That's why I decided to create a new module called Public Functions in which I would have common functions shared by each module. The problem is that once it's created it cannot be executed because it returns an error that 'Controls.add' was not previously declared.
I do believe that this is something really simple. I've tried looking for the libraries which could be missing and I've tried importing System.Windows.Forms.Controls but I still get the same error.
How do I actually create a Public Function which can be shared between different forms?
Thanks in advance, Alex
Sample code as requested:
Method 1 Passing the Controls collection to your helper function.
Public Sub CreateNewButton(parentControls As ControlCollection,
font As String, x As Integer, y As Integer,
width As Integer, height As Integer,
name As String, text As String,
menu_type As Integer,
Optional hidden As Boolean = True,
Optional centered As Boolean = False)
' Abbreviated implementation to illustrate the point
Dim newButton As New Button
newButton.Top = y
newButton.Left = x
newButton.Name = name
newButton.Text = text
parentControls.Add(newButton)
End Sub
Method 2 Passing the Parent container to your helper function.
Public Sub CreateNewButton(parent As Control,
font As String, x As Integer, y As Integer,
width As Integer, height As Integer,
name As String, text As String,
menu_type As Integer,
Optional hidden As Boolean = True,
Optional centered As Boolean = False)
' Abbreviated implementation to illustrate the point
Dim newButton As New Button
newButton.Top = y
newButton.Left = x
newButton.Name = name
newButton.Text = text
parent.Controls.Add(newButton)
End Sub
Screen shot of what it looks like.
* New 1 is from the first function
* New 2 is from the second function
These two functions can be called like this:
CreateNewButton(Me.Controls, "", 10, 10, 50, 20, "btnNew1", "New 1", 1)
CreateNewButton(Me, "", 100, 100, 50, 20, "btnNew2", "New 2", 1)
Create a class library(.DLL), say MyFunctionsLib.DLL which contains your functions and place it in the same folder of your new project folder (or in any sub folder).
When another new project is created, you add a reference to your 'DLL' file and you can access the functions.
In visual Studio 2017, File->New Project ->Visual Basic-> .NET Standard-> Class Library
and give a suitable name say MyFunctionsLib, click Ok
Eg.
Public NotInheritable Class MyFunctionsLib
Public Shared Function addTwoNums(a As Integer, b As Integer) As Integer
Return a+b
End Function
End Class
Build your project and use your 'DLL' with any other project.

How to center text on Y axis when force wrapping a string

I force wrap some of my text. The following method is used in a loop when I do this; it returns the Y cord for the next line (based on the string height). This works like a charm, however I lose the ability to center the text vertically.
I'm looking for suggestions on how to enhance this method to allow for vertical centering.
<Extension()> _
Public Function DrawText(ByVal p_graphics As Graphics, ByVal p_text As String, ByVal p_Font As Font, ByVal p_fontColor As Brush, ByVal p_X As Decimal, ByVal p_Y As Decimal, _
ByVal p_boundingWidth As Decimal, ByVal p_StringFormat As StringFormat) As Decimal
If String.IsNullOrEmpty(p_text) Then
Return p_Y
End If
Dim _sizef As SizeF = p_graphics.MeasureString(p_text, p_Font, Integer.MaxValue, p_StringFormat)
Dim _LineCnt As Integer = Math.Ceiling(_sizef.Width / p_boundingWidth)
Dim _height As Integer = Math.Ceiling(_LineCnt * Math.Ceiling(_sizef.Height))
p_graphics.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
Dim _rec As New RectangleF(p_X, p_Y, p_boundingWidth, _height)
p_graphics.DrawString(p_text, p_Font, p_fontColor, _rec, p_StringFormat)
Return (p_Y + _rec.Height)
End Function
Example of how I use this extension method (writing this free hand so syntax may not be correct):
.
.
.
Using g as graphics.FromImage(_MyImage)
Dim _LineStart as integer = 0
Foreach _line as string in _Lines 'List of String
_LineStart = g.DrawText(line, _font, Obj.FontColorBrush, 0, _LineStart, Obj.DPIWidth, Obj.StringFormat)
End For
End Using
.
.
.
OK, now I think I understand. You need to calculate where to start drawing vertically.
I put a PictureBox and a Button on a form, added your extension method, and used this code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim lines As New List(Of String)
lines.Add("The quick brown")
lines.Add("fox jumps over")
lines.Add("the lazy dog.")
lines.Add("This line is too wide to fit the available space.")
Dim fmt = StringFormat.GenericTypographic
fmt.Alignment = StringAlignment.Center
Using fnt = New Font("Arial", 8)
Using brsh = New SolidBrush(Color.Black)
Using g = PictureBox1.CreateGraphics
Dim lineY As Integer = (PictureBox1.Height - lines.Count * fnt.Height) \ 2
For Each line As String In lines
lineY = CInt(g.DrawText(line, fnt, brsh, 0, lineY, PictureBox1.Width, fmt))
Next
End Using
End Using
End Using
End Sub
As I use Option Strict On, I had to make some minor modifications to your DrawText method.
Note how the line which is too long is truncated. Centred, but truncated. That is where you might want to use the Graphics.MeasureString Method (String, Font, SizeF, StringFormat) overload so that you have the possibility of it wrapping automatically. Which will of course mess up the calculation for the vertical centring.

Dropping shadow on WinForm distorts interface

I'm using the following code to create a Windows7 style drop shadow effect on my WinForms:
<DllImport("dwmapi.dll", PreserveSig:=True)> _
Private Shared Function DwmSetWindowAttribute(hwnd As IntPtr, attr As Integer, ByRef attrValue As Integer, attrSize As Integer) As Integer
End Function
<DllImport("dwmapi.dll")> _
Private Shared Function DwmExtendFrameIntoClientArea(hWnd As IntPtr, ByRef pMarInset As Margins) As Integer
End Function
Private Function CreateDropShadow() As Boolean
Try
Dim val As Integer = 2
Dim ret1 As Integer = DwmSetWindowAttribute(Me.Handle, 2, val, 4)
If ret1 = 0 Then
Dim m As New Margins(0, 0, 0, 0)
Dim ret2 As Integer = DwmExtendFrameIntoClientArea(Me.Handle, m)
Return ret2 = 0
Else
Return False
End If
Catch ex As Exception
' Probably dwmapi.dll not found (incompatible OS)
Return False
End Try
End Function
Protected Overrides Sub OnHandleCreated(e As EventArgs)
CreateDropShadow()
MyBase.OnHandleCreated(e)
End Sub
The result of above code creates a nice drop shadow effect on my borderless winform, but it causes the UI to distort. All the controls and labels on my form aren't appearing properly, with text not readable.
Am I missing something here? I don't want to use the traditional drop shadow effect using CreateParams, its too 'boxy' look and doesn't give a nice shadow effect.
Here are screenshots of without shadow and with shadow:
Thanks.
Dim m As New Margins(0, 0, 0, 0)
There's a subtle mistake visible here, looks a lot like you are using System.Drawing.Printing.Margins. But that's not a type that's compatible with the Windows' MARGINS type. Which is a structure, not a class.
So this just goes complete wrong, Windows reads nonsense instead of (0, 0, 0, 0). And extends the frame into the entire client area. Which then plays havoc on any control that draws with GDI, it is a 24bpp drawing api that leaves the alpha at 0 so anything that should be black becomes transparent instead.
Fix this by declaring a proper MARGINS structure:
Structure MARGINS
Public Left, Right, Top, Bottom As Integer
End Structure

How to load a BitmapImage in MetroUI Dynamically

I've been experimenting with Windows 8 and Metro UI, I've written a perfectly reasonable load of a bitmap image, but it doesn't seem to be loading, any help is appreciated.
Public Sub New(Image As String)
Debug.Print("ms-resource://MyAssembly/" & Image)
Img = New ImageBrush()
Dim Bitmap As New BitmapImage()
Bitmap.UriSource = New Uri("ms-resource://MyAssembly/" & Image, UriKind.Absolute)
Img.ImageSource = Bitmap
Width = Bitmap.PixelWidth
Height = Bitmap.PixelHeight
Debug.Print("Height: " & Height & " Width: " & Width)
End Sub
In this example Width and Height always take values of zero.
It is rendered in the same class..
Public Sub Render(X As Integer, Y As Integer, Canv As Canvas)
Dim Sprite As New Shapes.Rectangle
Sprite.Width = CDbl(Width)
Sprite.Height = CDbl(Height)
Sprite.Fill = Img
Sprite.SetValue(Canvas.TopProperty, CDbl(Y))
Sprite.SetValue(Canvas.LeftProperty, CDbl(X))
Canv.Children.Add(Sprite)
End Sub
End Class
And here is where it is created/called:
V = New Sprite("Images/Test.bmp")
gameRoot.Children.Clear()
V.Render(100, 100, gameRoot)
===
it isn't a problem with my canvas object, because if i fill it with Sprite.Fill = New SolidColorBrush(Colors.White) then it works fine, and I see a white square on my screen, the bitmap in question is set to "Copy Always", and is in the destination folder when i view it.
I'm not quite sure what I'm doing wrong.
Well I managed to figure this out myself.
You can get a base uri by using
Me.Uri; or in C# This.Uri.
Here is the finished code that will enable anyone to load a bitmap image into a canvas; and even rotate it.
I wrote this myself, so anyone who discovers it having the same problem can feel free to use it as they please.
Image must take the format "FilePath/Image.extension"
Public Class Sprite
'Public Shared Baseuri As Uri
Public Img As ImageBrush
Public Bitmap As BitmapImage
Public Sub New(Image As String, Base As Uri)
'Debug.Print("BASE:" & Base.ToString)
'Debug.Print("USING:" & Image)
'Debug.Print("RESULT:" & New Uri(Base, Image).ToString)
Img = New ImageBrush()
Bitmap = New BitmapImage(New Uri(Base, Image))
End Sub
Public Overloads Sub Render(X As Integer, Y As Integer, Width As Integer, Height As Integer, Canv As Canvas)
Img.ImageSource = Bitmap
Dim Sprite As New Shapes.Rectangle
Sprite.Width = CDbl(Width)
Sprite.Height = CDbl(Height)
Sprite.Fill = Img
Sprite.SetValue(Canvas.TopProperty, CDbl(Y))
Sprite.SetValue(Canvas.LeftProperty, CDbl(X))
Canv.Children.Add(Sprite)
End Sub
Public Overloads Sub Render(X As Integer, Y As Integer, Width As Integer, Height As Integer, Canv As Canvas, Angle As Integer)
Img.ImageSource = Bitmap
Dim Sprite As New Shapes.Rectangle
Sprite.Width = CDbl(Width)
Sprite.Height = CDbl(Height)
Sprite.Fill = Img
Sprite.SetValue(Canvas.TopProperty, CDbl(Y))
Sprite.SetValue(Canvas.LeftProperty, CDbl(X))
Dim v As New Windows.UI.Xaml.Media.RotateTransform
v.Angle = CDbl(Angle)
v.CenterX = Width / 2
v.CenterY = Height / 2
Sprite.RenderTransform = v
Canv.Children.Add(Sprite)
End Sub
End Class