Category : BASIC Source Code
Archive   : CZLIS110.ZIP
Filename : DEMODIR.FRM

Version 1.00
BEGIN Form frmDemoDir
AutoRedraw = 0
BackColor = QBColor(7)
BorderStyle = 2
Caption = "CzDir"
ControlBox = -1
Enabled = -1
ForeColor = QBColor(0)
Height = Char(24)
Left = Char(1)
MaxButton = -1
MinButton = -1
MousePointer = 0
Tag = ""
Top = Char(0)
Visible = -1
Width = Char(74)
WindowState = 0
BEGIN Frame Frame1
BackColor = QBColor(7)
Caption = "General Information:"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(6)
Left = Char(2)
MousePointer = 0
TabIndex = 11
Tag = ""
Top = Char(16)
Visible = -1
Width = Char(57)
BEGIN Label Label4
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "(Press ENTER to display!)"
DragMode = 0
Enabled = -1
ForeColor = QBColor(15)
Height = Char(1)
Left = Char(19)
MousePointer = 0
TabIndex = 12
Tag = ""
Top = Char(0)
Visible = -1
Width = Char(25)
END
BEGIN Label Label2
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "Label2"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Left = Char(1)
MousePointer = 0
TabIndex = 13
Tag = ""
Top = Char(1)
Visible = -1
Width = Char(30)
END
BEGIN Label Label3
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "Label3"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Left = Char(1)
MousePointer = 0
TabIndex = 14
Tag = ""
Top = Char(2)
Visible = -1
Width = Char(49)
END
BEGIN Label Label7
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "Label7"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Left = Char(1)
MousePointer = 0
TabIndex = 15
Tag = ""
Top = Char(3)
Visible = -1
Width = Char(49)
END
BEGIN Label lblListIndex
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "Label1"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Left = Char(12)
MousePointer = 0
TabIndex = 17
Tag = ""
Top = Char(0)
Visible = -1
Width = Char(7)
END
BEGIN Label Label5
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "ListIndex ="
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Index = 1
Left = Char(1)
MousePointer = 0
TabIndex = 16
Tag = ""
Top = Char(0)
Visible = -1
Width = Char(11)
END
END
BEGIN Frame Frame2
BackColor = QBColor(7)
Caption = "Tagging:"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(6)
Left = Char(2)
MousePointer = 0
TabIndex = 1
Tag = ""
Top = Char(10)
Visible = -1
Width = Char(68)
BEGIN Label Label5
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "Items Tagged ="
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Index = 0
Left = Char(33)
MousePointer = 0
TabIndex = 10
Tag = ""
Top = Char(0)
Visible = -1
Width = Char(14)
END
BEGIN Label Label8
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "Keyboard: SPACE to tag/untag"
DragMode = 0
Enabled = -1
ForeColor = QBColor(15)
Height = Char(1)
Left = Char(1)
MousePointer = 0
TabIndex = 2
Tag = ""
Top = Char(3)
Visible = -1
Width = Char(30)
END
BEGIN Label Label9
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "Mouse: RIGHT button to tag/untag"
DragMode = 0
Enabled = -1
ForeColor = QBColor(15)
Height = Char(1)
Left = Char(33)
MousePointer = 0
TabIndex = 3
Tag = ""
Top = Char(3)
Visible = -1
Width = Char(32)
END
BEGIN CommandButton cmdTag
BackColor = QBColor(7)
Cancel = 0
Caption = "&Tag All Items"
Default = 0
DragMode = 0
Enabled = -1
Height = Char(1)
Left = Char(33)
MousePointer = 0
TabIndex = 4
TabStop = -1
Tag = ""
Top = Char(1)
Visible = -1
Width = Char(19)
END
BEGIN CommandButton cmdUntag
BackColor = QBColor(7)
Cancel = 0
Caption = "&Untag All Items"
Default = 0
DragMode = 0
Enabled = -1
Height = Char(1)
Left = Char(33)
MousePointer = 0
TabIndex = 5
TabStop = -1
Tag = ""
Top = Char(2)
Visible = -1
Width = Char(19)
END
BEGIN CheckBox chkKeybTag
BackColor = QBColor(7)
Caption = "&Keyboard Tag-Scrolling"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Left = Char(1)
MousePointer = 0
TabIndex = 6
TabStop = -1
Tag = ""

