I have a function which returns average RGB value of a region drawn on a picturebox in VB.net.
The code is as below:
Function GetAvgRGB(ByVal CrdY As Integer, ByVal CrdX As Integer, ByVal Region As System.Drawing.Rectangle) As Tuple(Of Integer, Integer, Integer)
Dim totalR As UInteger
Dim totalG As UInteger
Dim totalB As UInteger
For y As Integer = CrdY - (Region.Height / 2) To CrdY + ((Region.Height / 2) - 1)
For x As Integer = CrdX - (Region.Width / 2) To CrdX + ((Region.Width / 2) - 1)
totalR += myBitmap.GetPixel(x, y).R
totalG += myBitmap.GetPixel(x, y).G
totalB += myBitmap.GetPixel(x, y).B
Next
Next
Dim pixelCount As Integer = Region.Width * Region.Height
Dim averageR As Integer = CType(totalR \ pixelCount, Integer)
Dim averageG As Integer = CType(totalG \ pixelCount, Integer)
Dim averageB As Integer = CType(totalB \ pixelCount, Integer)
Return Tuple.Create(averageR, averageG, averageB)
End Function
My query is how do I separate the values of R, G & B returned by this function..
Use the Item property.
Dim myTuple = GetAvgRGB(?,?,?)
Dim r = myTuple.Item1 ' g = .Item2, b = .Item3
Related
I'm trying to implement the Traveling salesman problem algorithm in vbnet to find the fastest path that visits all points of a bidirectional and weighted matrix and how much is the cost. Can anyone help me?
I've tried several implementations, but none worked
Tried this but not working. Can someone help me?
Public Function FillGraph(lista As List(Of Cliente)) As Integer(,)
Dim graph As Integer(,) = New Integer(lista.Count, lista.Count) {}
Dim n As Integer = lista.Count
For i = 0 To lista.Count - 1
For j = 0 To lista.Count - 1
If lista.Item(i).Id = lista.Item(j).Id Then
graph(i, j) = 0
Else
graph(i, j) = GetDistanceBetweenTwoPoints(lista.Item(i).latitude, lista.Item(i).longitude, lista.Item(j).latitude, lista.Item(j).longitude)
End If
Next
Next
Return graph
End Function
Public Function findNextPermutation(ByVal data As List(Of Integer)) As Boolean
If data.Count <= 1 Then Return False
Dim last As Integer = data.Count - 2
While last >= 0
If data(last) < data(last + 1) Then Exit While
last -= 1
End While
If last < 0 Then Return False
Dim nextGreater As Integer = data.Count - 1
For i As Integer = data.Count - 1 To last + 1
If data(i) > data(last) Then
nextGreater = i
Exit For
End If
Next
data = swap(data, nextGreater, last)
data = reverse(data, last + 1, data.Count - 1)
Return True
End Function
Public Shared Function reverse(ByVal data As List(Of Integer), ByVal left As Integer, ByVal right As Integer) As List(Of Integer)
While left < right
Dim temp As Integer = data(left)
data(Math.Min(System.Threading.Interlocked.Increment(left), left - 1)) = data(right)
data(Math.Max(System.Threading.Interlocked.Decrement(right), right + 1)) = temp
End While
Return data
End Function
Public Function swap(ByVal data As List(Of Integer), ByVal left As Integer, ByVal right As Integer) As List(Of Integer)
Dim temp As Integer = data(left)
data(left) = data(right)
data(right) = temp
Return data
End Function
Private Function travllingSalesmanProblem(ByVal graph As Integer(,), ByVal s As Integer) As Integer
Dim vertex As List(Of Integer) = New List(Of Integer)()
For i As Integer = 0 To V - 1
If i <> s Then vertex.Add(i)
Next
Dim min_path As Integer = Int32.MaxValue
Do
Dim current_pathweight As Integer = 0
Dim k As Integer = s
For i As Integer = 0 To vertex.Count - 1
current_pathweight += graph(k, vertex(i))
k = vertex(i)
Next
current_pathweight += graph(k, s)
min_path = Math.Min(min_path, current_pathweight)
Loop While findNextPermutation(vertex)
routeTxt.Text = path
Return min_path
End Function
hello im trying to do this calculation : [365!/((365^x)((365-x)!))]
the problem is when i do it it doesn't give me the decimals just the integer it give me 0 or 1 because the answer is 0
Public Class Form1
Private Function fact(ByVal n As Integer) As Numerics.BigInteger
Dim Z As New Numerics.BigInteger(1)
For i As Integer = 1 To n
Z = Z * i
Next
Return Z
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim min As Integer
Dim max As Integer
Dim ranum As Integer
Dim ind() As Integer
Dim ran As New Random
Dim F365 As New Numerics.BigInteger(0)
F365 = Numerics.BigInteger.Parse("25104128675558732292929443748812027705165520269876079766872595193901106138220937419666018009000254169376172314360982328660708071123369979853445367910653872383599704355532740937678091491429440864316046925074510134847025546014098005907965541041195496105311886173373435145517193282760847755882291690213539123479186274701519396808504940722607033001246328398800550487427999876690416973437861078185344667966871511049653888130136836199010529180056125844549488648617682915826347564148990984138067809999604687488146734837340699359838791124995957584538873616661533093253551256845056046388738129702951381151861413688922986510005440943943014699244112555755279140760492764253740250410391056421979003289600000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")
min = Integer.Parse(Tmin.Text)
max = Integer.Parse(Tmax.Text)
ranum = Integer.Parse(TRan.Text)
ReDim ind(ranum)
For x As Integer = 1 To ranum
ind(x) = ran.Next(min, max + 1)
Answer.Items.Add(ind(x))
Next
Dim P(ranum) As Numerics.BigInteger
Dim facts(ranum) As Numerics.BigInteger
For x = 1 To ranum
P(x) = 365 ^ (ind(x))
facts(x) = fact(365 - ind(x))
Next
Dim phenB(ranum) As Numerics.BigInteger
Dim phen(ranum) As Double
For x = 1 To ranum
phenB(x) = (P(x) * facts(x))
phen(x) = F365 / phenB(x)
tx.Text = phen(x) (here is the aswer)
Next
End Sub
End Class
The BigInteger class does not have a function to give a non-integer result for division. However, it does have BigInteger.Log, so, using these logarithmic identities:
ln(a⋅b) = ln(a) + ln(b)
ln(a/b) = ln(a) - ln(b)
ln(a^b) = b⋅ln(a)
we can perform the calculation like this:
Function SomeCalc(n As Integer) As Double
Dim lnF365 = BigInteger.Log(fact(365))
Dim lnPower = n * Math.Log(365)
Dim lnOtherFact = BigInteger.Log(fact(365 - n))
Return Math.Exp(lnF365 - lnPower - lnOtherFact)
End Function
where fact() is a pre-calculated array:
Option Strict On
Option Infer On
' ... other code ...
Dim fact(365) As BigInteger
' ... other code ...
Private Sub CalcFacts()
Dim z = BigInteger.One
For i = 1 To 365
z *= i
fact(i) = z
Next
End Sub
You could even have an array of pre-calculated logs of the factorials, instead of an array of the factorials. It depends on if you're using them elsewhere, and if there is any need for it to go a tiny tiny bit faster:
Function SomeCalc(n As Integer) As Double
Dim lnF365 = lnFact(365)
Dim lnPower = n * Math.Log(365)
Dim lnOtherFact = lnFact(365 - n)
Return Math.Exp(lnF365 - lnPower - lnOtherFact)
End Function
and
Dim lnFact(365) As Double
' ...
Private Sub CalcLnFacts()
Dim z = BigInteger.One
For i As Integer = 1 To largestNum
z *= i
lnFact(i) = BigInteger.Log(z)
Next
End Sub
That number 365 should be a named variable - I had no idea what a sensible name for it would be.
I can find plenty of tutorials on how to use conditional formatting of tablix fields in Report Builder 3.0. However I would like a function that creates a gradient color, from black to red, which colors the text more and more red, the closer it comes to a certain number.
For example I got a column with the age of a product component in days. I want the text to be black (#000000), when the component is 0 days old. And then gradually turn into red, hitting a pure red (#FF0000) on the day it expires (could be day 30).
Can anyone provide me any information, regarding how to do that?
I ended up modifying the function from the solution linked by Alejandro.
Public Shared Function ColorDWB(ByVal Value As Decimal, ByVal MaxPositive As Decimal, ByVal Neutral As Decimal, ByVal ColStr As String) As String
'Initiate variables for Red, Green and Blue (RGB)
Dim ColVar1 As Integer
Dim ColVar2 As Integer
Dim ColVar3 As Integer
'Split the #RGB color to R, G, and B components
ColVar1=Convert.ToInt32(left(right(ColStr, 6),2),16)
ColVar2=Convert.ToInt32(left(right(ColStr, 4),2),16)
ColVar3=Convert.ToInt32(right(ColStr, 2),16)
'Find Largest Range
Dim decPosRange As Decimal = Math.Abs(MaxPositive - Neutral)
Dim iColor1 As Integer
Dim iColor2 As Integer
Dim iColor3 As Integer
Dim strColor As String
'Reduce a shade for each of the R,G,B components
iColor1 = Math.Max(0, Math.Min(ColVar1, ColVar1*(Value-Neutral)/(MaxPositive-Neutral)))
iColor2 = Math.Max(0, Math.Min(ColVar2, ColVar2*(Value-Neutral)/(MaxPositive-Neutral)))
iColor3 = Math.Max(0, Math.Min(ColVar3, ColVar3*(Value-Neutral)/(MaxPositive-Neutral)))
'Return the new color
strColor = "#" & iColor1.ToString("X2") & iColor2.ToString("X2") & iColor3.ToString("X2")
Return strColor
End Function
Like the answer before me, that article got me started but I modified to make it work better for my purposes.
Public Function HeatMap(ByVal Value As Double _
, ByVal MinVal As Double _
, ByVal MaxVal As Double _
, ByVal RValLo As Double _
, ByVal GValLo As Double _
, ByVal BValLo As Double _
, ByVal RValHi As Double _
, ByVal GValHi As Double _
, ByVal BValHi As Double _
) As String
Dim DiffPercent As Double
Dim RNew As Integer
Dim GNew As Integer
Dim BNew As Integer
Dim HeatMapColor As String
If Value = Nothing Then
RNew = 255
GNew = 255
BNew = 255
ElseIf Value <= MinVal Then
RNew = RValLo
GNew = GValLo
BNew = BValLo
ElseIf Value >= MaxVal Then
RNew = RValHi
GNew = GValHi
BNew = BValHi
Else
DiffPercent = (Value - MinVal) / (MaxVal - MinVal)
RNew = RValLo - Round((RValLo - RValHi) * DiffPercent, 0)
GNew = GValLo - Round((GValLo - GValHi) * DiffPercent, 0)
BNew = BValLo - Round((BValLo - BValHi) * DiffPercent, 0)
End If
HeatMapColor = "#" & Hex(RNew) & Hex(GNew) & Hex(BNew)
HeatMap = HeatMapColor
End Function
More info on my approach here: How to create heat map on a table in SSRS?
What is best way to force fit the columns of msflexgrid in vb6?
so, that all columns are visible and they occupies maximum width of grid!
I've tried this code but it does not properly fit last column inside the grid, can anyone suggest what could be problem?
Public Sub **FlexGrid_AutoSizeColumns (** ByRef pGrid As MSHFlexGrid, _
ByRef pForm As Form, _
Optional ByVal pIncludeHeaderRows As Boolean = True, _
Optional ByVal pAllowShrink As Boolean = True, _
Optional ByVal pMinCol As Long = 0, _
Optional ByVal pMaxCol As Long = -1, _
Optional ByVal pBorderSize As Long = 8, _
Optional fitToScreen As Boolean = False **)**
Dim lngMinCol As Long, lngMaxCol As Long, lngCurrRow As Long
Dim lngMinRow As Long, lngMaxRow As Long, lngCurrCol As Long
Dim lngMaxWidth As Long, lngCurrWidth As Long
Dim fntFormFont As StdFont
Dim totalWidth As Integer
totalWidth = 0
Set fntFormFont = New StdFont
Call CopyFont(pForm.Font, fntFormFont)
Call CopyFont(pGrid.Font, pForm.Font)
With pGrid
lngMinCol = pMinCol
lngMaxCol = IIf(pMaxCol = -1, .Cols - 1, pMaxCol)
lngMinRow = IIf(pIncludeHeaderRows, 0, .FixedRows)
lngMaxRow = .Rows - 1
For lngCurrCol = lngMinCol To lngMaxCol
lngMaxWidth = IIf(pAllowShrink, 0, pForm.ScaleX(.ColWidth(lngCurrCol), vbTwips, pForm.ScaleMode))
For lngCurrRow = lngMinRow To lngMaxRow '..find widest text (in scalemode of the form)
lngCurrWidth = pForm.TextWidth(Trim(.TextMatrix(lngCurrRow, lngCurrCol)))
If lngMaxWidth < lngCurrWidth Then lngMaxWidth = lngCurrWidth
Next lngCurrRow
lngMaxWidth = pForm.ScaleX(lngMaxWidth, pForm.ScaleMode, vbTwips)
.ColWidth(lngCurrCol) = lngMaxWidth + (pBorderSize * Screen.TwipsPerPixelX)
totalWidth = .ColWidth(lngCurrCol) + totalWidth
Next lngCurrCol
End With
Call CopyFont(fntFormFont, pForm.Font)
If fitToScreen = True Then
Dim i As Integer
Dim gridWidth As Long
gridWidth = pGrid.Width
For i = 0 To pGrid.Cols - 1
pGrid.ColWidth(i) = Int(gridWidth * pGrid.ColWidth(i) / totalWidth)
Next
End If
End Sub
One way I could think is to resize your columns (with visibility) to fit into the max width found in a column (text). The function returns either 0 or a double value. As long as the returned max column width is not zero, we may adjust the current grid column width accordingly. If zero then it remains the same.
Dim i, j, as Integer
Dim maxWidth as Double
For i = 0 to MsFlexGrid1.Rows - 1
For j = 0 to MsFlexGrid1.Cols - 1
maxWidth = maxColWidth(j)
If maxWidth > 0 then
MsFlexGrid.ColWidth(j) = maxWidth
End If
Next j
Next i
Private Function maxColWidth(coNum as Integer) as Double
Dim i, Max as Integer
Max = 0
With MsFlexGrid1
For i = .FixedRows to .Rows-1
If TextWidth(.TextMatrix(i, colNum)) > Max Then
Max = TextWidth(.TextMatrix(i, colNum))
End If
Next i
maxColWidth = Max
End With
End Function
to distribute the remaining space over the columns, divide it by the number of columns and add it to each column
'1 form with :
' 1 msflexgrid : name=MSFlexGrid1
Option Explicit
Private Sub Form_Load()
Dim intCol As Integer
'example form and grid configuration
Move 0, 0, 10000, 5000
With MSFlexGrid1
.FixedRows = 0
.FixedCols = 0
.Rows = 10
.Cols = 10
For intCol = 0 To .Cols - 1
.ColWidth(intCol) = (intCol + 1) * 107
Next intCol
End With 'MSFlexGrid1
End Sub
Private Sub Form_Resize()
MSFlexGrid1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub MSFlexGrid1_Click()
DistributeWidth
End Sub
Private Sub DistributeWidth()
Dim intCol As Integer, intColSel As Integer
Dim lngWidth As Long
Dim lngRemaining As Long
Dim lngExpand As Long
With MSFlexGrid1
intColSel = .Col 'remember selected column
.Col = 0 'select first column to ...
lngWidth = .Width - .CellLeft * 2 '... take flexgrid-borders into account
.Col = intColSel 'select column again
lngRemaining = lngWidth - InUse 'calculate the remaining space
If lngRemaining > 0 Then
lngExpand = lngRemaining \ .Cols 'distribute the remaining space over the columns
For intCol = 0 To .Cols - 1
.ColWidth(intCol) = .ColWidth(intCol) + lngExpand
Next intCol
lngExpand = lngRemaining Mod .Cols
.ColWidth(.Cols - 1) = .ColWidth(.Cols - 1) + lngExpand 'since we are working with longs, apply the remaining fraction to the last column
Else
'what to do with lack of space? Shrink columns or expand grid or nothing?
End If
End With 'MSFlexGrid1
End Sub
Private Function InUse() As Long
'calculate how much of the gridwidth is already in use by the columns
Dim intCol As Integer
Dim lngInUse As Long
With MSFlexGrid1
lngInUse = 0
For intCol = 0 To .Cols - 1
lngInUse = lngInUse + .ColWidth(intCol)
Next intCol
End With 'MSFlexGrid1
InUse = lngInUse
End Function
The above example somehow does not always fill the area completely, although i think the logic is correct and i can't see anything missing ...
i guess this gives a similar result to what you have? or is it slightly better?
What is the professional way to achieve this?
Thanks.
I've shamelessly ripped off the example from this question and converted it from C# to VB.net.
Public Function GetNthIndex(s As String, t As Char, n As Integer) As Integer
Dim count As Integer = 0
For i As Integer = 0 To s.Length - 1
If s(i) = t Then
count += 1
If count = n Then
Return i
End If
End If
Next
Return -1
End Function
Here's a way to do it with Linq.
Public Function GetNthIndex(searchString As String, charToFind As Char, n As Integer) As Integer
Dim charIndexPair = searchString.Select(Function(c,i) new with {.Character = c, .Index = i}) _
.Where(Function(x) x.Character = charToFind) _
.ElementAtOrDefault(n-1)
Return If(charIndexPair IsNot Nothing, charIndexPair.Index, -1)
End Function
Usage:
Dim searchString As String = "Assessment"
Dim index As Integer = GetNthIndex(searchString, "s", 4) 'Returns 5
My Version of Andew's but I believe this takes into account if the first character is the character you are looking for
Public Function GetNthIndexStringFunc(s As String, t As String, n As Integer) As Integer
Dim newFound As Integer = -1
For i As Integer = 1 To n
newFound = s.IndexOf(t, newFound + 1)
If newFound = -1 Then
Return newFound
End If
Next
Return newFound
End Function
If you're going for faster:
Public Function NthIndexOf(s As String, c As Char, n As Integer) As Integer
Dim i As Integer = -1
Dim count As Integer = 0
While count < n AndAlso i >= 0
i = s.IndexOf(c, i + 1)
count += 1
End While
Return i
End Function
Although it is slightly slower than Mike C's answer if you're looking for the nth "a" in a long string of "a"s (for example).
Edit: adjusted following spacemonkeys' comment.