HalVisionX Beta

[Data]

Hi Art, I am running a new install of XP media center 2005
not Vista.

I can successfully run Microsoft Visual Basic 2008 Express Edition so I believe .net3.5sp1 is installed correctly.

I would like to point out that Hal is running perfectly it’s just the halvisionx.exe that crashes on me.

[snowman]

This is the code for comparing two different pictures. It will display how closely related two pictures are. If the difference falls within a userset tolerance then it will display "MATCH" on the Textbox. If not it will display "MISSMATCH". It requires a textbox, a picturebox, and one button.


This script doesn't use EmguCV. It also used pointers instead of directly man-handling the pictures. That makes it very fast!!


Imports System.Threading.Thread
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices



Public Class Form1

Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged

End Sub

Private Sub PictureBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox1.Click

End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim img4 As New Bitmap("Picture1.bmp")
        Dim img5 As New Bitmap("Picture2.bmp")


Dim bmpData1 As BitmapData = img4.LockBits(New Rectangle(0, 0, img4.Width, img4.Height), ImageLockMode.ReadOnly, PixelFormat.Format32bppPArgb)

Dim bmpData2 As BitmapData = img5.LockBits(New Rectangle(0, 0, img5.Width, img5.Height), ImageLockMode.ReadOnly, PixelFormat.Format32bppPArgb)


        Dim bmpScan01 = bmpData1.Scan0
        Dim bmpScan02 = bmpData2.Scan0


Dim x, y, Alpha, Red, Green, Blue, Alpha2, Red2, Green2, Blue2, z, T, H, P, MPM, SAMPLE As Integer

Dim TOL As Single
z = 0
T = 0
H = 0
P = 0

        TOL = 10 '(+) or (-)%
        TOL = TOL / 100




        MPM = 50 '% Minimun Percentage Matched
        SAMPLE = 10000

For y = 0 To bmpData1.Width

     For x = 0 To bmpData1.Height

Try

Blue = Marshal.ReadByte(bmpScan01, (y * bmpData1.Stride) + (x * 4)) 'Alpha
Green = Marshal.ReadByte(bmpScan01, (y * bmpData1.Stride) + (x * 4) + 1) 'Red
Red = Marshal.ReadByte(bmpScan01, (y * bmpData1.Stride) + (x * 4) + 2) 'Green
Alpha = Marshal.ReadByte(bmpScan01, (y * bmpData1.Stride) + (x * 4) + 3) 'Blue

Try

Blue2 = Marshal.ReadByte(bmpScan02, (y * bmpData2.Stride) + (x * 4)) 'Alpha
Green2 = Marshal.ReadByte(bmpScan02, (y * bmpData2.Stride) + (x * 4) + 1) 'Red
Red2 = Marshal.ReadByte(bmpScan02, (y * bmpData2.Stride) + (x * 4) + 2) 'Green
Alpha2 = Marshal.ReadByte(bmpScan02, (y * bmpData2.Stride) + (x * 4) + 3) 'Blue

Catch
Exit For
End Try


z = z + 1
If z = SAMPLE Then
T = T + 1


If Blue2 > Blue - (TOL * Blue) And Blue2 < Blue + (Blue * TOL) Then H = H + 1

If Green2 > Green - (TOL * Green) And Green2 < Green + (Green * TOL) Then H = H + 1

If Red2 > Red - (TOL * Red) And Red2 < Red + (Red * TOL) Then H = H + 1

If Alpha2 > Alpha - (TOL * Alpha) And Alpha2 < Alpha + (Alpha * TOL) Then H = H + 1


z = 0
End If

Catch
Exit For
End Try

Next

Next


        H = (H / 4) 'Average total Hits
        P = (H * 100) / T 'Pecentage of Hits

        If P > MPM Then

TextBox1.AppendText("MATCH" & vbCrLf & "TotalSampleCount = " & T & vbCrLf & "Total Hits = " & H & vbCrLf & "Total Misses = " & T - H & vbCrLf & "Percentaged Matched = " & P & "%")
Beep()

        Else

