Private Function lang_array(ByVal temp As Double) As Double
'This program call the subroutine langmuir to calculate langmuir constants
'of each molecule for the small cage and for the large cage
Dim molenum As Integer = 1 ' Number of molecular species
Dim sigma(10) As Double ' value of sigma for each species
sigma(0) = 0.00000000030197
Dim radius(10) As Double ' value of core radius for each species
radius(0) = 0.000000000072
Dim edep_div_k(10) As Double ' value of energy depth/k for each species
edep_div_k(0) = 171.3
Dim z_small As Double = 20 ' coordination number for small cage
Dim z_large As Double = 24 'coordination number for large cage
Dim r_small As Double = 0.000000000391 ' radius of small cage
Dim r_large As Double = 0.000000000433 ' radius of large cage
Dim n_small As Double = 1.0 / 23.0 'number of small cage per one water molecule
Dim n_large As Double = 3.0 / 23.0 'number of large cage per one water molecule
'In langmuir constant array c[k][i], suffix k changes with molecular species
' and suffix i changes with cavity type
'In suffix i, 0 indicates small cavity and 1 indicates large cavity.
Dim c1, c2, c3, c4, c5 As Double
Dim c(2, 2) As Double
Dim k As Integer
For k = 0 To molenum
c1 = z_small
c2 = r_small
c3 = sigma(k)
c4 = radius(k)
c5 = edep_div_k(k)
c(k, 0) = langmuir(temp, c1, c2, c3, c4, c5)
Next
' Calculate langmuir constant for large cavity
For k = 0 To molenum
c1 = z_large
c2 = r_large
c3 = sigma(k)
c4 = radius(k)
c5 = edep_div_k(k)
c(k, 1) = langmuir(temp, c1, c2, c3, c4, c5)
Next
**Return (c)**
End Function
' All I am trying to return the value of array (c(k,0) & c(k,1)) but I unable to do that. Can you help please
change the signature to:
Private Function lang_array(ByVal temp As Double) As Double(,)
should work then
Related
I´m currently working on a small tool for powerpoint to make certain processes easier and one of them is to create a gradient with 2 stops and then extract the colors inbetween so that I can simply create a gradient in powerpoint on a shape, select it, choose how many colors should be generated out of the gradient and then create a group of shapes with the individual colors.
However creating the shapes with the colors is not an issue so I would simply like to know whether or not there is any way to extract the colors as described and perhaps how I would achieve it.
Thanks in advance
(Edit : I was able to resolve the issue myself. The code is attached in my answer)
Alright, I was able to find a solution myself by breaking down both colors into the respective values and then increase/decrease each value by a percentage of the difference between both colors. I attached the code for anyone interested.
Sub extractGradient()
Dim sld As Slide
Dim nShape As shape
Dim c1, c2, r1, g1, b1, r2, g2, b2, rDiff, gDiff, bDiff, cR, cG, cB As Long
Dim range As Integer
Dim colors As Collection
Set sld = Application.ActiveWindow.View.Slide
Set colors = New Collection
range = 1000
With ActiveWindow.Selection.ShapeRange(1).Fill.ForeColor
c1 = .RGB
r1 = .RGB Mod 256
g1 = .RGB \ 256 Mod 256
b1 = .RGB \ 65536 Mod 256
End With
With ActiveWindow.Selection.ShapeRange(2).Fill.ForeColor
c2 = .RGB
r2 = .RGB Mod 256
g2 = .RGB \ 256 Mod 256
b2 = .RGB \ 65536 Mod 256
End With
rDiff = Abs(r2 - r1)
gDiff = Abs(g2 - g1)
bDiff = Abs(b2 - b1)
colors.Add c1
For i = 1 To range - 1
cR = IIf(r1 > r2, r1 - (rDiff / range * i), r1 + (rDiff / range * i))
cG = IIf(g1 > g2, g1 - (gDiff / range * i), g1 + (gDiff / range * i))
cB = IIf(b1 > b2, b1 - (bDiff / range * i), b1 + (bDiff / range * i))
colors.Add (RGB(cR, cG, cB))
Next i
colors.Add c2
count = 0
For Each c In colors
Set nShape = sld.Shapes.AddShape(Type:=msoShapeRectangle, left:=(1 * count), top:=50, width:=1, height:=50)
nShape.Fill.ForeColor.RGB = c
nShape.Line.Visible = msoFalse
count = count + 1
Next c
End Sub
The following code raises a System.OverflowException
Dim b1 As Byte = 13
Dim b2 As Byte = 26
Dim b3 As Byte = 125
Dim b4 As Byte = 225
Dim i As Integer = (b1 + b2 + b3 + b4) \ 2
Why does this happen?
The value(s) doesn't get converted into an Integer until you assign it to the variable. This means that up until, and including, the \ 2 part everything is still of type Byte.
To make this work you've got to convert at least the first variable into an Integer, so that additional numbers can be added to it and go beyond 255.
Dim i As Integer = (CType(b1, Integer) + b2 + b3 + b4) \ 2
Online test: https://dotnetfiddle.net/Lxmx2S
Be aware that since this respects the order of mathematical operations, you must convert all the instances of too small types that are calculated before the others. For instance if you changed your operation to this:
Dim i As Integer = (CType(b1, Integer) + b2 * b3 + b4) \ 2
It would also throw an error because b2 * b3 is calculated before b1 + b2, and thus you would have to change it to:
Dim i As Integer = (CType(b1, Integer) + CType(b2, Integer) * b3 + b4) \ 2
Purpose: Take two fractions inputted on another platform and by user and evaluate them with IsNothing. If they aren't integers or strings that can be converted, run through Frac2Num (attached, I know this works, not the focus. Code created by Jeff Arms of Arecon Data).
It then checks to see if value A2 is greater than one. If so, then performs the math function (A2/2) - (A1/2) and then returns that value. Else, it returns 0.
So far I have only been able to return 0, so something with how it is reading the values or how its returning the value after the equation is messing it up, I think.
Main function:
Public Function MyFunction(ByVal A1 As String, ByVal A2 As String) As Integer
MyFunction= 0
Try
Dim B1 As Double
Dim B2 As Double
If IsNothing(A1) Then Return 0 'If the user provides no values, return 0.
If IsNothing(A2) Then Return 0 'If the user provides no values, return 0.
If IsNumeric(A1) = True Then
B1 = CDbl(A1)
Else
B1 = Frac2Num(A1)
End If 'If the value is an integer or convertible string, convert value to double. If not, run through Frac2Num function.
If IsNumeric(A2) = True Then
B2 = CDbl(A2)
Else
B2 = Frac2Num(A2)
End If
If A2 > 1 Then
MyFunction= (A2 / 2) - (A1 / 2)
Return MyFunction
Else MyFunction= 0
End If 'If A2 is greater than one, then MyFunction = value created by equation.
Catch ex As Exception
End Try
Frac2Num function:
Function Frac2Num(ByVal X As String) As Double
Dim P As Integer, N As Double, Num As Double, Den As Double
X = Trim$(X)
P = InStr(X, "/")
If P = 0 Then
N = Val(X)
Else
Den = Val(Mid$(X, P + 1))
If Den = 0 Then Error 11 ' Divide by zero
X = Trim$(Left$(X, P - 1))
P = InStr(X, " ")
If P = 0 Then
Num = Val(X)
Else
Num = Val(Mid$(X, P + 1))
N = Val(Left$(X, P - 1))
End If
End If
If Den <> 0 Then
N = N + Num / Den
End If
Frac2Num = N
End Function
Returning:
Sub Main()
Dim result As Integer
result = MyFunction("8 1/2", "8 5/8") 'Function called with example values.
Console.WriteLine(result)
Console.ReadLine()
End Sub
First of all, in the end of your code you are trying to convert a fraction string directly to a number, witch is causing your code to generate an exception and go to the Catch block
change it to
'You are using A1 and A2, change it to B1 and B#
If B2 > 1 Then
MyFunction = (B2 * 1.0 / 2) - (B1 * 1.0 / 2)
Return MyFunction
Else : MyFunction = 0
End If
also, you are returning an integer and assigning the result to an integer. Even if the result was computed properly in your example case it will not be evaluated correctly. Changing it to Double should solve it.
Public Function MyFunction(ByVal A1 As String, ByVal A2 As String) As Double
and
Dim result As Double
result = MyFunction("8 1/2", "8 5/8")
I'm making a Poker game for myself and I have the rest of the code but I can't seem to find out how to search seven cards to see if there is a straight(5 field cards and 2 cards in the player's hand), the cards are numbers (1 being ace, 2 being 2, etc.. 11 being jack, 12 being queen etc.) I have this so far:
Function isStraight(ByVal Player As String)
Dim h1, h2, h3, h4, h5 As String
h1 = 0
h2 = 1
h3 = 2
h4 = 3
h5 = 4
Dim z1, z2 As String
If Player = "P1" Then
z1 = P1Card1
z2 = P1Card2
ElseIf Player = "P2" Then
z1 = P2Card1
z2 = P2Card2
End If
Dim cntr As Integer = 0
Do
cntr = cntr + 1
h1 = h1 + 1
h2 = h2 + 1
h3 = h3 + 1
h4 = h4 + 1
h5 = h5 + 1
If A(FC1, FC2, FC3, FC4, FC5) Or A(FC5, FC1, FC2, FC3, FC4) Or A(FC4, FC5, FC1, FC2, FC3) Or A(FC3, FC4, FC5, FC1, FC2) Then
End If
Loop
Thanks in advance!
If you are using numeric values for the cards, you should use Integer rather than String for the data type. Think about designing your methods to work this way:
'Accept only cards, use a specific Boolean return type
'IEnumerable(Of Integer) will still allow you to pass arrays to this function
Function isStraight(ByVal River As IEnumerable(Of Integer), ByVal Hand As IEnumerable(Of Integer)) As Boolean
'Make sure Option Infer is On
Dim Cards = River.Concat(Hand)
'Ace can be high or low, so add a high value to the list if you have any aces
If Cards.Contains(1) Then Cards = Cards.Concat(New Integer() {14})
'It will be MUCH easier to find consecutive cards if they are sorted in order to start with, and we don't care about pairs so limit us to unique number cards
'The "Function(c) c" here is called a Lambda Expression. This lambda expression tells the OrderBy() method to compare items in the collection for sorting purposes using simple ascending order.
Cards = Cards.OrderBy(Function(c) c ).Distinct()
'If this count gets to five consecutive cards, we have a straight
Dim StraightCount As Integer
'Initialize to a card that can never be consecutive, so first time through the loop will reset the counter
Dim PreviousCard Integer = -1
For Each card As Integer In Cards
'If the prior card is one less than current card, they are consecutive: add 1 to StraightCount
'If they are not consecutive, set back to 1 (this is the 1st card in a new potential straight)
StraightCount = If(card - PreviousCard = 1, StraightCount + 1, 1)
'If we reach 5, don't bother finishing: Return True immediately
If StraightCount = 5 Then Return True
'Set this card as the prior card for the next loop iteration
PreviousCard = card
Next card
'Did not find a straight
Return False
End Function
this application for computing the gcd by using extended euclidean but it give me just the value for first iteration but i need the final values of x2 y2 a
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim x1 As Integer
Dim x2 As Integer
Dim y1 As Integer
Dim y2 As Integer
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim temp As Integer
a = CInt(TextBox1.Text)
Dim b As Integer
b = CInt(TextBox2.Text)
Dim q As Integer
x1 = 0
y1 = 1
x2 = 1
y2 = 0
If b > a Then
temp = a
a = b
b = temp
End If
Do While (b <> 0)
q = Math.Floor(a / b)
a = b
b = a Mod b
x = x2 - q * x1
x2 = x1
y = y2 - q * y1
y2 = y1
x1 = x
y1 = y
Loop
MessageBox.Show("the final value of x2 is " & CStr(x2) & "the final value of y2 is " & CStr(y2) & "the GCD is " & CStr(a), " the result ")
End Sub
Here's your problem:
a = b
b = a Mod b
In the second statement, a is already equal to b, so a Mod b is always zero.
'Euclid's algorithm
'code assumes that you are looking for the GCD of the
'values entered into TextBox1 and TextBox2
Dim dividend As Long
Dim divisor As Long
Dim quotient As Long
Dim remainder As Long
If Long.TryParse(TextBox1.Text, dividend) Then
If Long.TryParse(TextBox2.Text, divisor) Then
'place in correct order
quotient = Math.Max(dividend, divisor) 'determine max number
remainder = Math.Min(dividend, divisor) 'determine min number
dividend = quotient 'max is dividend
divisor = remainder 'min is divisor
Do
quotient = Math.DivRem(dividend, divisor, remainder) 'do the division
'set up for next divide
dividend = divisor 'dividend is previous divisor. if remainder is zero then dividend = GCD
divisor = remainder 'divisor is previous remainder
Loop While remainder <> 0 'loop until the remainder is zero
Label1.Text = dividend.ToString("n0")
End If
End If