Welcome to a new song and also a source code
off one of my composing tools.
By the way, each song I make has it's own Quake level build
around it. 'Ewoks VS Quake.' In a few years time when the
NET becomes fast, I will probalby blast the songs thru Inet
live wargames connections.
Below one of my latest source codes:
' Knock yourselfs out. (the Crom design label)
' Visual Basic source code - Mass storage container
'
' Some minor bugs thru converting but you should know how to
' fix these.
'
Dim filnam 'filename for datafile
Dim tlt 'name of the form
Dim feed 'linefeed thingy
Dim tkin 'extra setup option
Private Sub Form_Load()
' Change the filename here if run from Visual
filnam = "catast.txt"
a = Command 'make a .bat file for any data file u might need
If a = "" = False Then filnam = a
'
If a = "" = False Then Call loadit
'
tlt = "Listbox inc. (Crude) storage system" 'Place your name and\or Email here
Form1.Caption = tlt
feed = Chr(13) + Chr(10)
tkin = 2 '50% o/t screen
'
' Note that list1(1) is used for the mask and list1(0)
' for the raw data. list1(1) will only diplay the first
' set of characters until a chr(13) code (enter feed)
'
List1(1).ZOrder ' List1(1) always in front.
'
End Sub
Private Sub List1_DblClick(Index As Integer)
'
'Click twice on item to send it to the textbox
'
Call totext
'
' You could also for instance copy it directly to the clipboard (!!)
'
End Sub
Private Sub List1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
'
' Listbox addition
Select Case KeyCode
Case vbKeyReturn
Call totext 'move text to textwindow
Case vbKeyF3
Call doinsert(Text1.Text) 'insert text
Case vbKeyDelete ' Delete selected text
Call deleteitem
Case vbKeyF2 ' Save text to file
Call saveit
Case vbKeyF1 ' Load text from file
Call loadit
Case vbKeyF5 ' Insert a line
Call doinsert("----------")
Case vbKeyF6 ' Insert another line (Do enter anything you like)
Call doinsert("==========")
Case vbKeyF7 ' Maximize or not?
If Shift Then
tkin = 2: Call Form_Resize
Else
Call minim
End If
Case vbKeyF8 'decrease size of font
List1(1).FontSize = List1(1).FontSize - 2
Call Form_Resize
Case vbKeyF9 ' Increase size of font
List1(1).FontSize = List1(1).FontSize + 2
Call Form_Resize
Case vbKeyF10
Text1.Text = ""
Case vbKeyF11
Call inf 'Show info in text window (if textwindow = empty!!)
Case vbKeyF12 'No warning, dead end
End
End Select
Call settitle
End Sub
Private Sub List1_MouseUp(Index As Integer, Button As Integer, Shift As Integer,
'
' Press da right one to deselect item(s).
'
If Button = 2 Then List1(1).ListIndex = -1: For i = 0 To List1(1).ListCount - 1:
Call settitle
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Call Text1_KeyUp(KeyCode, Shift)
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
'
' This section for the textbox
'
Select Case KeyCode
Case vbKeyF3 ' move text from textbox into the list
Call doinsert(Text1.Text)
Case vbKeyF2 ' Save text to file
Call saveit
Case vbKeyF1 ' Load text from file
Call loadit
Case vbKeyF4
Call coolize ' Convert text into CoOl ForMatiNG.
Case vbKeyF7 ' Maximize or not?
If Shift Then
tkin = 3: Call Form_Resize
Else
Call minim
End If
Case vbKeyF8 ' decrease size of font
Text1.FontSize = Text1.FontSize - 2
Call Form_Resize
Case vbKeyF9 ' Increase size of font
Text1.FontSize = Text1.FontSize + 2
Call Form_Resize
Case vbKeyF10 ' erase textwindow
Text1.Text = ""
Case vbKeyF11
Call inf ' Show info in text window (if textwindow = empty!!)
Case vbKeyF12
End ' No warning, dead end
End Select
End Sub
Private Sub Text1_Change()
'
' Display realtime information in the form title bar
'
a = Len(Text1.Text)
Select Case a
Case Is < 1024
a = Str(a)
Case 1024
a = Str(a) + " - (Just right...) "
Case Is > 1024
a = Str(a) + " - (To big for single storage.) "
End Select
Form1.Caption = tlt + " [" + a + " ]"
End Sub
Private Sub doinsert(a)
'
' This will copy the text inside the listbox
'
' a = Text1.Text
If Len(a) > 1026 Then
MsgBox "No bigger text then 1026 characters per item, press Shft+f12 to chec
End If
'If a = "" Then Exit Sub
b = List1(1).ListIndex 'add into listposition
If b = -1 = False Then
List1(0).AddItem (a), b
Else
List1(0).AddItem (a)
End If
Call stringdo(a, b)
End Sub
Private Sub stringdo(a, c)
'
' Reads the first line from the text and uses it as the name
' displayed in listbox 1(1)
'
For i = 1 To Len(a) 'Loop the text
b = Mid(a, i, 1)
If b = Chr(13) Then GoTo itsi 'we have a header line
Next
itsi:
If c = -1 = False Then 'no selection ?
List1(1).AddItem (Left(a, i - 1)), c: GoTo ki
Else 'no selection then insert at end
List1(1).AddItem (Left(a, i - 1)): GoTo ki
End If
ki:
End Sub
Private Sub totext()
'
' This will copy the selected item(s) inside the textbox
'
Text1.Text = ""
For i = 0 To List1(1).ListCount - 1
If List1(1).Selected(i) = True Then Text1.Text = Text1.Text + List1(0).List(
If Len(Text1.Text) > 59508 Then Exit Sub
Next
a = Left(Text1.Text, Len(Text1.Text) - 2) 'remove last feed
Text1.Text = a
End Sub
Private Sub deleteitem()
'
' No fun if you cannot edit your menu's
'
a = List1(1).ListIndex
If a = True Then Exit Sub
List1(0).RemoveItem (a)
List1(1).RemoveItem (a)
End Sub
Private Sub saveit()
'
' Save the list1(0) to a file
'
Open filnam For Output As #1
For i = 0 To List1(0).ListCount - 1
a = List1(0).List(i)
For ti = 1 To Len(a)
b = Mid(a, ti, 1)
If b = Chr(34) Then Mid(a, ti, 1) = Chr(126)
Next
Write #1, a
Next
Close #1
MsgBox "saved", 0, "<<"
End Sub
Private Sub loadit()
'
' Loads a file and puts the text inside the program
'
a = Dir(filnam)
If a = "" Then Exit Sub
'
List1(0).Clear
List1(1).Clear
'
On Error GoTo goti
'
Open filnam For Input As #1
While EOF(1) = False
Input #1, a
For i = 1 To Len(a)
If Mid(a, i, 1) = Chr(126) Then Mid(a, i, 1) = Chr(34)
Next
List1(0).AddItem (a)
DoEvents
Wend
Close #1
For ti = 0 To List1(0).ListCount - 1
a = List1(0).List(ti)
Call stringdo(a, -1)
Next
MsgBox "loaded", 0, ">>"
Exit Sub
goti:
MsgBox filnam
End Sub
Private Sub inf() 'information
If Text1.Text = "" Then
a = List1(0).ListCount 'get entries
For i = 0 To List1(0).ListCount: z = List1(0).List(i): b = b + Len(z): Next 'get
aa = "Number of entries : " + Str(a) + feed
bb = "Number of characters : " + Str(b) + feed + feed
cc = "F1 - Load" + feed
cc = cc + "F2 - Save" + feed
cc = cc + "F3 - Add item" + feed
cc = cc + "Delete - Delete item" + feed
cc = cc + "Dbl click - view item" + feed
cc = cc + "Enter - view item(s)" + feed
cc = cc + "F4 - Coolize text" + feed
cc = cc + "F5 - Insert Line#1" + feed
cc = cc + "F6 - Insert Line#2" + feed
cc = cc + "F7 - Switch screensize" + feed
cc = cc + "Shft+F7 - Resize current window" + feed
cc = cc + "F8 - Smaller text" + feed
cc = cc + "F9 - Bigger text" + feed
cc = cc + "F10 - Erase text window" + feed
cc = cc + "F11 - Info" + feed
cc = cc + "F12 - Exit" + feed + feed
cc = cc + "Use a t/m z to search for items." + feed
cc = cc + "Use tab to switch windows." + feed + feed
cc = cc + "Just try anything!!" + feed + feed
cc = cc + "CTRL+home = top of document." + feed
cc = cc + "CTRL+end = end of document." + feed
cc = cc + "CTRL+shift+home = select until top." + feed
cc = cc + "CTRL+shift+end = select until bottom." + feed
cc = cc + "" + feed
cc = cc + "Change files using the command line option."
cc = cc + "(Use .bat connections)" + feed + feed
cc = cc + "This program will self destruct." + feed + feed
cc = cc + "Freeware 1999 - r.v.Etten for Crom Design " + feed
'cc = cc + "" + feed
a = aa + bb + cc
Text1.Text = a
End If
End Sub
Private Sub coolize() 'Convert the text into kewl notation.
a = Text1.Text
For i = 1 To Len(a)
Randomize Timer
If Fix(Rnd * 2) = 1 Then ' every now and then
Mid(a, i, 1) = UCase(Mid(a, i, 1)) ' change to upper case.
End If
Next
Text1.Text = a
End Sub
Private Sub settitle() 'Give some form information
a = Str(List1(1).ListIndex)
a = Str(a)
If a = "-1" Then a = "None"
Form1.Caption = tlt + " [" + a + "] "
End Sub
Private Sub minim() 'Switch between maximized (2) and normal (0)
If Form1.WindowState = 0 Then
Form1.WindowState = 2
Else
Form1.WindowState = 0
End If
End Sub
Private Sub Form_Resize()
'Scale contents to fit
a = Form1.WindowState
If a = 1 = False Then
For i = 0 To 1
List1(i).Left = 0
List1(i).Top = 0
List1(i).Width = Form1.Width - 140
List1(i).Height = Form1.Height / tkin
Next
Text1.Left = 0
Text1.Top = List1(1).Height
Text1.Width = Form1.Width - 140
Text1.Height = Form1.Height - List1(0).Height - 400
End If
End Sub
'
' Yes I know. The code is a mess. I am only programming in VB since januari. How
' a DLL is beyond my cup of crack:)
'
