- Timestamp:
- 04/09/10 09:52:39 (14 years ago)
- Location:
- trunk/desktop
- Files:
-
- 2 edited
-
ICSSerialPort.rbbas (modified) (1 diff)
-
mainWindow.rbfrm (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/desktop/ICSSerialPort.rbbas
r25 r26 455 455 #tag EndMethod 456 456 457 #tag Method, Flags = &h0 458 Sub exportProfile(theName as string) 459 dim xml as XmlDocument 460 dim root as XmlNode 461 dim rootchild as XmlNode 462 dim rs as RecordSet 463 dim i as integer 464 dim dlg as SaveAsDialog 465 dim f as FolderItem 466 467 dlg = New SaveAsDialog 468 dlg.Title = "Export your profile" 469 #if TargetLinux 470 dlg.InitialDirectory = SpecialFolder.Home 471 #else 472 dlg.InitialDirectory = SpecialFolder.Documents 473 #endif 474 475 dlg.SuggestedFileName = "ics_"+theName+".xml" 476 f = dlg.ShowModal() 477 478 if f <> Nil then 479 //Nothing to see here, move along 480 else 481 MsgBox "You must choose a file" 482 Return 483 end if 484 485 //Find the record 486 rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'") 487 488 if rs <> Nil then 489 //We have a record, so do something 490 491 //Create the root element of the XML file 492 xml = New XmlDocument 493 root = xml.AppendChild(xml.CreateElement("icsprofile")) 494 495 //Itterate all available fields and write them to the xml document 496 for i = 1 to rs.FieldCount 497 if rs.IdxField(i).Name <> "" and rs.IdxField(i).StringValue<> "" then 498 499 rootchild = root.AppendChild(xml.CreateElement(rs.IdxField(i).Name)) 500 rootchild.AppendChild(xml.CreateTextNode(rs.IdxField(i).StringValue)) 501 end if 502 next 503 504 //Write the document to a file 505 xml.SaveXml(f) 506 else 507 MsgBox "No profile to export" 508 Return 509 end if 510 511 End Sub 512 #tag EndMethod 513 514 #tag Method, Flags = &h0 515 Function importProfile() As Boolean 516 dim success as boolean 517 dim dlg as OpenDialog 518 dim f as FolderItem 519 dim xdoc as XmlDocument 520 dim root as XmlNode 521 dim i as integer 522 dim count as Integer 523 dim item as string 524 dim rec as DatabaseRecord 525 dim theName as string 526 527 rec = New DatabaseRecord 528 success = False 529 530 531 //Get the user to select a file 532 dlg = New OpenDialog 533 dlg.Title = "Select a profile to import" 534 #if TargetLinux 535 dlg.InitialDirectory = SpecialFolder.Home 536 #else 537 dlg.InitialDirectory = SpecialFolder.Documents 538 #endif 539 f = dlg.ShowModal() 540 541 //If we have a valid file we need to read it as an xml file to process it 542 //Items are individually specified to prevent the program from trying to insert columns that do not exist 543 //All column names should match the database table 544 545 if f <> nil then 546 547 //Read the XML file 548 xdoc = New XmlDocument(f) 549 550 count = xdoc.DocumentElement.ChildCount 551 552 for i = 0 to count - 1 553 root = xdoc.DocumentElement.Child(i) 554 555 item = root.FirstChild.Value 556 557 select case root.Name 558 559 case "name" 560 theName = item 561 case "cartype" 562 carType = item 563 case "byte01" 564 byte01 = chrb(val(item)) 565 case "byte02" 566 byte02 = chrb(val(item)) 567 case "byte03" 568 byte03 = chrb(val(item)) 569 case "byte04" 570 byte04 = chrb(val(item)) 571 case "byte05" 572 byte05 = chrb(val(item)) 573 case "byte06" 574 byte06 = chrb(val(item)) 575 case "byte07" 576 byte07 = chrb(val(item)) 577 case "byte08" 578 byte08 = chrb(val(item)) 579 case "byte09" 580 byte09 = chrb(val(item)) 581 case "byte10" 582 byte10 = chrb(val(item)) 583 case "byte11" 584 byte11 = chrb(val(item)) 585 case "byte12" 586 byte12 = chrb(val(item)) 587 case "byte13" 588 byte13 = chrb(val(item)) 589 case "byte14" 590 byte14 = chrb(val(item)) 591 case "byte15" 592 byte15 = chrb(val(item)) 593 case "byte16" 594 byte16 = chrb(val(item)) 595 case "byte17" 596 byte17 = chrb(val(item)) 597 case "byte18" 598 byte18 = chrb(val(item)) 599 600 end select 601 602 next 603 604 else 605 //File not select we can stop 606 success = False 607 return success 608 end if 609 610 //Now check to make sure their is not an existing profile with this name 611 dim rs as RecordSet 612 613 rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'") 614 615 if rs <> Nil then 616 617 if rs.RecordCount > 0 then 618 //we have a duplicate record 619 //we need to prompt the user about what to do 620 dim d as New MessageDialog 621 dim b as MessageDialogButton 622 d.Icon = MessageDialog.GraphicCaution 623 d.ActionButton.Caption = "Yes" 624 d.CancelButton.Visible = True 625 d.CancelButton.Caption = "No" 626 d.Message = "A profile exists with this name, do you want to overwrite the existing profile?" 627 b = d.ShowModal 628 629 //Now determine what the user chose 630 Select Case b 631 case d.ActionButton 632 //The user wants to overwrite the record so we can just save what we have 633 saveProfile(theName) 634 success = True 635 //Values changed because of the overwrite 636 valuesChanged() 637 case d.CancelButton 638 //The user chose not to overwrite the record, we need to come up with a new name 639 //We will increment the number until we find a name not used or we hit 32 just in case an infinite loop would occur 640 dim tempString as string 641 dim tempName as string 642 i = 0 643 while rs.RecordCount > 0 644 i = i + 1 645 tempString = str(i) 646 tempName = theName + tempString 647 //Check to make sure we are not in an infinite looooooooop 648 //If we are something went wrong 649 if i > 31 then 650 exit While 651 end if 652 rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name = '"+tempName+"'") 653 654 wend 655 //OK we have a unique name at this point 656 theName = theName + tempString 657 saveProfile(theName) 658 success = True 659 //new profile was imported 660 profileImported(theName) 661 end select 662 663 else 664 //No duplicate exists so we can just insert the record 665 saveProfile(theName) 666 success = True 667 //new profile was imported 668 profileImported(theName) 669 end if 670 //Close our record 671 rs.Close 672 673 end if 674 675 Return success 676 677 End Function 678 #tag EndMethod 679 457 680 458 681 #tag Hook, Flags = &h0 459 682 Event valuesChanged() 683 #tag EndHook 684 685 #tag Hook, Flags = &h0 686 Event profileImported(profileName as string) 460 687 #tag EndHook 461 688 -
trunk/desktop/mainWindow.rbfrm
r24 r26 2664 2664 TextFont = "System" 2665 2665 TextSize = 0 2666 Top = 2 182666 Top = 282 2667 2667 Underline = "" 2668 2668 Visible = True … … 2694 2694 TextSize = 0 2695 2695 Top = 186 2696 Underline = "" 2697 Visible = True 2698 Width = 88 2699 End 2700 Begin PushButton PushButton_Import 2701 AutoDeactivate = True 2702 Bold = "" 2703 Cancel = "" 2704 Caption = "Import" 2705 Default = "" 2706 Enabled = True 2707 Height = 20 2708 HelpTag = "" 2709 Index = -2147483648 2710 InitialParent = "" 2711 Italic = "" 2712 Left = 20 2713 LockBottom = "" 2714 LockedInPosition= False 2715 LockLeft = "" 2716 LockRight = "" 2717 LockTop = "" 2718 Scope = 0 2719 TabIndex = 58 2720 TabPanelIndex = 0 2721 TabStop = True 2722 TextFont = "System" 2723 TextSize = 0 2724 Top = 218 2725 Underline = "" 2726 Visible = True 2727 Width = 88 2728 End 2729 Begin PushButton PushButton_Export 2730 AutoDeactivate = True 2731 Bold = "" 2732 Cancel = "" 2733 Caption = "Export" 2734 Default = "" 2735 Enabled = False 2736 Height = 20 2737 HelpTag = "" 2738 Index = -2147483648 2739 InitialParent = "" 2740 Italic = "" 2741 Left = 20 2742 LockBottom = "" 2743 LockedInPosition= False 2744 LockLeft = "" 2745 LockRight = "" 2746 LockTop = "" 2747 Scope = 0 2748 TabIndex = 59 2749 TabPanelIndex = 0 2750 TabStop = True 2751 TextFont = "System" 2752 TextSize = 0 2753 Top = 314 2696 2754 Underline = "" 2697 2755 Visible = True … … 3541 3599 Sub Change() 3542 3600 ICSSerialPort1.setCarType(me.Text) 3601 ICSSerialPort1.setDefaultValues 3543 3602 disableControls 3544 3603 … … 3693 3752 #tag Event 3694 3753 Sub valuesChanged() 3754 //Update the screens with the new values 3755 updateAdvancedScreen 3756 updateCarScreen 3757 End Sub 3758 #tag EndEvent 3759 #tag Event 3760 Sub profileImported(profileName as string) 3761 PopupMenu_Profile.AddRow(profileName) 3762 3763 //Make sure to switch to the new profile 3764 PopupMenu_Profile.ListIndex = PopupMenu_Profile.ListCount 3765 3695 3766 //Update the screens with the new values 3696 3767 updateAdvancedScreen … … 3756 3827 PushButton_SaveProfile.Enabled = true 3757 3828 PushButton_Delete.Enabled = true 3829 PushButton_Export.Enabled = true 3758 3830 ICSSerialPort1.loadProfile(me.Text) 3759 3831 end if … … 3763 3835 Sub Open() 3764 3836 dim s() as string 3765 dim i as integer3766 3837 3767 3838 s = ICSSerialPort1.listProfiles … … 3795 3866 PushButton_SaveProfile.Enabled = False 3796 3867 PushButton_Delete.Enabled = False 3868 PushButton_Export.Enabled = False 3869 3797 3870 end if 3798 3871 End Sub … … 3807 3880 #tag EndEvent 3808 3881 #tag EndEvents 3882 #tag Events PushButton_Import 3883 #tag Event 3884 Sub Action() 3885 dim success as Boolean 3886 3887 success = ICSSerialPort1.importProfile 3888 3889 if success = false then 3890 MsgBox "Error importing profile" 3891 end if 3892 End Sub 3893 #tag EndEvent 3894 #tag EndEvents 3895 #tag Events PushButton_Export 3896 #tag Event 3897 Sub Action() 3898 if PopupMenu_Profile.Text <> "" then 3899 ICSSerialPort1.exportProfile(PopupMenu_Profile.Text) 3900 end if 3901 End Sub 3902 #tag EndEvent 3903 #tag EndEvents
Note: See TracChangeset
for help on using the changeset viewer.