Top = Char(1)
Value = 0
Visible = -1
Width = Char(26)
END
BEGIN CheckBox chkMouseTag
BackColor = QBColor(7)
Caption = "&Mouse Tag-Scrolling"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Left = Char(1)
MousePointer = 0
TabIndex = 7
TabStop = -1
Tag = ""
Top = Char(2)
Value = 0
Visible = -1
Width = Char(26)
END
BEGIN Label lblItemsTagged
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "Label6"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Left = Char(47)
MousePointer = 0
TabIndex = 8
Tag = ""
Top = Char(0)
Visible = -1
Width = Char(7)
END
BEGIN CheckBox chkAllowTag
BackColor = QBColor(7)
Caption = "&Allow Tagging"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Left = Char(1)
MousePointer = 0
TabIndex = 9
TabStop = -1
Tag = ""
Top = Char(0)
Value = 0
Visible = -1
Width = Char(22)
END
END
BEGIN CommandButton cmdCancel
BackColor = QBColor(7)
Cancel = -1
Caption = "&Cancel"
Default = 0
DragMode = 0
Enabled = -1
Height = Char(3)
Left = Char(60)
MousePointer = 0
TabIndex = 18
TabStop = -1
Tag = ""
Top = Char(19)
Visible = -1
Width = Char(10)
END
BEGIN CommandButton cmdCzFile
BackColor = QBColor(7)
Cancel = 0
Caption = "Cz&File"
Default = 0
DragMode = 0
Enabled = -1
Height = Char(3)
Left = Char(60)
MousePointer = 0
TabIndex = 20
TabStop = -1
Tag = ""
Top = Char(16)
Visible = -1
Width = Char(10)
END
BEGIN Custom CzDir
Action = 0
Alignment = 0
Archive = 0
AutoRedraw = 0
BackColor = QBColor(7)
BorderStyle = 1
Caption = ""
Checked = 0
Column = 0
DragMode = 0
Drive = ""
Enabled = -1
Filename = ""
ForeColor = QBColor(0)
Height = Char(8)
Hidden = 0
Interval = 0
LargeChange = 0
Left = Char(2)
ListCount = 0
ListIndex = 0
Max = 0
Min = 0
Mode = 0
MousePointer = 0
MultiLine = 0
Normal = 0
Path = ""
Pattern = ""
ReadOnly = -1
Row = 0
ScrollBars = 0
SelLength = 0
SelStart = 0
SelText = ""
SmallChange = 0
Sorted = 0
Style = 0
System = 0
TabIndex = 0
TabStop = -1
Tag = ""
Text = ""
Top = Char(2)
TypeID = "CzDir"
Value = 0
Visible = -1
Width = Char(68)
END
BEGIN Label Label10
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "With the mouse: Click on the top or bottom box line to scroll as well."
DragMode = 0
Enabled = -1
ForeColor = QBColor(15)
Height = Char(1)
Left = Char(1)
MousePointer = 0
TabIndex = 19
Tag = ""
Top = Char(1)
Visible = -1
Width = Char(70)
END
END
DEFINT A-Z

'$FORM frmGeneral
'$FORM frmDemoFile
'$FORM frmOrder

' CzList Internal functions. These functions have to be declared if you
' want to use them.
DECLARE FUNCTION CzGetWhatKindMem% ()
DECLARE FUNCTION CzItemsTagged% ()
DECLARE FUNCTION CzAllowTagging% (YesNo%)
DECLARE FUNCTION CzKeybTagScrolling% (YesNo%)
DECLARE FUNCTION CzMouTagScrolling% (YesNo%)
DECLARE FUNCTION CzSetVirtualPath% (PathToSet$)

' Demo functions
DECLARE SUB CzDirDetails ()
DECLARE SUB CzDirDetails2 ()
DECLARE SUB AboutCzDir ()

SUB AboutCzDir ()