TextBox1.AppendText("MISSMATCH" & vbCrLf & "TotalSampleCount = " & T & vbCrLf & "Total Hits = " & H & vbCrLf & "Total Misses = " & T - H & vbCrLf & "Percentaged Matched = " & P & "%")
Beep()

        End If




        img4.UnlockBits(bmpData1)
        img5.UnlockBits(bmpData2)

        Beep()



        PictureBox1.Image = img4


    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub
End Class

[snowman]

Below is what I've done so far in the Database class.... I have to keep perfecting it. There is allot involved.






Class MatrixDB
'***********************************************
'This class replaces all single quotes (') with a tilda (`) when adding anything to a database,
'when data is retrieved it reverses this process. This is done to keep errors from occuring.





'***********************************************

Public Function LoadDB(strMyDir, strDatabase)

objCon.Open "Provider = Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=" & strMyDir & strDatabase & ";User Id=admin;Password=;"

objDat.ActiveConnection =  "Provider = Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=" & strMyDir & strDatabase & ";User Id=admin;Password=;"

End Function

Public Function UnLoadDB()
objCon.Close
End Function
'***********************************************
'***********************************************

Public Function GetAllValues(strTable, strColumn)
e = 0

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)

Dim ACols(50)

objRec.Open "SELECT * FROM " & "[" & strTable & "]", objCon, 3, 3
objRec.MoveFirst

Do Until objRec.EOF
     e = e + 1
     Name = objRec.Fields.Item(strColumn)

     Name = Replace(Name, "`", "'", 1, -1, vbTextCompare)
     
     ACols(e) = Name
     objRec.MoveNext
Loop
objRec.close

GetAllValues = ACols

End Function
'***********************************************
'***********************************************

Public Function GetSelectValues(strTable, strColumn, strColumnCompare, strValueCompare)
e = 0

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strColumnCompare = Replace(strColumnCompare, "'", "`", 1, -1, vbTextCompare)
strValueCompare = Replace(strValueCompare, "'", "`", 1, -1, vbTextCompare)


Dim ACols(50)

objRec.Open "SELECT * FROM " & "[" & strTable & "]", objCon, 3, 3

Do Until objRec.EOF
On Error Resume Next
     Name = objRec.Fields.Item(strColumnCompare)
     Name2 = objRec.Fields.Item(strColumn)
     objRec.MoveNext
          If Name = strValueCompare Then
          e = e + 1
         
          Name2 = Replace(Name2, "`", "'", 1, -1, vbTextCompare)
         
          ACols(e) = Name2
          End If
Loop
objRec.close

GetSelectValues = ACols

End Function
'***********************************************
'***********************************************

Public Function GetAllColumns(strMyDir, strDatabase, strTable)
e = 0

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)

UnLoadDB
LoadDB strMyDir, strDatabase

Dim Acols(50)

For Each objTable In objDat.Tables
  If ObjTable.Name = strTable And ObjTable.Type = "TABLE" Then

    For Each objColumn in objTable.Columns
    e = e + 1

    Name = Replace(objColumn.Name, "`", "'", 1, -1, vbTextCompare)
   
    Acols(e) = Name
    Next

  End If
Next

GetAllColumns = Acols

End Function
'***********************************************
'***********************************************

Public Function CheckColumnExists(strMyDir, strDatabase, strTable, strColumn)
e = 0

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)

ACols = GetAllColumns(strMyDir, strDatabase, strTable)

For Each Column In ACols
   If Column = strColumn Then
   e = e + 1
   End If
Next

If e > 0 Then
CheckColumnExists = e
Else
CheckColumnExists = 0
End If

End Function
'***********************************************
'***********************************************

Public Function CheckValueExists(strTable, strColumn, strValue)
e = 0

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValue = Replace(strValue, "'", "`", 1, -1, vbTextCompare)

objRec.Open "SELECT * FROM " & "[" & strTable & "]", objCon, 3, 3

Do Until objRec.EOF
     Name = objRec.Fields.Item(strColumn)
     If InStr(1, Name, strValue, vbTextCompare) > 0 Or Name = strValue Then
     e = e + 1
     End If
     objRec.MoveNext
