I am trying to make it so that when the screen area changes the font will too! I have got it to calculate the font size correctly and have checked with breakpoints. However, fontSize does not change appropriately, for example I run my program on 1300x740 and the fontSize is calculated to be 13 however it will not change the font to that size even though the variable FontSize does equal 13, instead the font is much much smaller than 13. I have tried making a temporary variable Dim fontSize As Integer = 13 and this changed the textbox to the correct size.
Here is my code:
Private Function Resizing()
Dim totalBaseScreenArea As Double = 1936 * 1100
Dim totalCurrentScreenArea As Double = Me.Width * Me.Height
Dim value As Double = totalCurrentScreenArea / totalBaseScreenArea
Dim fontSize As Integer = Math.Ceiling(txtEnterMP.Font.Size * value)
txtEnterMP.Font = New Font(txtEnterMP.Font.FontFamily, fontSize, txtEnterMP.Font.Style)
End Function
Any help would be highly appreciated!
This solution calculates a new font size based on the size/area of the form. In the designer, add a label called lblFont to a blank form and anchor it to all four corners.
In the code behind, add this code:
Public Class Form1
Private OriginalFontSize As Single = Me.Font.Size
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Call Resizing()
End Sub
Private Sub Form1_ResizeEnd(sender As Object, e As EventArgs) Handles MyBase.ResizeEnd
Call Resizing()
End Sub
Private Sub Resizing()
Try
'Get the screen resolution of your monitor (may not be the monitor the program is running on)
Dim iWidth As Integer = SystemInformation.PrimaryMonitorSize.Width
Dim iHeight As Integer = SystemInformation.PrimaryMonitorSize.Height
'Calculate screen area
Dim totalBaseScreenArea As Double = iWidth * iHeight
Dim totalCurrentScreenArea As Double = Me.Width * Me.Height
'Calculate the new font size
Dim value As Single = (totalCurrentScreenArea / totalBaseScreenArea) * 30
Dim NewFontSize As Single = Math.Ceiling(OriginalFontSize * value)
'Stop the font from being super tiny and hard to read
If NewFontSize < 8 Then NewFontSize = 8
'Display the new font size
Me.Text = "Calculated: " & NewFontSize
Me.Font = New Font(Me.Font.FontFamily, NewFontSize, Me.Font.Style)
lblFont.Text = "The font size of this label is " & NewFontSize
Catch Exp As Exception
lblFont.Text = Exp.Message
End Try
End Sub
End Class
Related
I am new to visual basics and was wondering how to do the following program: I have 9 picture boxes and a button "arrange". For my program, I would like that all picture boxes come together like a puzzle randomly to make a square that has a width and height of three picture boxes. The square made would have all nine picture boxes in one and every time you click the button "arrange" the picture boxes would change to a random location within the square. So far, I have written so that all the picture boxes become the same size but i don't know how to make them come together in a square. Thanks in advance.
Public Class frm1
Dim Placement As Integer
Private Sub btnArrange_Click(sender As Object, e As EventArgs) Handles btnArrange.Click
picDeux.Size = picgris.Size
picTrois.Size = picgris.Size
picQuatre.Size = picgris.Size
picCinq.Size = picgris.Size
picSix.Size = picgris.Size
picSept.Size = picgris.Size
picHuit.Size = picgris.Size
picNeuf.Size = picgris.Size
lstNum.Items.Clear()
For i = 1 To 3
For j = 1 To 3
Dim L As New Point(picgris.Width * j + 100, picgris.Height * i)
lstNum.Items.Add(L)
Next
Next
For i = 1 To 3
For j = 1 To 3
Placement = Int(Rnd() * (lstNum.Items.Count))
Next
Next
End Sub
End Class
I created nine pictures boxes at design time. You would assign a different image to each picture box. They are all square and the same size. Mine are 100 x 100 to make the arithmetic easy.
I made an array of points as a form level variable. These point will form a 300 x 300 square with the picture boxes. I also declared an array of PictureBox. In the Form.Load I added the pictures boxes to the array.
To reposition the picture boxes assigned the array to a list. Items in this list will be removed because we don't want to assign the same location to more the one picture box. This will not effect the original array.
Looping through the picture boxes we assign a random position to the box then remove that point from the list.
Public Class PictureSort
Private Rand As New Random()
Private PointArray As Point() = {New Point(100, 100), New Point(200, 100), New Point(300, 100), New Point(100, 200), New Point(200, 200), New Point(300, 200), New Point(100, 300), New Point(200, 300), New Point(300, 300)}
Private PictureBoxArray(8) As PictureBox
Private Sub PictureSort_Load(sender As Object, e As EventArgs) Handles MyBase.Load
PictureBoxArray = {PictureBox1, PictureBox2, PictureBox3, PictureBox4, PictureBox5, PictureBox6, PictureBox7, PictureBox8, PictureBox9}
End Sub
Private Sub RepositionPictureBoxes()
Dim lst = PointArray.ToList
For Each pb In PictureBoxArray
Dim index = Rand.Next(0, lst.Count)
pb.Location = lst(index)
lst.RemoveAt(index)
Next
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
RepositionPictureBoxes()
End Sub
End Class
My advice is to use a control array - you have an example here that should help: VB.NET Control Array- Declaration and Application.
You just need to initiate that array of controls once, this can be done at form load.
The next step is to sort that array in a random manner. Finally, loop on the array and every time your current loop index modulo 3 = 0, then you increase the Y coordinates and reset the X position.
Here is an example. You can see that each time you click on the button, the picture boxes are rearranged on the form in random order using an ad hoc function. For each picture box, a bitmap is generated on the fly to show the index of the control.. this is for demonstration purposes.
Public Class frmPics
Private pics As New List(Of PictureBox)
Private Const picture_width As Integer = 100, picture_height As Integer = 50
Sub New()
' This call is required by the Windows Form Designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
' instantiate controls
Dim font As New Font("Arial", 20, FontStyle.Regular, GraphicsUnit.Pixel)
For i As Integer = 1 To 9
Dim pic As New PictureBox
pic.Visible = False
pic.Name = "pic" & i
pic.Text = i.ToString
Console.WriteLine("Create control: name: " & pic.Name)
' generate an ad-hoc bitmap image showing the index of the control
Dim bitmap As New Bitmap(picture_width, picture_height)
Using g As Graphics = Graphics.FromImage(bitmap)
Dim width As Integer = CInt(g.MeasureString(Text, font).Width)
Dim height As Integer = CInt(g.MeasureString(Text, font).Height)
End Using
Using g As Graphics = Graphics.FromImage(bitmap)
g.Clear(Color.Blue)
g.DrawString(i.ToString, font, New SolidBrush(Color.White), 0, 0)
End Using
pic.Image = bitmap
pics.Add(pic)
Me.Controls.Add(pic)
Next
End Sub
Private Sub btnShuffle_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnShuffle.Click
Dim x As Integer = 10, y As Integer = picture_height
Dim counter As Integer = 1
Dim rnd As New Random()
' show controls on form
Console.WriteLine("Show controls on form")
Me.SuspendLayout()
For Each item In pics.OrderBy(Function() rnd.Next)
item.Width = picture_width
item.Height = picture_height
item.Location = New Point(x, y)
item.BorderStyle = BorderStyle.FixedSingle
item.Visible = True
Console.WriteLine("counter: " & counter & " - control name" & item.Name & " - position: " & item.Location.X & "/" & item.Location.Y & " text: " & item.Text)
' reset X position every 3 iterations
If counter Mod 3 = 0 Then
x = 10
y += item.Height
Else
x += item.Width
End If
counter += 1
Next
Me.ResumeLayout()
End Sub
End Class
I can drag a PictureBox onto a Form Control, a Tab Control or a Panel Control, etc. And I can import an image into a PictureBox. However, I don't know how to group multiple PictureBoxes together in Visual Studio 2017. Looks like there is no such a function. I need this function because I want to generate a big picture based on the user's input. That big picture consists of multiple small pictures, the visibility of which is controlled by the user through multiple checkboxes.
In Excel, I could put multiple pictures in it, group them together, use the VBA to control the visibility of each picture, and finally copy that picture group into a Word file. I would do this in a VSTO Word Document project in Visual Studio 2017 using vb.net.
I added some pictures for demonstrate the expected function.
Picture 1 shows the small pictures to be used in a big picture. (Please ignore the .vslx file)
Picture 2 shows a possible result based on user's input.
You can make your own custom control. here is an example/suggestion how to do it with a User control that can be reused across your application. the user control is holding panels in a matrix, you can set a drag&drop Event to each Panel control and the user will be able to drop a picture box on each panel:
USER CONTROL:
Public Class UserControl1
Public NumberOfPanelsInRow As Integer
Sub New(ByVal height As Integer, width As Integer, Optional ByVal numberofPanelsInRow As Integer = 3)
' This call is required by the designer.'
InitializeComponent()
' Add any initialization after the InitializeComponent() call.'
Me.Height = height
Me.Width = width
Me.NumberOfPanelsInRow = numberofPanelsInRow
End Sub
Private Sub UserControl1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' grouped panels to hold picturebox you can drag & drop to them...'
Dim panelHeight As Integer = Me.Height / NumberOfPanelsInRow
Dim panelWidth As Integer = Me.Width / NumberOfPanelsInRow
Dim colors() As Color = {Color.Pink, Color.Black, Color.Red, Color.Cyan, Color.Green, Color.Orange,
Color.Red, Color.Pink, Color.Black, Color.Red, Color.Cyan, Color.Green, Color.Orange, Color.Red}
Dim total As Integer = NumberOfPanelsInRow * NumberOfPanelsInRow
Dim currentYlocation As Integer = 0
Dim currentXlocation As Integer = 0
Dim location As Point = New Point(0, currentYlocation)
Dim rowcounter As Integer = 0
Dim itemcounter As Integer = 0
For i = 1 To total
If rowcounter >= NumberOfPanelsInRow Then
rowcounter = 0
currentYlocation += panelHeight
currentXlocation = 0
End If
' to each one of this panel you can drag a picture box'
Dim p As New Panel
p.Size = New Size(panelWidth, panelHeight)
p.Location = New Point(currentXlocation, currentYlocation)
p.BackColor = colors(itemcounter)
Me.Controls.Add(p)
rowcounter += 1
itemcounter += 1
currentXlocation += panelWidth
Next
End Sub
End Class
CALLING THE USER CONTROL FROM FORM1:
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim uc = New UserControl1(300, 300)
Me.Controls.Add(uc)
End Sub
End Class
GUI OUTPUT:
I'm trying to create a simple program that will allow you to enter a degree and have a dial fill to that exact degree, and then also display the degree inside of the dial. The project builds without errors, and will display correctly until a value is entered into the textbox, and then I will get the error on the line
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
If I comment out that line it will go down to the line below it. This is my first time using vb.net, so I'm guessing there is something small I'm just doing incorrectly. My full code is:
Public Class Form1
Dim degree As Double
Dim ge As Graphics
Private Sub Form2_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
ge = e.Graphics
DrawProgress(ge, New Rectangle(150, 25, 400, 400), degree)
End Sub
Private Sub DrawProgress(g As Graphics, rect As Rectangle, degree As Double)
'work out the angles for each arc
Dim progressAngle = CSng(degree)
Dim remainderAngle = 360 - progressAngle
'create pens to use for the arcs
Using progressPen As New Pen(Color.LightSeaGreen, 2), remainderPen As New Pen(Color.LightGray, 2)
'set the smoothing to high quality for better output
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
'draw the blue and white arcs
g.DrawArc(progressPen, rect, -90, progressAngle)
g.DrawArc(remainderPen, rect, progressAngle - 90, remainderAngle)
End Using
'draw the text in the centre by working out how big it is and adjusting the co-ordinates accordingly
Using fnt As New Font(Me.Font.FontFamily, 50)
Dim text As String = degree.ToString
Dim textSize = g.MeasureString(text, fnt)
Dim textPoint As New Point(CInt(rect.Left + (rect.Width / 2) - (textSize.Width / 2)), CInt(rect.Top + (rect.Height / 2) - (textSize.Height / 2)))
'now we have all the values draw the text
g.DrawString(text, fnt, Brushes.Black, textPoint)
End Using
End Sub
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
Dim input_s As String
input_s = TextBox1.Text
If (String.IsNullOrEmpty(input_s)) Then
degree = 0
Else
degree = CDec(input_s)
End If
DrawProgress(ge, New Rectangle(150, 25, 400, 400), degree)
End Sub
End Class
I'm writing a full screen program for windows tablets that needs to resize all of its controls to fit the screen, regardless of rotation.
right now i'm using the following:
Private Sub CreateOrder_Resize(sender As Object, e As EventArgs) Handles MyBase.Resize
Dim widthMultiplier As Decimal = (Me.Width * 0.99) / itemsPanel.Width 'this panel is 99% as tall as the form initially, and 80% as tall
Dim heightMultiplier As Decimal = (Me.Height * 0.8) / itemsPanel.Height
resizeEverything(Me.Controls, widthMultiplier, heightMultiplier)
End Sub
Private Sub resizeEverything(ByRef container As Object, ByVal widthMultiplier As Decimal, ByVal heightMultiplier As Decimal)
For Each screenItem In container
screenItem.location = New Point(screenItem.location.x * widthMultiplier, screenItem.location.y * heightMultiplier)
screenItem.size = New Size(screenItem.width * widthMultiplier, screenItem.height * heightMultiplier)
checkIfFont(screenItem, widthMultiplier)
If screenItem.GetType() = (New Panel).GetType Then
resizeEverything(screenItem.controls, widthMultiplier, heightMultiplier)
End If
Next
End Sub
Private Sub checkIfFont(ByRef viewObject As Object, ByVal multiplier As Decimal)
Dim fontCarriers() As Object = {New RichTextBox, New Label, New TextBox, New ListBox, New DateTimePicker, New ComboBox}
For Each controlType In fontCarriers
If viewObject.GetType = controlType.GetType Then
controlType = viewObject
Dim myFont As Font = controlType.font
Dim newFont As Font = New Font(myFont.Name, myFont.Size * multiplier, myFont.Style)
viewObject.font = newFont
Exit For
End If
Next
End Sub
This has proven to be far too resource intensive for some of the tablets I've had to put it on.
I havent used Autoscale because the form needs to 'squish' a bit when the tablet is used in portrait mode, and as far as i'm aware, autoscale maintains aspect ratio.
So how can i do this without grinding through and resizing each control?
I wanted to be able to dynamically create a panel with a label on it, but the label isn't acting as I would expect it too, its cutting most of it off.
When I create a panel then create a label inside the panel, the text isn't displayed correctly. Anyone know how to fix it?
What is was supposed to do was to create a panel with text on it with the newpanel() sub
Dim timetable(5, 5) As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Width = (74 * 5) - 3
Me.Height = My.Computer.Screen.Bounds.Size.Height
Me.Top = My.Computer.Screen.Bounds.Top
Me.Left = My.Computer.Screen.Bounds.Right - Me.Width
GetTimetable()
End Sub
Private Sub newpanel(colour As Color, textT As String)
Dim Npan As New Panel
Npan.Top = 0
Npan.Left = 0
Npan.Width = Me.Width
Npan.Height = 64
Npan.BackColor = colour
Dim NpanT As New Label
NpanT.Parent = Npan
NpanT.Text = textT
Npan.Controls.Add(NpanT)
Me.Controls.Add(Npan)
End Sub
Private Sub GetTimetable()
'Dim path As String = My.Computer.FileSystem.SpecialDirectories.Desktop + "\Timetable"
newpanel(Color.Aqua, "this is a test! test testtesttest test test test")
End Sub
Looking at the MSDN page for the Label.AutoSize Property, it states as was mentioned above that the Labels AutoSize Property defaults to true in the designer, but it is false when created in code.
From above link:
When added to a form using the designer, the default value is true. When instantiated from code, the default value is false.
So you need to change your newpanel method to this:
Private Sub newpanel(colour As Color, textT As String)
Dim Npan As New Panel
Npan.Top = 0
Npan.Left = 0
Npan.Width = Me.Width
Npan.Height = 64
Npan.BackColor = colour
Dim NpanT As New Label
NpanT.Parent = Npan
NpanT.Text = textT
NpanT.AutoSize = True 'Enables Auto sizing
Npan.Controls.Add(NpanT)
Me.Controls.Add(Npan)
End Sub