I have an auto-clicker where if you click a button it checks your current screen, the screen it saw when you made the auto-clicker program, compares them, and if they're similar enough it "approves" the set-up. Otherwise it says to adjust your camera angle and warns you that the auto-clicker could fail.
The problem is if you spam the button, "Calibrate" in this case, it will eventually lead to an "Out of memory" exception.
I noticed this when I got mad running it myself, unable to get it to pass, spamming the button... and then the program crashed.
The code that I think is relevant is:
For Each scr As Screen In Screen.AllScreens
Wdt += scr.Bounds.Width
Next
Dim ScreenSizeTotal As Size = New Size(Wdt, My.Computer.Screen.Bounds.Height)
Dim ScreenGrab1 As New Bitmap(Wdt, My.Computer.Screen.Bounds.Height)
Dim g As Graphics = Graphics.FromImage(ScreenGrab1)
g.CopyFromScreen(New Point(0, 0), New Point(0, 0), ScreenSizeTotal)
If System.IO.File.Exists(DriveLetter & "RSAutoClicker\" & "TestClick.bmp") = True Then
My.Computer.FileSystem.DeleteFile(DriveLetter & "RSAutoClicker\" & "TestClick.bmp")
End If
ScreenGrab1.Save(DriveLetter & "RSAutoClicker\" & "TestClick.bmp")
a = New Bitmap(DriveLetter & "RSAutoClicker\" & TestProgram & "\" & TestProgram & "Click1.bmp") 'Out of memory exception occurs on this line
b = New Bitmap(DriveLetter & "RSAutoClicker\" & "TestClick.bmp")
Dim ScreenRegion As New Bitmap(b.Width, b.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
For y As Integer = My.Settings.VerifyScreenYU To My.Settings.VerifyScreenYD - 1 Step 4
For x = My.Settings.VerifyScreenXL To My.Settings.VerifyScreenXR - 1 Step 4
Dim aColor As Color = a.GetPixel(x, y)
Dim bColor As Color = b.GetPixel(x, y)
If aColor.ToArgb() = bColor.ToArgb() Then
PixelMatchCount += 1
End If
TotalPixels += 1
Next
Next
a.Dispose()
b.Dispose()
The stuff about saving/deleting is about the "Calibrate" button and deleting the picture after the check has been done. The YL YR XD & XU is the boundaries of where to check in the left, right, top, and down direction on the screen.
The "Step 4" stuff is because I'm only checking every 4th pixel, otherwise its very intensive operating wise. Every 4 pixels in the X & Y direction seemed to be a good compromise that still gave good results.
I use .Dispose() to throw everything away when it's done. But I think I have misunderstood what .Dispose() is for, because it isn't doing that. I feel that is where the error lies, but I don't know how to fix it.
I could be totally wrong, but any help is appreciated. thank you!
Related
I'm building a text editor program, and on the left-hand side of the main RichTextBox, is a line numbering scheme that consists of a PictureBox, and a routine uses the Graphics method to draw numbers. As you scroll down the RichTextBox, the line numbers equally adjust.
I found some code online and made a few adjustments, but I'm struggling with one of them.
I have a Zoom In/Out feature so the user can adjust the size of the text in the RichTextBox, this is done by adding/subtracting 0.5 to/from the .ZoomFactor property of the RichTextBox. That part works perfectly and is a great, simple solution. However; If I adjust the zoom on the RichTextBox, the text is now larger than the line numbers, so they don't line up. My idea was to just increase the font size of the line numbering scheme and make small adjustments until they line up perfectly with each other.
Example:
This is it at normal size (the numbers are coloured because I've told the program to do that on purpose)
This is what happens when I adjust the RichTextBox zoom factor, without adjusting font size of line number
The code for drawing the line numbers is:
Private Sub DrawRichTextBoxLineNumbers(ByRef g As Graphics)
With TextEditBox
Dim font_height As Single
font_height = .GetPositionFromCharIndex(.GetFirstCharIndexFromLine(2)).Y _
- .GetPositionFromCharIndex(.GetFirstCharIndexFromLine(1)).Y
If font_height = 0 Then Exit Sub
'Get the first line index and location
Dim first_index As Integer
Dim first_line As Integer
Dim first_line_y As Integer
first_index = .GetCharIndexFromPosition(New _
Point(0, g.VisibleClipBounds.Y + font_height / 3))
first_line = .GetLineFromCharIndex(first_index)
first_line_y = .GetPositionFromCharIndex(first_index).Y
'Print on the PictureBox the visible line numbers of the RichTextBox
g.Clear(Control.DefaultBackColor)
Dim i As Integer = first_line
Dim y As Single
Do While y < g.VisibleClipBounds.Y + g.VisibleClipBounds.Height
y = first_line_y + 2 + font_height * (i - first_line - 1)
g.DrawString((i).ToString, .Font, Brushes.Gray, LineNumber.Width _
- g.MeasureString((i).ToString, .Font).Width, y)
i += 1
Loop
'Debug.WriteLine("Finished: " & firstLine + 1 & " " & i - 1)
End With
End Sub
What adjustment would I make to this section of the code to increase the size?
Dim font_height As Single
font_height = .GetPositionFromCharIndex(.GetFirstCharIndexFromLine(2)).Y _
- .GetPositionFromCharIndex(.GetFirstCharIndexFromLine(1)).Y
If font_height = 0 Then Exit Sub
Any help is greatly appreciated :)
Turns out, the drawing routine already handles this.
I've made it so that when the user moves the mouse on the form, resizes the form or adjusts the zoom, it refreshes.
I simply wrote the following code which immediately solved the problem.
LineNumber.Invalidate()
Also this was a great Line Numbers for RichTextBox with many Features
You can download the Source Code at this Link: https://drive.google.com/file/d/1aMVts_pkok_56DRvCdTkYCGywzjsRqS6/view?usp=sharing
I have connected a weighing scale to my PC via an RS-232 to USB converter cable. My goal was to create a command button in excel 2007 that would place the weight from the scale into the selected cell. I got it to work using the following code in a userform.
Private Sub XMCommCRC1_OnComm()
Static sInput As String
Dim sTerminator As String
Dim Buffer As Variant
' Branch according to the CommEvent property
Select Case XMCommCRC1.CommEvent
Case XMCOMM_EV_RECEIVE
Buffer = XMCommCRC1.InputData ' Use Input property for MSComm
sInput = sInput & Buffer
If Worksheets("Settings").Range("Terminator") = "CR/LF" Then
sTerminator = vbCrLf
Else
sTerminator = vbCr
End If
If Right$(sInput, Len(sTerminator)) = sTerminator Then
XMCommCRC1.PortOpen = False
sInput = Left$(sInput, Len(sInput) - Len(sTerminator))
Select Case Left$(sInput, 2)
Case "ST", "S "
ActiveCell.Value = CDbl(Mid$(sInput, 7, 8))
ActiveCell.Activate
Case "US", "SD"
MsgBox "The balance is unstable."
Case "OL", "SI"
MsgBox "The balance is showing an eror value."
End Select
sInput = ""
End If
End Select
End Sub
Public Sub RequestBalanceData()
With Worksheets("Settings")
' Configure and open the COM port
If Not XMCommCRC1.PortOpen Then
XMCommCRC1.RThreshold = 1
XMCommCRC1.RTSEnable = True
XMCommCRC1.CommPort = .Range("COM_Port")
XMCommCRC1.Settings = .Range("Baud_Rate") & "," & _
.Range("Parity") & "," & _
.Range("Data_Bits") & "," & _
.Range("Stop_Bits")
XMCommCRC1.PortOpen = True
End If
' Send balance's "SI" (Send Immediate) command
' to request weighing data immediately
If .Range("Terminator") = "CR/LF" Then
XMCommCRC1.Output = "R" & vbCrLf
Else
XMCommCRC1.Output = "R" & vbCr
End If
End With
End Sub
I then created a command button with the following code.
Private Sub CommandButton1_Click()
UserForm1.RequestBalanceData
End Sub
When I click on the command button the weight is placed in the selected cell. However, this does not consistently happen. Sometimes when I click the button nothing will be placed in the cell, and I will have to click it multiple times until the weight is placed in the cell. I would like to fix this, but I'm not sure where to start. Is it a problem with the code itself, or is it more likely a problem with the converter or the scale itself?
Any help is appreciated.
Here is the scale: https://www.optimascale.com/product-page/op-915-bench-scale
Here is the converter cable: https://www.amazon.com/gp/product/B06XJZHCV8/ref=ox_sc_act_title_3?smid=A33N7O64F8FSDL&psc=1
Here is the tutorial I used for the code: http://www.msc-lims.com/lims/diybalance.html
Here is the ActiveX control from the tutorial that I used: http://www.hardandsoftware.net/xmcomm.htm
EDIT: I have done what Wedge has suggested and placed a Mgsbox sInput after my first End If. I have been getting inconsistent results. I am wondering if I need to change my scales sending format. The scale is currently set to sending format 4.
Here is the scale manual (sending formats are on page 21-23: https://docs.wixstatic.com/ugd/78eff6_e629ae5fe7004c7189060cca4bc7c3de.pdf
2ND EDIT:
I have connected my serial port to putty. My scale is in continuos sending mode. In putty the scale is consistently sending the following: ST,GS+ 0.00lb. However, when i try to enter the weight value in a cell, the message box sometimes displays that part of the data sent (ST,GS+ 0.00lb) has got cut off, or has been sent multiple times with one button press. Does anyone know how I would fix this?
3RD EDIT: It seems to me that the continuous sending mode (mode 4) my scale is set to is sending data too fast and is causing my code to mess up. I would like to try to make this work with the command request mode (mode 3), but I can't figure out how to properly parse the data string and place it into a cell. The sending format for command request mode is :
If anybody could help me figure out how to get this working I would greatly appreciate it.
I am copying the string values out of text boxes on a form and saving them in the settings. The way I am doing it here seems kind of long handed. Is there a way to reference the TextBox1.Text and the My.Settings.Value1 with a string. If so then I could just loop through and keep changing the strings to point at the different controls. See the way I am currently doing it.
My.Settings.F1LabelCol0Save = F1LabelCol0.Text
My.Settings.F1LabelCol1Save = F1LabelCol1.Text
My.Settings.F1LabelCol2Save = F1LabelCol2.Text
My.Settings.F1LabelCol3Save = F1LabelCol3.Text
My.Settings.F1LabelCol4Save = F1LabelCol4.Text
My.Settings.F1LabelCol5Save = F1LabelCol5.Text
My.Settings.F1LabelCol6Save = F1LabelCol6.Text
My.Settings.F1LabelCol7Save = F1LabelCol7.Text
My.Settings.F1LabelCol8Save = F1LabelCol8.Text
My.Settings.F1LabelCol9Save = F1LabelCol9.Text
You can access both settings and controls dynamically via My.Settings.Item() and Me.Controls.Item().
I present you with two options:
1) Use a For loop for a fixed number range:
For x = 0 To 9
My.Settings("F1LabelCol" & x & "Save") = Me.Controls("F1LabelCol" & x).Text
Next
Upside: Does not swallow exceptions (see next example).
Downside: You must change the upper bound (currently 9) when you add new settings/controls.
2) Use a While loop for a dynamic number range.
Dim x As Integer = 0
While True
Try
My.Settings("F1LabelCol" & x & "Save") = Me.Controls("F1LabelCol" & x).Text
Catch
Exit While 'If an exception is thrown we've most likely hit the setting/control limit.
End Try
End While
Upside: Dynamic number range, you do not need to change anything when adding new settings/controls.
Downside: Swallows exceptions, i.e. you won't know when an exception is thrown for another reason than when a setting/control does not exist.
If you want to load data dynamically as well just reverse the get/set operation:
Me.Controls("F1LabelCol" & x).Text = My.Settings("F1LabelCol" & x & "Save")
I did some more research and here is how to do it. Now obviously it needs to be a number of of them very similarly named to to be worth it.
For i = 0 To 39
My.Settings("F1LabelCol" & i.ToString & "Save") = Me.Controls("F1LabelCol" & i.ToString).Text
Next
Just on some PCs, with "strange" video sizes, a WinForm app fails to correctly set the size of anchored controls. Strange e.g. a TV used as VGA device. Resize is working OK on Win7 desktops, but I need the app to work the same in conference rooms.
Private Sub frmSearch2_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd
Dim s As String = ""
s &= "me.size " & Me.Size.ToString & vbNewLine
s &= "Me.ClientSize " & Me.ClientSize.ToString & vbNewLine
s &= "dgv size: " & dgv01.Size.ToString & vbNewLine ' initially incorrect
s &= "panel size: " & Panel1.Size.ToString ' initially incorrect
Clipboard.SetText(s)
dgv01.Width = Me.ClientSize.Width - (dgv01.Left * 2) ' manually set width based on ClientSize
End Sub
Executed on the problem PC:
me.size {Width=941, Height=578}
Me.ClientSize {Width=925, Height=540}
dgv size: {Width=939, Height=361}
panel size: {Width=964, Height=52}
Note the dgv is wider than the client area even though it is anchored on all sides. Height is resizing properly. I added a Panel docked to left and right edges to see if it would resize properly - nope. Changing AutoScaleMode doesn't seem to help - didn't try all possibilities. Remember: scaling works on most PCs properly.
The last line of code that sets the DGV width manually is visually OK. This would be OK for a very simple form but I have many controls, some hosted in other controls, that need the same attention.
Likely a video driver problem but the code shows the WinForm has the proper ClientSize, it just isn't using that value to resize the controls.
Is there something I can call to force the WinForm to reprocess the anchors using the valid ClientSize? Or??
This is a strange problem... Some WinForms experience the problem and others don't. I haven't been able to determine the relevant differences.
The code below works 90+% for us as we have common names and positioning for significant controls on our forms that need to be resized on the problem PCs. A Panel - pnlResizer - was added to some forms that must work on the problem PCs - it contains most of the other significant controls.
Try
' try to deal with bad video drivers
Dim ctl() As Control = frm.Controls.Find("TabControl1", False)
If ctl.Length = 1 AndAlso (ctl(0).Width + ctl(0).Left) > frm.ClientSize.Width Then
ctl(0).Width = frm.ClientSize.Width - ctl(0).Left - 5
End If
ctl = frm.Controls.Find("StatusStrip1", False)
If ctl.Length = 1 AndAlso (ctl(0).Width + ctl(0).Left) > frm.ClientSize.Width Then
ctl(0).Width = frm.ClientSize.Width
End If
ctl = frm.Controls.Find("ToolStrip1", False)
If ctl.Length = 1 AndAlso (ctl(0).Width + ctl(0).Left) > frm.ClientSize.Width Then
ctl(0).Width = frm.ClientSize.Width - ctl(0).Left - 5
End If
ctl = frm.Controls.Find("pnlResizer", False)
If ctl.Length = 1 AndAlso (ctl(0).Width + ctl(0).Left) > frm.ClientSize.Width Then
ctl(0).Width = frm.ClientSize.Width - ctl(0).Left - 5
End If
Catch ex As Exception
End Try
I have the following VBA code
Private Sub CreateQuery_Click()
Dim doc As Document
Dim i As Integer
Set doc = ActiveDocument
i = doc.Paragraphs.Count
doc.Paragraphs(i).Range.InsertParagraphAfter
i = i + 1
For j = 0 To 1000
doc.Paragraphs(i).Range.InsertParagraphAfter
i = i + 1
doc.Paragraphs(i).Range.InsertParagraphAfter
i = i + 1
With doc.Paragraphs(i)
.Range.Font.Italic = True
.Range.ListFormat.ApplyBulletDefault
.Indent
.Indent
.TabStops.Add Position:=CentimetersToPoints(3.14)
.TabStops.Add Position:=CentimetersToPoints(10)
.TabStops.Add Position:=CentimetersToPoints(11)
End With
For k = 0 To 10
With doc.Paragraphs(i)
.Range.InsertAfter "testState" & vbTab & CStr(doc.Paragraphs(i).Range.ListFormat.CountNumberedItems) & vbTab & CStr(doc.Paragraphs.Count)
.Range.InsertParagraphAfter
End With
i = i + 1
Next
i = doc.Paragraphs.Count
With doc.Paragraphs(i)
.Range.ListFormat.ApplyBulletDefault
.TabStops.ClearAll
.Outdent
.Outdent
End With
Next
i = doc.Paragraphs.Count
doc.Paragraphs(i).Range.InsertParagraphAfter
i = i + 1
End Sub
Basically this code just prints n numbers of lines with the specific format.
Bullet list
Indented
and TabStops
(source: lans-msp.de)
The Code works perfectly for an arbitrary number of lines, but then at some point Word just stops applying the TabStops.
I know that if I wouldn't reset the format every 10 lines, the code would work seemingly forever (really?!?). But the every 10 line brake is a must.
The exact line number where everything breaks down is dependent on the amount of RAM. On my work computer with 1GB it only works until about line 800(as you can see). My computer at home with 4GB didn't show this behaviour. But I'm sure it would have shown it as well if I had it let run long enough, because in my production code(which is a bit more complex) my home computer shows the problem as well.
Is this some kind of memory leak or something? What did I do wrong? Is maybe, god-forbid, VBA itself the culprit here?
Try to apply the formatting using a defined style. See if that makes a difference.
You might try turning automatic pagination off while adding the lines, to see if that helps.
Application.Options.Pagination = False