a$ = "CzDir is a directory listbox control for VBDOS. It displays an alphabetically sorted, graphical directory tree. It fully supports tagging and untagging."
a$ = a$ + CHR$(13) + CHR$(10)
a$ = a$ + CHR$(13) + CHR$(10) + "CzDir uses 2 memory areas in XMS, EMS or Disk files because it has to keep track of the graphical tree as well as the directory paths."
a$ = a$ + CHR$(13) + CHR$(10)
a$ = a$ + CHR$(13) + CHR$(10) + "CzDir will first try to use XMS Memory. If no XMS memory is available, it will try to use EMS Memory. If no XMS and no EMS memory is available, CzDir will use the disk as virtual memory."
MSGBOX a$, 0, "CzDir Demo"

END SUB

SUB chkAllowTag_Click ()

IF chkAllowTag.Value = 1 THEN
Result = CzAllowTagging(0)
Result = CzKeybTagScrolling(0)
Result = CzMouTagScrolling(0)
chkKeybTag.Enabled = -1
chkMouseTag.Enabled = -1
chkKeybTag.Value = 1
chkMouseTag.Value = 1
ELSE
Result = CzAllowTagging(1)
Result = CzKeybTagScrolling(1)
Result = CzMouTagScrolling(1)
chkKeybTag.Enabled = 0
chkMouseTag.Enabled = 0
END IF

END SUB

SUB chkKeybTag_Click ()

IF chkKeybTag.Value = 1 THEN
Result = CzKeybTagScrolling(0)
ELSE
Result = CzKeybTagScrolling(1)
END IF

END SUB

SUB chkMouseTag_Click ()

IF chkMouseTag.Value = 1 THEN
Result = CzMouTagScrolling(0)
ELSE
Result = CzMouTagScrolling(1)
END IF

END SUB

SUB cmdCancel_Click ()

' You must UNLOAD the form or control(s) before you end your program. CzDir
' will then remove itself from memory. If you do not unload the form or
' control, the memory used by CzDir (either XMS, EMS, or disk space) will
' not be released and unpredictable results may occur.
UNLOAD frmDemoDir
frmOrder.SHOW 1
END

END SUB

SUB cmdCzFile_Click ()

' You must UNLOAD the form or control(s) before you end your program. CzFile
' will then remove itself from memory. If you do not unload the form or
' control, the memory used by CzFile (either XMS, EMS, or disk space) will
' not be released and unpredictable results may occur.
UNLOAD frmDemoDir
frmDemoFile.SHOW 1

END SUB

SUB cmdTag_Click ()

' Tag all elements
' Value = 1 : tag alll elements in CzDir
' Value = 2 : untag alll elements in CzDir
CzDir.Value = 1

' Display the number of items tagged.
lblItemsTagged.Caption = STR$(CzItemsTagged)

CzDir.SETFOCUS

END SUB

SUB cmdUntag_Click ()

' Untag all elements
' Value = 1 : tag alll elements in CzDir
' Value = 2 : untag alll elements in CzDir
CzDir.Value = 2

' Display the number of items tagged.
lblItemsTagged.Caption = STR$(CzItemsTagged)

CzDir.SETFOCUS

END SUB

SUB CzDirDetails ()

a$ = "CzDir reads the disk every time you use CzDir.Drive = Drive$."
a$ = a$ + CHR$(13) + CHR$(10)
a$ = a$ + CHR$(13) + CHR$(10) + "Unless you unload the CzDir control, the tree and directory paths stay in memory (XMS, EMS, or Disk)."
MSGBOX a$, 0, "CzDir Demo"

END SUB

SUB CzDirDetails2 ()

a$ = " NOTE:"
a$ = a$ + CHR$(13) + CHR$(10)
a$ = a$ + CHR$(13) + CHR$(10) + "It will take a few moments until the entire directory tree is read from disk, sorted, and the tree and paths are saved."
MSGBOX a$, 0, "CzDir Demo"

END SUB

SUB CzDir_DblClick ()

' Get the current element and display it.
' CzDir.ListIndex is the current Index. You can also get any other
' index from 0 to ListCount. For example, to get element 189, use
' Dummy$ = CzDir.List(188). Remember, the list starts with element 0.
MSGBOX CzDir.List(CzDir.ListIndex), 0, "Mouse Double Click"

