|
A_Griffin wrote: something not quite right in the editor here, CP - NB I have to add a \
Most likely because you have use language neutral <pre> tags round your code block. Use the code button to select the appropriate programming language.
|
|
|
|
|
|
some one please help me in designing database tables to record financial transactions in a central university in india. we are using double entry system. database shall be used for in-house development team.
M KAMIL
|
|
|
|
|
Have a look through these data structures
Never underestimate the power of human stupidity
RAH
|
|
|
|
|
Hi. I am developing a staff information form. How to retrieve staff information from Access Database after staff login? Which mean who login then it will display his information at second form.
Examples, staff A login, at the next form it will display staff A details. And staff B login it will display Staff B information.
|
|
|
|
|
1. Create a connection to the database.
2. Run a query against the correct tables.
3. Read the results of the query.
4. Display the results in a form.
The difficult we do right away...
...the impossible takes slightly longer.
|
|
|
|
|
with rsOrder
.ActiveConnection = Conn
.ActiveConnection = sConnString
.CursorLocation = (adUseClient)
.CursorType = (adOpenStatic)
.LockType = (adLockBatchOptimistic)
'Conn.Open()
Conn.Close()
End With
If rsOrder.EOF Then (error at this line I dont know how I can use EOF in vb.net for windows application)
ValidateOrderID = Nothing
iCount = 0
Else
ValidateOrderID = rsOrder
iCount = 1
End If
|
|
|
|
|
If you're moving to .NET, you should be looking to replace the ancient ADODB with the built-in ADO.NET[^] instead. It will take some work to upgrade, but it will make things a lot easier in the long run.
As to the error, I suspect it might have something to do with the fact that you've closed the database connection before you try to read the query results.
"These people looked deep within my soul and assigned me a number based on the order in which I joined."
- Homer
|
|
|
|
|
I check the connection but is not closed. I tried to avoid COM exception but did not get any success. I added few References also according to google search but nothing is working.
|
|
|
|
|
|
I need to specify a variable or text box in a SQL where clause. I am having a very difficult time replacing ‘IN PRODUCTION’ shown in the below code with a variable or test box. My desire is to use a variable, but is that is not possible a text box will do.
Below is the section of code with the WHERE clause. The query currently returns every item perfectly where the Status equals "IN PRODUCTION" What I would like to do is use a variable so that the same query can be used based on user selection.
FROM tbl_Switches WHERE Status = 'IN PRODUCTION' ORDER BY Node", cs)
|
|
|
|
|
What you need to look at is the SQL Parameters, to support parameterized queries. That way you can generate the SQL queries that look like this,
SELECT * FROM tble_Switches WHERE Status = @p1 ORDER BY Node
Now you will pass a parameter @p1, which comes from a user input (combobox, or anything of your choice) and then you will finally get the records for that status.
Using SQLParameters with VB.NET/C#
SqlCommand.Parameters Property (System.Data.SqlClient)
Never try to build up a query by concatenation. You will expose the query to SQL Injection and that will only hurt; badly. SQL injection - Wikipedia.
The sh*t I complain about
It's like there ain't a cloud in the sky and it's raining out - Eminem
~! Firewall !~
|
|
|
|
|
how can i add user-agent to vlc player when playing rtsp server.
Set vlcControl = Controls.Add("VideoLAN.VLCPlugin.2", "vlcControl" & i)
vlcControl.Height = 6000
vlcControl.Width = 5000
x = Int(Rnd * 60)
Set vlcPlayer = vlcControl.object
vlcControl.Visible = True
ReqVideo = Text2.Text
vlcControl.object.playlist.Add ((ReqVideo))
vlcControl.object.playlist.play
vlcPlayer.audio.volume = 100
i will really appreciate it if anybody can tell me how i can add custom user-agents to this.
|
|
|
|
|
Hi,
In VB forms, I want to do a search of an XLSX for a part number and have the cell line shown in a textbox.
So basically I will make a textbox, type in the part number, click the search button, it will search the xlsx for the part number and show the part number in another textbox. I will probably expand on this showing the description of the part but for now I am just trying to do this (Not a message box)
Similar to the code I provided.
I know the code just reads the line given, but it is simple and that is what I am looking for, for the search.
I have been searching for this method and can't seem to find it.
(I keep seeing datagrid and datasource)
Thank-you
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Dim APP As New Excel.Application
Dim worksheet As Excel.Worksheet
Dim workbook As Excel.Workbook
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
workbook = APP.Workbooks.Open("C:\MAIN PARTS LIST\temp.xlsx")
worksheet = workbook.Worksheets("sheet1")
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
TextBox1.Text = worksheet.Cells(1, 1).Value
TextBox2.Text = worksheet.Cells(1, 2).Value
If TextBox1.Text = ("RENT") Then
TextBox4.Text = "TADA"
Else
TextBox4.Text = "NOPE"
End If
workbook.Close()
APP.Quit()
End Sub
Private Sub TextBox1_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBox1.TextChanged
End Sub
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs)
End Sub
Private Sub TextBox4_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBox4.TextChanged
End Sub
Private Sub TextBox2_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBox2.TextChanged
End Sub
End Class
|
|
|
|
|
You just need to create a loop that tests the content of each cell in the range to see if it contains the value you are looking for.
|
|
|
|
|
If the data is tructured into regular columns - e.g column 1 is part number, column 2 is description etc, you will get much better performance if you open a data connection to the worksheet and use a query to retrieve the data.
=========================================================
I'm an optoholic - my glass is always half full of vodka.
=========================================================
|
|
|
|
|
Thank-you both, but code examples would help me more understand
|
|
|
|
|
how do i link opengl in vb2017 ?
i have some experiance whit opengl in freebasic
|
|
|
|
|
this is a try at GP
i have this working in liberty/just basic
GP what :
from tabel or plot to formula
GP how :
1 : write some random formula's
2 : calculate output of formula's
3 : sort formula's on error
4 : mix the best in child's
5 : mutate some child's
6 : if best.error > whised and generation < max then goto 2
i got so far as this :
[code]
'' bluatigro 4 sept 2017
'' genetic programming module
Module Module1
Public Const gp_add As String = "[ + # # ]"
Public Const gp_sub As String = "[ - # # ]"
Public Const gp_mul As String = "[ * # # ]"
Public Const gp_div As String = "[ / # # ]"
Public Const gp_sqrt As String = "[ sqrt # # ]"
Public Class GeneProg
Private genes As Collection
Private Enum numMode As Integer
OnlyInputs = 0
AsDouble = 1
AsInteger = 2
End Enum
Private gpstate As numMode
Public Sub New()
gpstate = numMode.OnlyInputs
End Sub
Public Sub use(gen As String)
genes.Add(gen)
End Sub
Public Function run(prog As String) As String
While InStr(prog, "]") <> 0
Dim eind As Int16 = InStr(prog, "]")
Dim begin As Int16 = eind
While Mid(prog, begin, 1) <> "["
begin -= 1
End While
Dim part As String = Mid(prog _
, begin, eind - begin + 1)
Dim q() As String = Split(part)
Dim a As Double = Val(q(2))
Dim b As Double = Val(q(3))
Dim ab As Double
Try
Select Case q(1)
Case "+"
ab = a + b
Case "-"
ab = a - b
Case "*"
ab = a * b
Case "/"
If b = 0 Then
Return "error"
Else
ab = a / b
End If
Case "sqrt"
ab = Math.Sqrt(a)
Case Else
Return "error"
End Select
Catch ex As Exception
Return "error"
End Try
Dim l As String = Left(prog, begin - 1)
Dim r As String = Right(prog _
, Len(prog) - eind)
prog = l + Str(ab) + r
End While
Return prog
End Function
Public Function mix(pa As String, pb As String) As String
Dim begina As Int16
Dim einda As Int16
Dim beginb As Int16
Dim eindb As Int16
Dim cola As New Collection
Dim colb As New Collection
If Rnd() < 0.5 Then
Dim q As String = pa
pa = pb
pb = q
End If
Dim i As Integer
For i = 1 To Len(pa)
If Mid(pa, i, 1) = "[" Then
cola.Add(i)
End If
Next
For i = 1 To Len(pb)
If Mid(pb, i, 1) = "[" Then
colb.Add(i)
End If
Next
begina = cola.Item(CInt(Rnd() * cola.Count()))
einda = begina
Dim fl As Int16 = 0
While fl > 0
einda += 1
If Mid(pa, einda, 1) = "]" Then fl -= 1
If Mid(pa, einda, 1) = "[" Then fl += 1
End While
beginb = colb.Item(CInt(Rnd() * colb.Count()))
fl = 0
While fl > 0
eindb += 1
If Mid(pb, eindb, 1) = "]" Then fl -= 1
If Mid(pb, eindb, 1) = "[" Then fl += 1
End While
Return Left(pa, begina)
End Function
End Class
Sub Main()
Dim proga As String = "[ + 7 [ - 2 3 ] ]"
Dim progb As String = "[ * 4 [ / 5 6 ] ]"
Dim GP As New GeneProg()
Console.WriteLine("[ test run ]")
Console.WriteLine("prog a = " & proga)
Console.WriteLine("prog b = " & progb)
Console.WriteLine("run a = " & GP.run(proga))
Console.WriteLine("check a = " _
& 7.0 + (2.0 - 3.0))
Console.WriteLine("run b = " & GP.run(progb))
Console.WriteLine("check b =" _
& 4.0 * (5.0 / 6.0))
Console.WriteLine("[ push return ]")
Console.ReadKey()
Console.WriteLine("[ test mix ]")
Dim i As Int16
For i = 0 To 5
Dim c As String = GP.mix(proga, progb)
Console.WriteLine("mix a b = c = " & c)
Console.WriteLine("run c = " & c)
Next
Console.WriteLine("[ push return ]")
Console.ReadKey()
End Sub
End Module
[/code]
error :
run b <> check b
mix frezes my pc
|
|
|
|
|
What you have tried is actually *NOT* a genetic algorithm (GA). 
Any genetic algorithm has the following formulation:
0. Generate random values (chromosomes) population;
1. Select a random pair of chromosomes;
2. Recombine chromosomes using cross-over genetic operator;
3. Check if the new child chromosomes are the fittest ones by using objective fitness function;
4. If at least one chromosome in a pair is the fittest, appended it to the array of valid solutions;
4. Mutate those new child chromosomes;
5. Go to step 1 until you've selected N / 2 - chromosomes, where N - the size of population;
6. Proceed with steps 1-5 until you've produced the desired number of fittest solutions;
This is the easies variant of the a classical genetic algorithm.
If you want implement a genetic algorithm, please rework it the way as just I have explained.
And if you've got any questions about how to rework it, just write me in the reply to my post.
|
|
|
|
|
i aready knew that
i wrote some GA's in the past
GP is somthing else
i already have GP/GA working in liberty/just basic
i m just not knowing how to do it in vb2017 jet
i have some detail's wrong
|
|
|
|
|
As far as I can understand you want just to migrate your code into VB.NET 2017 ?
At the present time I'm just a bit busy, but will help you out later on.
I'll post the ready code as the reply to your message today, but a little bit later.
|
|
|
|
|
Module Module1
Public Const gp_add As String = "[ + # # ]"
Public Const gp_sub As String = "[ - # # ]"
Public Const gp_mul As String = "[ * # # ]"
Public Const gp_div As String = "[ / # # ]"
Public Const gp_sqrt As String = "[ sqrt # # ]"
Public Class GeneProg
Private genes As Collection
Private Enum numMode As Integer
OnlyInputs = 0
AsDouble = 1
AsInteger = 2
End Enum
Private gpstate As numMode
Public Sub New()
gpstate = numMode.OnlyInputs
End Sub
Public Sub use(gen As String)
genes.Add(gen)
End Sub
Public Function run(prog As String) As String
While InStr(prog, "]") <> 0
Dim eind As Int16 = InStr(prog, "]")
Dim begin As Int16 = eind
While Mid(prog, begin, 1) <> "["
begin -= 1
End While
Dim part As String = Mid(prog _
, begin, eind - begin + 1)
Dim q() As String = Split(part)
Dim a As Double = Val(q(2))
Dim b As Double = Val(q(3))
Dim ab As Double
Try
Select Case q(1)
Case "+"
ab = a + b
Case "-"
ab = a - b
Case "*"
ab = a * b
Case "/"
If b = 0 Then
Return "error"
Else
ab = a / b
End If
Case "sqrt"
ab = Math.Sqrt(a)
Case Else
Return "error"
End Select
Catch ex As Exception
Return "error"
End Try
Dim l As String = Left(prog, begin - 1)
Dim r As String = Right(prog _
, Len(prog) - eind)
prog = l + Str(ab) + r
End While
Return prog
End Function
Public Function mix(pa As String, pb As String) As String
Dim begina As Int16
Dim einda As Int16
Dim beginb As Int16
Dim eindb As Int16
Dim random As Int16
Dim cola As New Collection
Dim colb As New Collection
If Rnd() < 0.5 Then
Dim q As String = pa
pa = pb
pb = q
End If
Dim i As Integer
For i = 1 To Len(pa)
If Mid(pa, i, 1) = "[" Then
cola.Add(i)
End If
Next
For i = 1 To Len(pb)
If Mid(pb, i, 1) = "[" Then
colb.Add(i)
End If
Next
random = CInt(Rnd()) + 1
If random > cola.Count() Then
random = cola.Count() - 1
End If
begina = cola.Item(random)
einda = begina
Dim fl As Int16 = 0
While fl > 0
einda += 1
If Mid(pa, einda, 1) = "]" Then fl -= 1
If Mid(pa, einda, 1) = "[" Then fl += 1
End While
random = CInt(Rnd()) + 1
If random > cola.Count() Then
random = cola.Count() - 1
End If
beginb = colb.Item(random)
fl = 0
While fl > 0
eindb += 1
If Mid(pb, eindb, 1) = "]" Then fl -= 1
If Mid(pb, eindb, 1) = "[" Then fl += 1
End While
Return Left(pa, begina)
End Function
End Class
Sub Main()
Dim proga As String = "[ + 7 [ - 2 3 ] ]"
Dim progb As String = "[ * 4 [ / 5 6 ] ]"
Dim GP As New GeneProg()
Console.WriteLine("[ test run ]")
Console.WriteLine("prog a = " & proga)
Console.WriteLine("prog b = " & progb)
Console.WriteLine("run a = " & GP.run(proga))
Console.WriteLine("check a = " _
& 7.0 + (2.0 - 3.0))
Console.WriteLine("run b = " & GP.run(progb))
Console.WriteLine("check b =" _
& 4.0 * (5.0 / 6.0))
Console.WriteLine("[ push return ]")
Console.ReadKey()
Console.WriteLine("[ test mix ]")
Dim i As Int16
For i = 0 To 5
Dim c As String = GP.mix(proga, progb)
Console.WriteLine("mix a b = c = " & c)
Console.WriteLine("run c = " & c)
Next
Console.WriteLine("[ push return ]")
Console.ReadKey()
End Sub
End Module
|
|
|
|
|
Here's the corrected code in VB.NET 2017. I've made some small improvements of code to avoid the number of runtime errors. I actually can't figure out what particular algorithm you're about to implement. So, if you want me to delve into your code more deep, please let me know about the algorithm.
Are you actually trying to develop a code that performs a reverse 'polish notation' to parse math expressions ?
|
|
|
|
|
the problem whit basic is that the
operant is not on the same place every time
parsing is a lot easyer that way
do you have use for the liberty/just code
than we wil have translated it earlyer ?
'' bluatigro 4 sept 2017
'' genetic programming module
Module Module1
Public Const gp_add As String = "[ + # # ]"
Public Const gp_sub As String = "[ - # # ]"
Public Const gp_mul As String = "[ * # # ]"
Public Const gp_div As String = "[ / # # ]"
Public Const gp_sqrt As String = "[ sqrt # # ]"
Public Class GeneProg
Private genes As Collection
Private Enum numMode As Integer
OnlyInputs = 0
AsDouble = 1
AsInteger = 2
End Enum
Private gpstate As numMode
Public Sub New()
gpstate = numMode.OnlyInputs
End Sub
Public Sub use(gen As String)
genes.Add(gen)
End Sub
Public Function run(prog As String) As String
While InStr(prog, "]") <> 0
Dim eind As Int16 = InStr(prog, "]")
Dim bgin As Int16 = eind
While Mid(prog, bgin, 1) <> "["
bgin -= 1
End While
Dim part As String = Mid(prog _
, bgin, eind - bgin + 1)
Dim q() As String = Split(part)
Dim a As Double = Val(q(2))
Dim b As Double = Val(q(3))
Dim ab As Double
Try
Select Case q(1)
Case "+"
ab = a + b
Case "-"
ab = a - b
Case "*"
ab = a * b
Case "/"
If b = 0 Then
Return "error"
Else
ab = a / b
End If
Case "sqrt"
ab = Math.Sqrt(a)
Case Else
Return "error"
End Select
Catch ex As Exception
Return "error"
End Try
Dim l As String = Left(prog, bgin - 1)
Dim r As String = Right(prog _
, Len(prog) - eind)
prog = l + Str(ab) + r
End While
Return prog
End Function
Public Function mix(pa As String, pb As String) As String
Dim begina As Int16
Dim einda As Int16
Dim beginb As Int16
Dim eindb As Int16
Dim cola As New Collection
Dim colb As New Collection
If Rnd() < 0.5 Then
Dim q As String = pa
pa = pb
pb = q
End If
Dim i As Integer
For i = 1 To Len(pa)
If Mid(pa, i, 1) = "[" Then
cola.Add(i)
End If
Next
For i = 1 To Len(pb)
If Mid(pb, i, 1) = "[" Then
colb.Add(i)
End If
Next
begina = cola.Item(random)
einda = begina
Dim fl As Int16 = 0
While fl > 0
einda += 1
If Mid(pa, einda, 1) = "]" Then fl -= 1
If Mid(pa, einda, 1) = "[" Then fl += 1
End While
beginb = colb.Item(random)
fl = 0
While fl > 0
eindb += 1
If Mid(pb, eindb, 1) = "]" Then fl -= 1
If Mid(pb, eindb, 1) = "[" Then fl += 1
End While
dim l as string = left(pa, begina - 1)
dim m as string = mid(pb ,beginb ,eindb - beginb)
dim r as string = right(pa ,len(pa) - eindea + 1 )
Return l + m + r
End Function
End Class
Sub Main()
Dim proga As String = "[ + 7 [ - 2 3 ] ]"
Dim progb As String = "[ * 4 [ / 5 6 ] ]"
Dim GP As New GeneProg()
Console.WriteLine("[ test run ]")
Console.WriteLine("prog a = " & proga)
Console.WriteLine("prog b = " & progb)
Console.WriteLine("run a = " & GP.run(proga))
Console.WriteLine("check a = " _
& 7.0 + (2.0 - 3.0))
Console.WriteLine("run b = " & GP.run(progb))
Console.WriteLine("check b =" _
& 4.0 * (5.0 / 6.0))
Console.WriteLine("[ push return ]")
Console.ReadKey()
Console.WriteLine("[ test mix ]")
Dim i As Int16
For i = 0 To 5
Dim c As String = GP.mix(proga, progb)
Console.WriteLine("mix a b = c = " & c)
Console.WriteLine("run c = " & c)
Next
Console.WriteLine("[ push return ]")
Console.ReadKey()
End Sub
End Module
modified 7-Sep-17 4:33am.
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
