how to change deprecated code - Scale(ratio As Single)' is obsolete ... use Scale(SizeF) - vb.net

I have some issues with Winform scaling, and found this code here
Public Sub ScaleForm(WindowsForm As System.Windows.Forms.Form)
Using g As System.Drawing.Graphics = WindowsForm.CreateGraphics
Dim sngScaleFactor As Single = 1
Dim sngFontFactor As Single = 1
If g.DpiX > 96 Then
sngScaleFactor = g.DpiX / 96
'sngFontFactor = 96 / g.DpiY
End If
If WindowsForm.AutoScaleDimensions = WindowsForm.CurrentAutoScaleDimensions Then
'ucWindowsFormHost.ScaleControl(WindowsForm, sngFontFactor)
WindowsForm.Scale(sngScaleFactor)
End If
End Using
End Sub
The code is brilliant! It does what I want it to do, (scales the form) even though I have NO idea WHAT it is doing.
However I get the following message on this line WindowsForm.Scale(sngScaleFactor)
'Public Sub Scale(ratio As Single)' is obsolete: 'This method has been deprecated. Use the
Scale(SizeF ratio) method instead.
Please would someone be able to help me to rewrite the line of code using the suggested change?
As I said , I have no idea what the code is doing, and in order to test such code in high DPI scale environment one can't use the debugger because VS resizes everything to the new DPI settings. I also searched and found some very sparse explanations with no examples and as my skill level is nonexistent in this field I am floundering with it.

I found the answer through experimentation and the way shown by Hans Passant. The code is designed to scale the Form using DPI. WHile it is true that this can be done by Form AutoScaleMode settings, the issue is that this setting cannot be altered dynamicaly. I have need for a user to manually select such scaling, where otherwise it is set to none. This code does the job very well!
Public Sub ScaleForm(WindowsForm As System.Windows.Forms.Form)
Using g As System.Drawing.Graphics = WindowsForm.CreateGraphics
Dim sngScaleFactor As Single = 1
Dim sngFontFactor As Single = 1
If g.DpiX > 96 Then
sngScaleFactor = g.DpiX / 96
'sngFontFactor = 96 / g.DpiY
End If
If WindowsForm.AutoScaleDimensions = WindowsForm.CurrentAutoScaleDimensions Then
'ucWindowsFormHost.ScaleControl(WindowsForm, sngFontFactor)
' WindowsForm.Scale(sngScaleFactor)
WindowsForm.Scale(New SizeF(sngScaleFactor, sngScaleFactor))
End If
End Using
End Sub

Related

Argument not optional, how can I change it?

I'm getting a message Argument not optional running the code below:
Private Sub CommandButton1_Click()
Dim linia As AcadLine
Dim Pt1(0 To 2) As Double
Dim stopien(0 To 3) As Double
Dim segment As Variant
Dim n As Double
Dim h As Double
n = CDbl(TextBox1)
h = CDbl(TextBox2)
Pt1(0) = 10# '
Pt1(1) = 10# '
Pt1(2) = 0# '
segment = Pt1
For Licznik = 0 To n - 1
stopien(0) = segment(0)
stopien(1) = segment(1)
stopien(2) = segment(0) + h
stopien(3) = segment(1)
Set linia = ThisDrawing.ModelSpace.AddLine(stopien)
segment(0) = stopien(2)
segment(1) = stopien(3)
Next
End Sub
I can debug it , but if I write something in the TextBox1 or TextBox2 I get this message.
I don't know how I can fix it
The error message is telling you exactly what the issue is... namely, that you are not supplying a needed argument. In this case, the offending line is below:
Set linia = ThisDrawing.ModelSpace.AddLine(stopien)
The AddLine method takes both a StartPoint and an EndPoint, and you are only supplying one of them.
CDbl to the textbox.. hmm.. Shouldn't that be Textbox1.value ? I think you need more uh error handling on the input for Textbox1 and Textbox2.
For example do something like this before you start converting - so put a breakpoint on your first value set of n = CDbl(Textbox1). Then make sure you can see the debug / immediate views in VBA editor. Then write something like this or add Textbox1 to a watch, and expand it's properties to make sure you are using the object's values correctly.
Debug.print(Textbox1)
Debug.print(Textbox1.value)
To handle problems in conversion or w/e, you want to add error handles to the value checks before you set the values to variables.
MrExcel classic discussion on userform handling input errors

