Welcome Guest ( Log In | Register)



 
 Reply to this topicStart new topic
> Save Listbox Where Style Is Checked!
kvarnerexpress
post Jan 28 2006, 06:16 PM
Post #1


Super Member
*********

Group: Members
Posts: 407
Joined: 13-December 04
Member No.: 2,696
I've been trying to get an answer from other forums but have had NO luck at all I'm trying to accomplish 2 additional things with the program I have.

1) My program has one window with a list box. The items that are added to the listbox are doneso in the code. When the user opens the program, these items are visible and have check marks next to their name.

I want to be able to save the information so if they checked 5 of the 17 items available, and then CLOSE the program, I want them to be able to reopen the program and have those same items checked.

Below is the code that I currently have. Everything works as it should. I'm trying to get everything to save so that when they reopen the program, it looks just like how they left it so if they want to use those same items, they can just run the program as soon as it opens.

I've had a bunch of ideas from other people but they NEVER seem to work with the code I have or produce the results I'm looking for.

2) If you look at this line:

Code:

CODE
Open "C:\\Program Files\\America's Army\\System\\rand.txt" For Output As #1



The program currently uses a SET directory to place the TXT file in. How can I change this so the USER has to select the directory in which to put the file. The reason I ask is because some people install America's Army, like other programs, to a directory OTHER THAN the default which causes the program to stop working. I want to make it so they can select the directory themself and then have the file saved THERE instead. Any ideas on this one??


Here's the code I have (this does NOT include any option to save right now -- I'm trying to figure out where I can build it in & same with #2):



Code:
CODE
Private Sub createlist()

  Dim selectedGuns(1000) As String
  Dim guns(1000) As String
  Dim tmp As String
  Dim selectedCount As Integer
  Dim convertFullnameToShortname(17) As String
 
  Randomize

  ' Table that converts the names
  convertFullnameToShortname(0) = "m4a1auto"
  convertFullnameToShortname(1) = "sf"
  convertFullnameToShortname(2) = "g"
  convertFullnameToShortname(3) = "ar"
  convertFullnameToShortname(4) = "m9"
  convertFullnameToShortname(5) = "rpg"
  convertFullnameToShortname(6) = "SPR"
  convertFullnameToShortname(7) = "s24"
  convertFullnameToShortname(8) = "S82"
  convertFullnameToShortname(9) = "rct"
  convertFullnameToShortname(10) = "ak74su"
  convertFullnameToShortname(11) = "pso"
  convertFullnameToShortname(12) = "ak"
  convertFullnameToShortname(13) = "gp"
  convertFullnameToShortname(14) = "rpk"
  convertFullnameToShortname(15) = "v"
  convertFullnameToShortname(16) = "svd"
 

  ' Put the SELECTED gun name in an array
  selectedCount = 0
  For x = 0 To List1.ListCount - 1
     If List1.Selected(x) = True Then
        selectedGuns(selectedCount) = convertFullnameToShortname(x)
        selectedCount = selectedCount + 1
     End If
  Next
 
  'Put randomly select from the selected guns for each slot

  For x = 0 To 1000
     i = Int(Rnd * selectedCount)
     guns(x) = selectedGuns(i)
  Next

  'Print out the stuff to the file

  Open "C:\\Program Files\\America's Army\\System\\rand.txt" For Output As #1
  Print #1, "admin message dotCOM's Random Guns!"
  For x = 0 To 1000
     xPlusOne = x + 1
     Print #1, "admin forceclass " & xPlusOne & " " & guns(x)
  Next
 
  Close #1
End Sub

Private Sub About_Click()
frmAbout.Show
Form1.Hide
End Sub

Private Sub Exit_Click()
Unload Me
End Sub
Private Sub Form_Load()
  List1.AddItem "M4A1"
  List1.AddItem "M4 SOPMOD (SF)"
  List1.AddItem "M16A2 (m203)"
  List1.AddItem "M249 SAW"
  List1.AddItem "M9"
  List1.AddItem "RoePG"
  List1.AddItem "SPR (Silenced Sniper)"
  List1.AddItem "M24"
  List1.AddItem "M82 Barrett"
  List1.AddItem "Recruit"
  List1.AddItem "AKS-74U (VIP Gun)"
  List1.AddItem "AKS-74U-UBN (VIP MODDED)"
  List1.AddItem "AK47"
  List1.AddItem "AK103 (E 203)"
  List1.AddItem "RPK"
  List1.AddItem "VSS"
  List1.AddItem "Dragunov"
  cmdRun.Caption = "START"
  Timer1.Enabled = False
  Timer1.Interval = 5000
End Sub
Private Sub Timer1_Timer()
   createlist