Loop
objRec.close

If e > 0 Then
CheckValueExists = e
Else
CheckValueExists = 0
End If
End Function
'***********************************************
'***********************************************

Public Sub CreateColumn(strTable, strColumnName, DataType)

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumnName = Replace(strColumnName, "'", "`", 1, -1, vbTextCompare)

objCon.Execute "ALTER TABLE [" & strTable & "] ADD [" & strColumnName & "] " & DataType & " NULL"
End Sub
'***********************************************
'***********************************************

Public Sub UpDateSelectValues(strTable, strColumn, strValueAdd, strColumnCompare, strValueCompare)

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValueAdd = Replace(strValueAdd, "'", "`", 1, -1, vbTextCompare)
strColumnCompare = Replace(strColumnCompare, "'", "`", 1, -1, vbTextCompare)
strValueCompare = Replace(strValueCompare, "'", "`", 1, -1, vbTextCompare)

 objCon.Execute "UPDATE [" & strTable & "] SET [" & strColumn & "] = " & "'" & strValueAdd & "'" & _
 " WHERE [" & strColumnCompare & "] = " & "'" & strValueCompare & "'"
End Sub
'***********************************************
'***********************************************

Public Sub UpDateAllValues(strTable, strColumn, strValueAdd)

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValueAdd = Replace(strValueAdd, "'", "`", 1, -1, vbTextCompare)

objCon.Execute "UPDATE [" & strTable & "] SET [" & strColumn & "] = " & "'" & strValueAdd & "'"
End Sub
'***********************************************
'***********************************************

Public Sub AddNewTable(strTableName, strNewColumn)

strTableName = Replace(strTableName, "'", "`", 1, -1, vbTextCompare)
strNewColumn = Replace(strNewColumn, "'", "`", 1, -1, vbTextCompare)

objTab.Name = strTableName
objTab.Columns.Append strNewColumn, 3
objDat.Tables.Append objTab
End Sub
'***********************************************
'***********************************************

Public Sub AddValue(strTable, strColumn, strValueAdd)

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValueAdd = Replace(strValueAdd, "'", "`", 1, -1, vbTextCompare)

 objCon.Execute "INSERT INTO " & "[" & strTable & "]" & " (" & "[" & strColumn & "]" & _
  ") VALUES (" & "'" & strValueAdd & "'" & ")"
End Sub

'***********************************************
'***********************************************
Public Sub AppendSelectValues(strTable, strColumn, strValueAppend, strColumnCompare, strValueCompare)

strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValueAppend = Replace(strValueAppend, "'", "`", 1, -1, vbTextCompare)
strColumnCompare = Replace(strColumnCompare, "'", "`", 1, -1, vbTextCompare)
strValueCompare = Replace(strValueCompare, "'", "`", 1, -1, vbTextCompare)

s = 0
ACols = GetSelectValues(strTable, strColumn, strColumnCompare, strValueCompare)

objRec.Open "SELECT * FROM " & "[" & strTable & "]", objCon, 3, 3

For Each strValue1 In ACols

strValue = strValue1 & strValueAppend

If Len(strValue) > Len(strValueAppend) Then
On Error Resume Next
objCon.Execute "UPDATE [" & strTable & "] SET [" & strColumn & "] = " & "'" & strValue & "'" & _
 " WHERE [" & strColumnCompare & "] = " & "'" & strValueCompare & "'"
 s = s + 1
End If
Next

If s = 0 Then
UpDateSelectValues strTable, strColumn, strValueAppend, strColumnCompare, strValueCompare
End If

objRec.Close

End Sub


 Private Sub Class_Initialize()

 End Sub
'***********************************************
'***********************************************

Private Sub Class_Terminate()

 End Sub

End Class

[snowman]

Here is the infamous Matrix script. All other classes I make will go in here, thus all plugins will inherit those classes.




Set fso = CreateObject("Scripting.FileSystemObject")
MyDir = Left(fso.GetAbsolutePathName("."), Len(fso.GetAbsolutePathName(".")) - Len("KittData"))
MyDirGlobal = MyDir