Get max value from RichTextBox

I am having a difficult time getting the correct maximum value from a rich text box. I have tried using 3 different methods to find the max value and all work the same way. For this sample I am working with GPS Speed data. So I add the speeds 1 by 1 to the rich text box. The issue I am experiencing gives me a maximum speed value of 11.3 or 11.4 under certain scenarios.
For example, if the speed is greater than 12.0 it works fine. If the speed is below 11.0 it works fine. If the speed goes above (or starts above) 11.5 but then drops down below 11.5, the max reported will be one of these 11.3 or 11.4 numbers
It truly seems like my code believes 11.3 is the largest of numbers.
I tried Richtextbox.lines.Max(), i tried adding the data to a list, and also adding from the RTB to an array and using the methods below.
Private Sub CheckMaxSpeed()
Dim speed
If MaxSpeedRTB.Text = "" Then
MaxSpeedtxt.Text = "N/A"
MaxSpeedtxt.Text = "N/A"
Exit Sub
Else
'speed = MaxSpeedRTB.Lines.Max()
'Dim speedlist As List(Of String) = MaxSpeedRTB.Lines.ToList
Dim myArr As String() = MaxSpeedRTB.Lines
speed = myArr.Max()
'speed = speedlist.Max
speed *= 1.15078
speed = Math.Round(speed, 1)
If speed < 0.4 Then
speed = "0.0"
End If
MaxSpeedtxt.Text = speed & " MPH"
MaxSpeedRTB.Clear()
MaxSpeedCom = False
End If
Invoking Max against string is a recipe for disaster.
Instead, try parse all lines as Single then invoke Max against it:
Dim lines = RichTextBox1.Lines
Dim values = New List(Of Single)
For Each line As String In lines
Dim result As Single
Dim tryParse = Single.TryParse(line, result)
If tryParse Then
values.Add(result)
End If
Next
Dim max = values.Max()
Result:
For the following lines in RichTextBox:
11.1
11.123
Max = 11.123

VBA Array of picture boxes

I am making a game for my intro to comp programming class, I have a 6 by 6 board where you do something different on each tile. I am currently working on a mob collision sub where if the player collides with the mob the player has to battle. Right now I have an issue with creating multiple of the same time of mob. Here is my code
Public Sub creeperS()
' Dim creeper As New PictureBox
'This is now above so it can be used by other subs
Dim creepercount As Integer
creeper.Width = 32
creeper.Height = 32
creeper.BackColor = Color.LimeGreen
creepercount = rand.Next(0, 36)
If creepercount = 0 Then
Me.Controls.Add(creeper)
creeper.Top = 95
creeper.Left = 84
creeper.BringToFront()
ElseIf creepercount = 1 Then
Me.Controls.Add(creeper)
creeper.Top = 95
creeper.Left = 184
creeper.BringToFront()
ElseIf creepercount = 2 Then
Me.Controls.Add(creeper)
creeper.Top = 95
creeper.Left = 284
creeper.BringToFront()
ElseIf creepercount = 3 Then
It does this all the way to 36, Im wondering if you can make a picture box array so i can have several of a mob on the board.
You did not post your class code, so I will try showing you a generic method to create controls and keep them in an array. In fact a Dictionary object...
Create a variable on top of your form, at the declarations side:
Option Explicit
Private shDict As Object
Then put the next code in your Form Initialize event:
Dim i As Long, No As Long
Dim txtBox As MSForms.TextBox
No = 36 'your needed controls
Set shDict = CreateObject("Scripting.Dictionary")
For i = 84 To No * 100 Step 100
Set txtBox = Controls.Add("Forms.TextBox.1", "txt_" & i)
shDict.Add txtBox.Name, Array(txtBox, 95, i, True)
Next i
Not having your class, my example code creates text boxes and fills their Name, Top and Left properties in a Dictionary array. It can keep objects, arrays, strings etc. I tried to use your Top and Left logic, but big part of them will not fit on the form surface...
Place a button on the form (named btRepAll). It will preposition all created shapes according to the values previously input in shDict.
Private Sub btRepAll_Click()
Dim i As Long
For i = 84 To shDict.Count * 100 Step 100
shDict("txt_" & i)(0).top = shDict("txt_" & i)(1)
shDict("txt_" & i)(0).left = shDict("txt_" & i)(2)
Next i
End Sub
I wanted to ask some other preliminary questions, to clarify myself regarding your real need, but since you did not answered a simple one and I cannot stay to much at my office, I preferred to post a generic answer. You can load as many properties as you want. Please try building something similar, able to better fit your real need.

