Jump to content
xisto Community
Sign in to follow this  
kvarnerexpress

Save Listbox Where Style Is Checked!

Recommended Posts

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:

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:
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 #1End SubPrivate Sub About_Click()frmAbout.ShowForm1.HideEnd SubPrivate Sub Exit_Click()Unload MeEnd SubPrivate 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 = 5000End SubPrivate Sub Timer1_Timer()    createlistEnd SubPrivate Sub cmdRun_Click()    If cmdRun.Caption = "START" Then        Timer1.Enabled = True        cmdRun.Caption = "STOP"    Else        Timer1.Enabled = False        cmdRun.Caption = "START"    End IfEnd Sub

Thanks again for ANY help

Share this post


Link to post
Share on other sites

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 START[/b

 

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 #1End SubPrivate Sub Exit_Click()Unload MeEnd SubPrivate 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_fileOpen App.Path & "temp.txt" For Input As #1For x = 0 To List1.ListCount - 1Input #1, xxx	If xxx = "1" Then		List1.Selected(x) = True	End IfNextClose #1no_file:End SubPrivate Sub Form_Unload(Cancel As Integer)'saving user's checks for next reopening...Open App.Path & "temp.txt" For Output As #1For x = 0 To List1.ListCount - 1	If List1.Selected(x) = True Then		Print #1, 1	Else		Print #1, 0	End IfNextClose #1End SubPrivate Sub Timer1_Timer()   createlistEnd SubPrivate 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 IfEnd Sub

Please try It!

Share this post


Link to post
Share on other sites

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

'*** If you put this code inside Form declarations section, replace Global keyword, with PrivateGlobal 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 LongEnd TypeGlobal Const BIF_RETURNONLYFSDIRS = 1Global Const MAX_PATH = 260'*** If you put this code inside Form declarations section, add Private keyword in front of all DLL declarationsDeclare 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 LongDeclare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As LongDeclare 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:
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 IfEnd 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.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×
×
  • Create New...

Important Information

Terms of Use | Privacy Policy | Guidelines | We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.