End Sub
Private Sub cmdRun_Click()
   If cmdRun.Caption = "START" Then
       Timer1.Enabled = True
       cmdRun.Caption = "STOP"
   Else
       Timer1.Enabled = False
       cmdRun.Caption = "START"
   End If
End Sub


Thanks again for ANY help

(list)

Go to the top of the page
 
+Quote Post
miCRoSCoPiC^eaRt...
post Jan 28 2006, 07:34 PM
Post #2


Advanced Member
*******

Group: Members
Posts: 144
Joined: 19-February 05
From: Nakorn Chaisri, Thailand
Member No.: 3,864
Do you HAVE to stick to old VB ? Why don't you switch to VB.NET. If you're interested in that, I can provide you with a far simpler and much more flexible solution. VB was never up to my liking - but with the advent of .NET - HELL YEAH biggrin.gif

(list)

Go to the top of the page
 
+Quote Post
DeveloperX
post Feb 4 2006, 07:28 PM
Post #3


Advanced Member
*******

Group: Members
Posts: 130
Joined: 21-December 05
Member No.: 15,990
I upgrade your code for TWO purposes:

1. Load/Save last time user's checks.
2. Manual rand.txt path changing by user.

No more objects needed!
Just change your code by mine code!
And click [b]START[/b

CODE

Private Sub createlist()

  Dim selectedGuns(1000) As String
  Dim guns(1000) As String
  Dim tmp As String
  Dim selectedCount As Integer
  Dim convertFullnameToShortname(17) As String
  Dim TXTPath As String
  
  Randomize

  ' Table that converts the names
  convertFullnameToShortname(0) = "m4a1auto"
  convertFullnameToShortname(1) = "sf"
  convertFullnameToShortname(2) = "g"
  convertFullnameToShortname(3) = "ar"
  convertFullnameToShortname(4) = "m9"
  convertFullnameToShortname(5) = "rpg"
  convertFullnameToShortname(6) = "SPR"
  convertFullnameToShortname(7) = "s24"
  convertFullnameToShortname(8) = "S82"
  convertFullnameToShortname(9) = "rct"
  convertFullnameToShortname(10) = "ak74su"
  convertFullnameToShortname(11) = "pso"
  convertFullnameToShortname(12) = "ak"
  convertFullnameToShortname(13) = "gp"
  convertFullnameToShortname(14) = "rpk"
  convertFullnameToShortname(15) = "v"
  convertFullnameToShortname(16) = "svd"
  

  ' Put the SELECTED gun name in an array
  selectedCount = 0
  For x = 0 To List1.ListCount - 1
     If List1.Selected(x) = True Then
        selectedGuns(selectedCount) = convertFullnameToShortname(x)
        selectedCount = selectedCount + 1
     End If
  Next
  
  'Put randomly select from the selected guns for each slot

  For x = 0 To 1000
     i = Int(Rnd * selectedCount)
     guns(x) = selectedGuns(i)
  Next

  'Print out the stuff to the file
  'Dynamic path generation by user's input
  
  Open TXTPath & "rand.txt" For Output As #1
  Print #1, "admin message dotCOM's Random Guns!"
  For x = 0 To 1000
     xPlusOne = x + 1
     Print #1, "admin forceclass " & xPlusOne & " " & guns(x)
  Next
  
  Close #1
End Sub

Private Sub Exit_Click()
Unload Me
End Sub
Private Sub Form_Load()
  List1.AddItem "M4A1"
  List1.AddItem "M4 SOPMOD (SF)"
  List1.AddItem "M16A2 (m203)"
  List1.AddItem "M249 SAW"
  List1.AddItem "M9"
  List1.AddItem "RoePG"
  List1.AddItem "SPR (Silenced Sniper)"
  List1.AddItem "M24"
  List1.AddItem "M82 Barrett"
  List1.AddItem "Recruit"
  List1.AddItem "AKS-74U (VIP Gun)"
  List1.AddItem "AKS-74U-UBN (VIP MODDED)"
  List1.AddItem "AK47"
  List1.AddItem "AK103 (E 203)"
  List1.AddItem "RPK"
  List1.AddItem "VSS"
  List1.AddItem "Dragunov"
  cmdRun.Caption = "START"
  Timer1.Enabled = False
  Timer1.Interval = 5000
  
  'loading user's checks from last opening...
On Error GoTo no_file
Open App.Path & "temp.txt" For Input As #1
For x = 0 To List1.ListCount - 1
Input #1, xxx
    If xxx = "1" Then
        List1.Selected(x) = True
    End If
Next
Close #1
no_file:
End Sub

Private Sub Form_Unload(Cancel As Integer)
'saving user's checks for next reopening...
Open App.Path & "temp.txt" For Output As #1
For x = 0 To List1.ListCount - 1
    If List1.Selected(x) = True Then
        Print #1, 1
    Else
        Print #1, 0
    End If
Next
Close #1
End Sub

Private Sub Timer1_Timer()
   createlist
End Sub
Private Sub cmdRun_Click()
   If cmdRun.Caption = "START" Then
       'my idea for selection of TXT file location
       TXTPath = InputBox("Please select", "File location", "C:\Program Files\America's Army\System\")
       If TXTPath <> "" Then
            Timer1.Enabled = True
            cmdRun.Caption = "STOP"
       End If
   Else
       Timer1.Enabled = False
       cmdRun.Caption = "START"
   End If
End Sub


Please try It!

(list)

Go to the top of the page
 
+Quote Post
Galahad
post Feb 6 2006, 02:00 PM
Post #4


Neurotical Squirrel
*********

Group: [HOSTED]
Posts: 590
Joined: 4-November 04
From: Novi Sad, Vojvodina
Member No.: 2,127
The above example should work fine, but additionally, you can add folder selection, make your program seem more professional. This is the code you need to add to your program, and it will pop Folder selection window, just like some windows programs do.

This code should be put inside a module, or in form declarations section
CODE

'*** If you put this code inside Form declarations section, replace Global keyword, with Private
Global Type BrowseInfo
  hWndOwner As Long
  pIDLRoot As Long
  pszDisplayName As Long
  lpszTitle As Long
  ulFlags As Long
  lpfnCallback As Long
  lParam As Long
  iImage As Long
End Type
Global Const BIF_RETURNONLYFSDIRS = 1
Global Const MAX_PATH = 260
'*** If you put this code inside Form declarations section, add Private keyword in front of all DLL declarations
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long


Now that you added these declarations, you can modify your code further, to display this selection dialog, in the following way:
CODE

Private Sub cmdRun_Click()
  Dim iNull As Integer, lpIDList As Long, lResult As Long
  Dim sPath As String, udtBI As BrowseInfo
  
  With udtBI
    .hWndOwner = Me.hWnd
    .lpszTitle = lstrcat("C:\", "")
    .ulFlags = BIF_RETURNONLYFSDIRS
  End With

  If cmdRun.Caption = "START" Then
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
      sPath = String$(MAX_PATH, 0)
      SHGetPathFromIDList lpIDList, sPath
      CoTaskMemFree lpIDList
      iNull = InStr(sPath, vbNullChar)
      If iNull Then
        sPath = Left$(sPath, iNull - 1)
        TXTPath = sPath
        Timer1.Enabled = True
        cmdRun.Caption = "STOP"
      End If
    End If
   Else
       Timer1.Enabled = False
       cmdRun.Caption = "START"
   End If
End Sub


I haven't tried this code, but I believe it will work, by just copy / paste. This dialog will add professional look and feel to your program, and also, prevent typing errors if users manualy enter location. Hope this helped, and for any further questions, don't hesitate to reply in this topic, or drop me a private message, or email.

(list)

Go to the top of the page
 
+Quote Post
« Next Oldest · VB Programming · Next Newest »
 

Reply to this topicStart new topic

Collapse

> Similar Topics

Topics Topics
  1. Avatars(10)
  2. Turning An Image Into A Cartoon Style - Photoshop(30)
  3. Xbox-save-games(11)
  4. New Yorker Style Pizza Vs. Chicago Deep Dish(12)
  5. Style Xp?(14)
  6. Need 4 Speed Underground 2(4)
  7. How To Save *.swf From A Web Site?(30)
  8. Personality Test - With Signing Style(8)
  9. Sonic Style Characters/drawing Requests(1)
  10. Web Page Tree Menu: Style Sheet - Javascript(6)
  11. What Is Your Martial Art Level Belt?(57)
  12. Signature Making Full Tutorial(1)
  13. How To Save Yourself From A Rape Situation?(13)
  14. Decoration(1)
  15. Speak With Style(2)
  1. Save The World... One Click At A Time!(6)
  2. Prince Of Persia Save Games(1)
  3. Free Domain Name Application [denied](1)
  4. Web Page Layouts(1)
  5. Care For The Poor(0)
  6. Do Not Conceal! Just Confess(2)
  7. An Awesome Retro Style Computer(7)
  8. Save Youtube Files(21)
  9. New Sig From Me!(2)
  10. Save Me!(0)
  11. Style Not Displayed Correctly On Firefox [resolved](16)
  12. Are Airlines Gonna Save The Planet?(9)
  13. Easy Realmedia Producer(0)


 

Display Mode: Standard · Switch to: Linear+ · Switch to: Outline

Track this topic · Email this topic · Print this topic · Subscribe to this forum

- Lo-Fi Version Time is now: 5th September 2008 - 09:00 AM
Powered By IP.Board © 2008  IPS, Inc.
Licensed to: Xisto Corporation