Flood fill algorithm for Visual Basic [duplicate]

I am an amateur in Visual Basic. I am attempting to recreate the game of Go, and I have created the board and am able to place stones on the intersections of the grid.
I now want to start capturing stones which are surrounded. I have looked online and found that flood fill is the best way to go about this. However, I have looked online for days, and I can't find anything that I can use, or manipulate to create this. I do not understand any other programming language, so I cannot use bits of code from Java, etc. And the bits of information for Visual Basic I have found do not make much sense to me as I am still a beginner.
I have attempted to start it by myself, starting off small with the situation of "If one stone were to be captured". I have two representations for the board, one is declared as "grid", and the other as "placed_stone".
"Grid" is the actual board where the users click to place their stones. placed_stone is a copy of this board, but I have used "0", "1" and "2" to represent empty, black and white respectively. I am using Windows Forms to recreate this game. This is the segment of code I have written for capturing the stones:
Private Sub Panel1_Click(sender As Object, e As EventArgs) Handles Panel1.Click
Dim board As Panel = DirectCast(sender, Panel)
' Figure out where the user clicked: min = 0, max = (gridsize - 1)
Dim pt As Point = board.PointToClient(Cursor.Position)
Dim colWidth As Integer = (1 / (GridSize + 1)) * board.Size.Width
Dim rowHeight As Integer = (1 / (GridSize + 1)) * board.Size.Height
Dim gridPosition As New Point(Math.Min(Math.Max((pt.X / colWidth) - 1, 0), GridSize - 1), Math.Min(Math.Max((pt.Y / rowHeight) - 1, 0), GridSize - 1))
Dim newcoordsx As Integer
Dim newcoordsy As Integer
' Now do something with gridPosition:
If Not Grid(gridPosition.X)(gridPosition.Y).HasValue Then 'If gird(x,y) is empty
illegalmovelbl.Hide() ' Hides the "Illegal Move" Label
If cp = True Then ' If current player is Black
This is the part where I got stuck and realised that the coding for every situation will take too long. I managed to write up the code for one situation:
newcoordsx = gridPosition.X + 1
If placed_stone(newcoordsx, gridPosition.Y) = 2 Then
newcoordsy = gridPosition.Y + 1
If placed_stone(newcoordsx, newcoordsy) = 1 Then
newcoordsy = gridPosition.Y - 1
If placed_stone(newcoordsx, newcoordsy) = 1 Then
newcoordsx = gridPosition.X + 2
If placed_stone(newcoordsx, gridPosition.Y) = 1 Then
newcoordsx = gridPosition.X + 1
Grid(gridPosition.X)(gridPosition.Y) = True 'Place a black stone at Grid(x,y)
Grid(newcoordsx)(gridPosition.Y) = Nothing
placed_stone(newcoordsx, gridPosition.Y) = 0
pass = False
cp = False
passbtn.BackColor = Color.White 'The passbutton changes colour to white
passbtn.ForeColor = Color.Black 'The passbutton font changes colour to black
End If
End If
End If
End If
'Grid(gridPosition.X)(gridPosition.Y) = True ' Place a black stone at Grid(x,y)
'placed_stone(gridPosition.X, gridPosition.Y) = 1
'pass = False
'cp = False
'passbtn.BackColor = Color.White ' The passbutton changes colour to white
'passbtn.ForeColor = Color.Black ' The passbutton font changes colour to black
ElseIf cp = False Then ' If current player is White
Grid(gridPosition.X)(gridPosition.Y) = False ' Place a white stone at Grid(x,y)
placed_stone(gridPosition.X, gridPosition.Y) = 2
pass = False
cp = True
passbtn.BackColor = Color.Black ' The passbutton changes colour to black
passbtn.ForeColor = Color.White ' The passbutton font changes colour to white
End If
ElseIf Grid(gridPosition.X)(gridPosition.Y).HasValue Then ' If gird(x,y) isn't empty
illegalmovelbl.Show() ' Shows the "Illegal Move" Label
MsgBox("Place your stone in a vacant point") ' Displays error message
End If
board.Invalidate() ' Force the board to redraw itself
End Sub
I have tried to use Wikipedia's algorithm on flood fill, and I understand the logic of how it works, but I just don't know how to program it in Visual Basic.
Flood-fill (node, target-color, replacement-color):
1. If target-color is equal to replacement-color, return.
2. If the color of node is not equal to target-color, return.
3. Set the color of node to replacement-color.
4. Perform Flood-fill (one step to the south of node, target-color, replacement-color).
Perform Flood-fill (one step to the north of node, target-color, replacement-color).
Perform Flood-fill (one step to the west of node, target-color, replacement-color).
Perform Flood-fill (one step to the east of node, target-color, replacement-color).
5. Return.
Of course, in Go, instead of colouring in the area, you have to remove the stones when capturing, and you don't start the flood fill from the stone you just placed to capture, you start from the closest stone you wish to capture.
Can you please explain how to use flood fill in Visual Basic in an easy way and how to implement it to this game of Go?
If anyone would like to look at the whole code, please let me know. I would appreciate any suggestions!
I'm not familiar with the rules/game-play of the game Go, so I'm not sure exactly what you are attempting to accomplish, but if you believe that a flood-fill type of algorithm is what you need, then I can at least offer some advice in how you could do that. The primary thing that your code needs is to be broken down into more granular methods. What are the steps that you are attempting to perform when the panel is clicked? Surely it's not just one thing. There are many different things going on--each of which could be performed by a separate dedicated method. For instance, if you had a method like this:
Private Function GetGridPosition(board As Panel, cursorPosition As Point) As Point
Dim pt As Point = board.PointToClient(Cursor.Position)
Dim colWidth As Integer = (1 / (GridSize + 1)) * board.Size.Width
Dim rowHeight As Integer = (1 / (GridSize + 1)) * board.Size.Height
Return New Point(Math.Min(Math.Max((pt.X / colWidth) - 1, 0), GridSize - 1), Math.Min(Math.Max((pt.Y / rowHeight) - 1, 0), GridSize - 1))
End Function
Then, in the Panel1_Click event handler, you could simplify the beginning of the code considerably, like this:
Private Sub Panel1_Click(sender As Object, e As EventArgs) Handles Panel1.Click
Dim board As Panel = DirectCast(sender, Panel)
Dim gridPosition As Point = GetGridPosition(board, Cursor.Position)
' ...
Sure, that makes the code more organized and easier to read, but that doesn't get you any closer to a flood fill algorithm, right? Well, yes, that's mostly true, but organization and readability are worthy goals in their own right, so lets continue anyway... The next step we need to perform is to make the player's move, and then, if the move was successful, we need to switch to the other player. So, let's first create the method to switch players:
Private Sub SwitchPlayer()
pass = False
cp = Not cp
passbtn.BackColor = GetPlayerForeColor(cp)
passbtn.ForeColor = GetPlayerBackColor(cp)
End Sub
Private Function GetPlayerForeColor(player as Boolean) As Color
If player Then
Return Color.White
Else
Return Color.Black
End If
End Function
Private Function GetPlayerBackColor(player as Boolean) As Color
If player Then
Return Color.Black
Else
Return Color.White
End If
End Function
You'll notice that I snuck (Chrome auto-spell tells me that isn't a word, but my American upbringing begs to differ) a couple other methods in there while I was at it. I'm sure their purpose is obvious. But stop right there. It's obvious? You'll notice that the comments are gone, yet the meaning of the code is still obvious. That's what we mean by self-documenting code. Comments are great when they're necessary, but it's even better when they aren't necessary at all.
So, pretend for now we have a method like this:
Private Function MakeMove(gridPosition As Grid, player As Boolean) As Boolean
' return true if the move was successful
End Function
Then the whole Panel1_Click event handler could look like this:
Private Sub Panel1_Click(sender As Object, e As EventArgs) Handles Panel1.Click
Dim board As Panel = DirectCast(sender, Panel)
Dim gridPosition As Point = GetGridPosition(board, Cursor.Position)
If MakeMove(gridPosition, cp) Then
SwitchPlayer()
Else
ShowIllegalMoveMessage()
End If
End Sub
Private Sub ShowIllegalMoveMessage()
illegalmovelbl.Show() 'Shows the "Illegal Move" Label
MsgBox("Place your stone in a vacant point") 'Displays error message
End Sub
Ok, so now we're getting to the meat of it. So, what are the steps that need to be taken when a move is being made? Well, I don't know, because I don't know the game. I leave that exercise up to you, but, if your inclinations are correct, and you need some kind of flood fill algorithm, then that probably means that you need some kind of PlaceStone action which can be repeated over and over again, so that should be its own method:
Private Sub PlaceStone(gridPosition As Point, player As Boolean)
' Do something
End Sub
Obviously the Do something is the key part of all this, and it's the one part that I can't help you with. But, if it's going to be a flood fill algorithm, I can give you a really big hint. Among all the other stuff it's going to do in there, it's going to be calling PlaceStone again, passing it a different grid position (one of the surrounding positions). So for instance, something like this:
Private Sub PlaceStone(gridPosition As Point, player As Boolean)
Dim north As Position = GetNorthPosition(gridPosition)
If Floodable(north, player) Then
PlaceStone(north, player)
End If
' ...
End Sub
When a method calls itself, like that, we call it recursion. But, until you start splitting your code up into dedicated little methods, each with its own encapsulated task, then you can't really add recursion. So, first get organized, then add recursion.

Selecting layer to search on all pages

This is part of the code im working with;
Dim s As Shape
Dim p As Page, numberPage As Integer
Dim i&
Dim WhatSamp As String
WhatSamp = "Sample1"
For i = 1 To ActiveDocument.Pages.Count
ActiveDocument.Pages(i).Activate
For Each s In ActiveDocument.ActivePage.Shapes
If s.Type = cdrTextShape Then
If InStr(1, s.Text.Story, WhatSamp) > 0 Then
ActivePage.Layers("Sample").Visible = True
ActivePage.Layers("Sample").Printable = True
End If
End If
Next
Next i
The code im working with is much longer but i believe this is the relevant part.
It searches for my text on the page (Sample1) then displays and makes printable the layer called "Sample".
I think because I have a ridiculous amount of needed layers it takes forever to run
So, Im trying to get it to search for my text only on a specific layer that exists on each page called "Style" but i cant seem to figure it out.
Thank you in advance.
Let me know if more information is needed
To test on what layer is object "S" use if
if S.Layer.Name="Style" then
then
If InStr(1, s.Text.Story, WhatSamp) > 0 Then
ActivePage.Layers("Sample").Visible = True
ActivePage.Layers("Sample").Printable = True