Set Kitt = New Matrix


'*****************************************************************************
'This is where the Kitt's Output file is Read and UserSentence is created.
'*****************************************************************************

Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = fso.OpenTextFile(MyDir & "KittData\" & "OutgoingData.txt", 1, True)

KittSentence = objTextFile.ReadLine

objTextFile.Close

UserSentence = KittSentence

'*****************************************************************************
'This is where the VBscript Plugins are added to the Matrix.
'*****************************************************************************

GetPlugins(MyDir) 'Sub-Routine



Sub GetPlugins(MyDir)

           On Error Resume Next

           Set fso = CreateObject("Scripting.FileSystemObject")
           Set objFolder = fso.GetFolder(MyDir & "KittPlugins\")

           Set colFiles = objFolder.Files
           For Each objFile In colFiles

           If Instr(1,objFile.Name,"vbs", 1) > 0 Then
           e = e + 1

                 plugins = MyDir & "KittPlugins\" & objFile.Name

                 Kitt.GetScript(plugins)
                 
           If e = 25 Then Exit Sub      

           End If          
           Next

End Sub



'*****************************************************************************
'This Area is where the Matrx class is called. It allows the programmer some short
'cuts in plugin design. A list of classes will be shown below.
'*****************************************************************************

'Use Kitt.GetRespone("Kitt will say this sentence.") to echo anything to Kitt' Console
'Use Kitt.GetScript(C:/script.vbs) to add an external script to your script.
'No other class has been added at this time.
   
   
 
Class Matrix

Public Function GetResponse(Response)
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set objTextFile = fso.OpenTextFile(MyDirGlobal & "KittData\" & "IncomingData.txt", 8, True)
     objTextFile.WriteLine(Response)
     objTextFile.Close
 End Function
 
 Public Function GetScript(dirVBScript)
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set objTextFile = fso.OpenTextFile(dirVBScript, 1, True)
     Script = objTextFile.ReadAll
     objTextFile.Close
     Execute Script
 End Function
 
   Public Function OpenProgram(dirProgram)
     Set WSHshell = CreateObject("Wscript.Shell")
     WSHshell.Run chr(34) & dirProgram & Chr(34)  
   End Function
 
 Public Function Askit()
 
 
 
 End Function
 
 
 
 
 Private Sub Class_Initialize()

 End Sub

Private Sub Class_Terminate()

 End Sub

End Class

[snowman]

This is My solution to WordNet. It utilizes the Database class to discover the Part of speech of any particular word. It requires the WordKitt.accdb database. This is an Microsoft Access 2007 database that is filled with words and there corresponding POS.

I just started on it so it is semi-incomplete. It will work as is though.

Here is a link to WordKitt.zip database.

http://www.savefile.com/files/2120112

Class MatrixWD
'***********************************************
'***********************************************

Public Function GuessPOS(WordToLookup)
Dim POSArray(10)
a = 0

OrigWord = Trim(WordToLookup)

Fword = Left(OrigWord, 3)

If DB.CheckValueExists(strTableWD, WDColumnID, Fword) > 0 Then

     ARat = DB.GetAllColumns(MyDirWD, DatabaseWD, strTableWD)

     For Each ColumnLookup In ARat

          If ColumnLookup <> WDColumnID And ColumnLookup > "" Then
          ABat = DB.GetSelectValues(strTableWD, ColumnLookup, WDColumnID, Fword)

               For Each wordvalue In ABat
               wordvalue = Trim(wordvalue)
 
                    If wordvalue > "" And InStr(1,wordvalue, ",", vbTextCompare) > 0 Then
                    word1 = Split(wordvalue, ",")
                         For Each word2 In word1

                         '***********************
                              If word2 = OrigWord Then
                                                                                 
                              POSArray(a) = ColumnLookup
                              a = a + 1
                             
                              End If
                         '***********************

                         Next

                     ElseIf wordvalue > "" Then
                     
                         If wordvalue = OrigWord Then
                         '***********************
                                     
                              POSArray(a) = ColumnLookup & "****"
                              a = a + 1
                             
                         '***********************      
                         End If
                     
                     End If
               Next
          End If
     Next
End If

GuessPOS = POSArray

 End Function
 
 Public Function FindPOS(Sentence, WordToLookup)
 
OrigWord = Trim(WordToLookup)
 
POS = GuessPOS(WordToLookup)
 
For Each P In POS
If P > "" Then

If InStr(1, Sentence, "to " & OrigWord, vbTextCompare) > 0 And P = "verb" Then L = 1

If InStr(1, OrigWord, "ing", vbTextCompare) > 0 And P = "verb" Then L = 1

If InStr(1, Sentence, "a " & OrigWord, vbTextCompare) > 0 And P = "noun" Then L = 2

If InStr(1, Sentence, "an " & OrigWord, vbTextCompare) > 0 And P = "noun" Then L = 2

If InStr(1, Sentence, "the " & OrigWord, vbTextCompare) > 0 And P = "noun" Then L = 2

If InStr(1, OrigWord, "ly", vbTextCompare) > 0 And P = "adverb" Then L = 3

If InStr(1, OrigWord, "lier", vbTextCompare) > 0 And P = "adverb" Then L = 3

End If
Next

If L = 1 Then FindPOS = "verb"
If L = 2 Then FindPOS = "noun"
If L = 3 Then FindPOS = "adverb"

  End Function
 
'***********************************************
'***********************************************

 Private Sub Class_Initialize()

 End Sub
'***********************************************
'***********************************************

Private Sub Class_Terminate()

 End Sub

End Class

[snowman]

-Dude,

As you can see, I'm getting a little nearer to parsing your concept text files.[]

[jasondude7116]

looks great man!
i know many people will appreciate your work.[]
i will be feeding the concept files to GRETTA downloads, however they are a very time consuming task. i hope to eventually end up with aprox. 250,000 lines with all files combined. all lines are individually read by yours truly.[xx(] trying to do as much as i can though.

keep rockin' with the good stuff!

-the dude

[snowman]

quote:Originally posted by jasondude7116

looks great man!
i know many people will appreciate your work.[]
i will be feeding the concept files to GRETTA downloads, however they are a very time consuming task. i hope to eventually end up with aprox. 250,000 lines with all files combined. all lines are individually read by yours truly.[xx(] trying to do as much as i can though.

keep rockin' with the good stuff!

-the dude

Right now I'm working on the KittParser.vbs to take your concept sentences apart. It will divide each sentence into two parts: the subject in the ID column and the rest of the sentence as a column title.

The intersection of the row and the column will have a "True" or "False" entry. This will allow me to find a subject, get the concept associated with that subject, and tell if it is true or false.

Thanks for the encouragement too.

-Aaron[]

[sas929]

I have Visual Studio 2005, will this be enough or do I need to get 2008?

[snowman]

sas929,

I'm not sure what you mean.

If you just want to install the HalVisionx program then read the first post on this thread. You do not need Visual Studio to use HalVision.

If you are trying to modify or explore the HalVisionx source code then you will probably need Visual Basic 2008, not sure if it will run on 2005, I haven't tried it yet.

I made the program using Visual Studio 2008 Professional Edition.

I hope this helps....

Oh, and welcome to the forum.[]

[spydaz]

im just wondering if microsoft do a runtime file library for vis studio 2008

[snowman]

I'm sorry, but I do not know what you are saying. Please restate your sentence.


[]I wrote this next thought just for the fun of it. []
I was told once by a linguistics professor that the word 'do' is used in very very few languages. Most other languages just cite 'what' you are doing, not 'that' you are doing.

I am doing well.. (English)

Or

I am in good health, feeling strong, and learning much. (other languages)[]

[lightspeed]

i am just patiently waiting for a universal fix to come through as i know i am not the only one who cant get halvision to work so am still waiting . []

[Data]

Me to LS

I just downloaded the 64bit Windows 7 RC, gona get the drivers in etc and give this halvision a go in there.

Will report back with the result some time.

[Avery]

Lightspeed you need this MSVCRT 8.0 SP1[]