HalVisionX Beta

Data · May 28, 2009, 07:52:05 AM

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 · May 29, 2009, 01:00:11 PM

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 · May 29, 2009, 01:03:35 PM

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 · May 29, 2009, 01:06:55 PM

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 · May 29, 2009, 01:11:22 PM

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 · May 29, 2009, 01:14:25 PM

-Dude,

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

jasondude7116 · May 29, 2009, 03:10:46 PM

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 · May 29, 2009, 04:20:53 PM

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 · May 30, 2009, 01:20:04 PM

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

snowman · May 30, 2009, 04:30:00 PM

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 · June 02, 2009, 08:29:35 PM

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

snowman · June 03, 2009, 02:56:01 AM

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 · June 03, 2009, 10:31:33 AM

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 · June 03, 2009, 10:49:05 AM

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 · July 30, 2009, 10:32:57 PM

Lightspeed you need this MSVCRT 8.0 SP1[:)]