END SUB

SUB CzDir_KeyDown (KeyCode AS INTEGER, Shift AS INTEGER)

' Display the current index.
lblListIndex.Caption = STR$(CzDir.ListIndex)

' Display the number of items tagged.
lblItemsTagged.Caption = STR$(CzItemsTagged)

' The ENTER key was pressed. Get the current element and display it.
' CzDir.ListIndex is the current Index. You can also get any other
' index from 0 to ListCount. For example, to get element 189, use
' Dummy$ = CzDir.List(188). Remember, the list starts with element 0.
IF KeyCode = 13 THEN MSGBOX CzDir.List(CzDir.ListIndex), 0, "Pressed Enter Key"

END SUB

SUB CzDir_MouseDown (Button AS INTEGER, Shift AS INTEGER, X AS SINGLE, Y AS SINGLE)

' Display the number of items tagged.
lblItemsTagged.Caption = STR$(CzItemsTagged)

END SUB

SUB CzDir_MouseUp (Button AS INTEGER, Shift AS INTEGER, X AS SINGLE, Y AS SINGLE)

' Display the current index.
lblListIndex.Caption = STR$(CzDir.ListIndex)

END SUB

SUB Form_Load ()

Left = ((SCREEN.Width - Width) / 2) ' Center form horizontally
Top = ((SCREEN.Height - Height) / 2) ' Center form vertically

AboutCzDir
CzDirDetails
CzDirDetails2

CzDir.Max = 299
NumElements& = CzDir.Max

' Get a drive letter from user
DriveToRead$ = INPUTBOX$("Enter a drive to read. For example, C:", "", "C:")

' Check user input
IF LEN(DriveToRead$) > 2 THEN DriveToRead$ = LEFT$(DriveToRead$, 2)
IF LEN(DriveToRead$) < 2 THEN DriveToRead$ = "C:"
IF MID$(DriveToRead$, 2, 1) <> ":" THEN MID$(DriveToRead$, 2, 1) = ":"

' Display status window
frmGeneral.Label1.Caption = "One moment...reading disk information."
frmGeneral.SHOW

' Start reading the drive
CzDir.Drive = DriveToRead$

' Unload status window from memory
UNLOAD frmGeneral

lblListIndex.Caption = STR$(CzList.ListIndex) ' Display the current index.

lblItemsTagged.Caption = STR$(CzItemsTagged) ' Display the number of items
' tagged.

' Display the number of elements used.
Label2.Caption = "Number of elements =" + STR$(NumElements& + 1)

MemoryUsed& = (NumElements& + 1) * 76
SELECT CASE CzGetWhatKindMem
CASE -1 ' Use XMS
d$ = "XMS Memory"
CASE -2 ' Use EMS
d$ = "EMS Memory"
' EMS requires additional 16 KBytes for memory page slackspace
MemoryUsed& = ((NumElements& + 1) * 76) + 16384
CASE ELSE
d$ = "Disk"
END SELECT

' Show the amount of memory or disk space used.
Label3.Caption = "Used =" + STR$(MemoryUsed&) + " Bytes (" + d$ + ")"

' Show the amount of conventional memory used.
Label7.Caption = "Conventional Memory Free =" + STR$(FRE(-1)) + " Bytes"

' ***** Setup Scrolling and Tagging *****
' Result = The current status, which is either 0 or 1
' Result = CzAllowTagging(0) ' 1 = Disable, 0 = Enable
' Result = CzKeybTagScrolling(0) ' 1 = Disable, 0 = Enable
' Result = CzMouTagScrolling(0) ' 1 = Disable, 0 = Enable

IF CzAllowTagging(0) = 0 THEN
chkAllowTag.Value = 1
IF CzKeybTagScrolling(0) = 0 THEN
chkKeybTag.Value = 1
ELSE
chkKeybTag.Value = 2
END IF
IF CzMouTagScrolling(0) = 0 THEN
chkMouseTag.Value = 1
ELSE
chkMouseTag.Value = 2
END IF
END IF

END SUB