Changeset 11 for trunk/desktop/ICSSerialPort.rbbas

Timestamp:

04/07/10 16:45:17 (15 years ago)

Author:

pinwc4

Message:

Added more database logic and a screen for creating a new profile

File:

• trunk/desktop/ICSSerialPort.rbbas (modified) (8 diffs)

trunk/desktop/ICSSerialPort.rbbas

@@ -99 +99 @@
                   case "MR-03"
                     carType = value
+                    byte15 = chrb(&h05)
+                    byte16 = chrb(&h5A)
+                    byte17 = chrb(&h3C)
                   case "dNaNo"
                     carType = value
-                  case "AD"
-                    carType = value
+                    byte15 = chrb(&hFF)
+                    byte16 = chrb(&h80)
+                    byte17 = chrb(&h80)
                   case "ASF"
                     carType = value
+                    byte15 = chrb(&hFF)
+                    byte16 = chrb(&hFF)
+                    byte17 = chrb(&hFF)
+                    
                   else
                     MsgBox "Error setting Car Type"
                   end select
+                  
+                  valuesChanged()
                 End Sub
         #tag EndMethod
@@ -114 +124 @@
                 Sub writeCar()
                   //Send set bytes to the car
+                  mode = "write"
                   
                   dim sendstring as string
@@ -157 +168 @@
                 Sub readCar()
                   //Read values from the currently attached car
+                  
+                  mode = "read"
                 End Sub
         #tag EndMethod
@@ -175 +188 @@
                     end if
                   end if
+                  
+                  //Set default byte values
+                  byte01 = chrb(&hD5)
+                  byte02 = chrb(&h5A)
+                  byte03 = chrb(&h64)
+                  byte04 = chrb(&hFF)
+                  byte05 = chrb(&h02)
+                  byte06 = chrb(&h02)
+                  byte07 = chrb(&h01)
+                  byte08 = chrb(&hFF)
+                  byte09 = chrb(&hBC)
+                  byte10 = chrb(&h44)
+                  byte11 = chrb(&h88)
+                  byte12 = chrb(&h78)
+                  byte13 = chrb(&hFF)
+                  byte14 = chrb(&h2C)
+                  byte15 = chrb(&h05)
+                  byte16 = chrb(&h5A)
+                  byte17 = chrb(&h3C)
+                  byte18 = chrb(&h87)
+                  
+                  carType = "MR-03"
                 End Sub
         #tag EndMethod
@@ -198 +233 @@
                     if fsicsdb.Connect() then
                       dim query as string
-                      query = "CREATE TABLE carprofiles (id INTEGER PRIMARY KEY, name VARCHAR, cartype VARCHAR, byte01 VARCHAR, byte02 VARCHAR, byte03 VARCHAR, byte04 VARCHAR, byte05 VARCHAR, byte06 VARCHAR"+_
-                      ", byte07 VARCHAR, byte08 VARCHAR, byte09 VARCHAR, byte10 VARCHAR, byte11 VARCHAR, byte12 VARCHAR, byte13 VARCHAR, byte14 VARCHAR, byte15 VARCHAR, byte16 VARCHAR, byte17 VARCHAR"+_
-                      ", byte18 VARCHAR, UNIQUE(name))"
+                      query = "CREATE TABLE carprofiles (id INTEGER PRIMARY KEY, name VARCHAR, cartype VARCHAR, byte01 INTEGER, byte02 INTEGER, byte03 INTEGER, byte04 INTEGER, byte05 INTEGER, byte06 INTEGER"+_
+                      ", byte07 INTEGER, byte08 INTEGER, byte09 INTEGER, byte10 INTEGER, byte11 INTEGER, byte12 INTEGER, byte13 INTEGER, byte14 INTEGER, byte15 INTEGER, byte16 INTEGER, byte17 INTEGER"+_
+                      ", byte18 INTEGER, UNIQUE(name))"
                       fsicsdb.SQLExecute(query)
                       if fsicsdb.Error then
                         MsgBox "Database Error (carprofiles):" + fsicsdb.ErrorMessage
+                        fsicsdb.Rollback
+                        
+                      else
+                        fsicsdb.Commit
                       end if
                       
@@ -217 +256 @@
         #tag EndMethod
 
+        #tag Method, Flags = &h0
+                Function createProfile(theName as String) As Boolean
+                  dim success as boolean
+                  success = false
+                  
+                  //Make sure we got a name
+                  if theName = "" then
+                    return success
+                  else
+                    //Build a new database record
+                    dim rec as DatabaseRecord
+                    rec = New DatabaseRecord
+                    
+                    rec.Column("name") = theName
+                    rec.Column("cartype") = carType
+                    rec.IntegerColumn("byte01") = asc(byte01)
+                    rec.IntegerColumn("byte02") = asc(byte02)
+                    rec.IntegerColumn("byte03") = asc(byte03)
+                    rec.IntegerColumn("byte04") = asc(byte04)
+                    rec.IntegerColumn("byte05") = asc(byte05)
+                    rec.IntegerColumn("byte06") = asc(byte06)
+                    rec.IntegerColumn("byte07") = asc(byte07)
+                    rec.IntegerColumn("byte08") = asc(byte08)
+                    rec.IntegerColumn("byte09") = asc(byte09)
+                    rec.IntegerColumn("byte10") = asc(byte10)
+                    rec.IntegerColumn("byte11") = asc(byte11)
+                    rec.IntegerColumn("byte12") = asc(byte12)
+                    rec.IntegerColumn("byte13") = asc(byte13)
+                    rec.IntegerColumn("byte14") = asc(byte14)
+                    rec.IntegerColumn("byte15") = asc(byte15)
+                    rec.IntegerColumn("byte16") = asc(byte16)
+                    rec.IntegerColumn("byte17") = asc(byte17)
+                    rec.IntegerColumn("byte18") = asc(byte18)
+                    
+                    fsicsdb.InsertRecord("carprofiles", rec)
+                    
+                    if fsicsdb.Error = True then
+                      MsgBox "Error creating profile, " + fsicsdb.ErrorMessage
+                      fsicsdb.Rollback
+                    else
+                      fsicsdb.Commit
+                      success = true
+                    end if
+                  end if
+                  
+                  Return success
+                End Function
+        #tag EndMethod
+
+        #tag Method, Flags = &h0
+                Sub deleteProfile(theName as String)
+                  if theName <> "" then
+                    
+                    //Delete the profile selected
+                    fsicsdb.SQLExecute("DELETE FROM carprofiles WHERE name = '" + theName + "'")
+                    
+                    //Check for errors
+                    if fsicsdb.Error = True then
+                      MsgBox "Error deleting profile"
+                      fsicsdb.Rollback
+                    else
+                      fsicsdb.Commit
+                    end if
+                    
+                  else
+                    
+                    MsgBox "Please select a profile to delete"
+                    
+                  end if
+                End Sub
+        #tag EndMethod
+
+        #tag Method, Flags = &h0
+                Sub saveProfile(theName as String)
+                  dim rs as RecordSet
+                  dim status as Boolean
+                  
+                  //Find a record
+                  rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'")
+                  
+                  //Make sure we got a record
+                  if rs <> nil then
+                    //delete the record before saving
+                    deleteProfile(theName)
+                  end if
+                  
+                  rs.Close
+                  
+                  status = createProfile(theName)
+                End Sub
+        #tag EndMethod
+
+        #tag Method, Flags = &h0
+                Function listProfiles() As String()
+                  dim rs as RecordSet
+                  dim s() as string
+                  
+                  //Find records
+                  rs = fsicsdb.SQLSelect("SELECT name FROM carprofiles")
+                  
+                  if rs <> nil then
+                    
+                    while rs.EOF = false
+                      s.Append rs.Field("name").StringValue
+                      rs.MoveNext
+                    wend
+                    
+                  end if
+                  
+                  rs.Close
+                  Return s()
+                End Function
+        #tag EndMethod
+
 
         #tag Hook, Flags = &h0
@@ -233 +386 @@
 
         #tag Property, Flags = &h0
-                byte01 As String = "&hFF"
+                byte01 As String
         #tag EndProperty
 
@@ -310 +463 @@
         #tag Property, Flags = &h0
                 fsicsdb As REALSQLDatabase
+        #tag EndProperty
+
+        #tag Property, Flags = &h0
+                mode As String = "read"
         #tag EndProperty