home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
code
/
design
/
lbtabs
/
listdemo.frm
< prev
next >
Wrap
Text File
|
1995-02-18
|
7KB
|
267 lines
VERSION 2.00
Begin Form frmListDemo
Caption = "List Control Demo"
ClientHeight = 4800
ClientLeft = 2280
ClientTop = 1650
ClientWidth = 5760
Height = 5205
Left = 2220
LinkTopic = "Form1"
ScaleHeight = 4800
ScaleWidth = 5760
Top = 1305
Width = 5880
Begin TextBox txtSearch
Height = 285
Left = 240
TabIndex = 1
Top = 360
Width = 5295
End
Begin CommandButton cmdExit
Caption = "E&xit"
Height = 495
Left = 3000
TabIndex = 8
Top = 4080
Width = 2535
End
Begin ListBox lstFonts
Height = 1200
Left = 240
Sorted = -1 'True
TabIndex = 6
Top = 3360
Width = 2535
End
Begin TextBox txtListHeadings
BorderStyle = 0 'None
Enabled = 0 'False
ForeColor = &H00C00000&
Height = 255
Left = 240
MultiLine = -1 'True
TabIndex = 4
Text = "(headings)"
Top = 1440
Width = 855
End
Begin CommandButton cmdSetColumns
Caption = "(set columns)"
Height = 495
Left = 3000
TabIndex = 7
Top = 3480
Width = 2535
End
Begin ListBox lstFruits
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 1230
Left = 240
Sorted = -1 'True
TabIndex = 5
Top = 1800
Width = 5295
End
Begin ComboBox cboSelect
Height = 300
Left = 240
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 3
Top = 1080
Width = 5295
End
Begin Label lblSearch
Caption = "Search:"
Height = 255
Left = 240
TabIndex = 0
Top = 120
Width = 1455
End
Begin Label lblSelect
Caption = "Select:"
Height = 255
Left = 240
TabIndex = 2
Top = 840
Width = 1455
End
End
Option Explicit
'Updated 01/06/95 - DULIST.BAS Fixes and Enhancements
'
' dulist_tfSetListCols
' --------------------
' Fixed bug that caused an endless
' loop if the last character of a
' listbox item string was a Chr$(9) tab.
'
' dulist_sGetColumn
' -----------------
' New routine to extract data, by column,
' from a tab-delimited string.
'
' dulist_AddHorizScrollBar
' ------------------------
' New routine to add a horizontal
' scrollbar to a listbox.
'If you have questions, comments, or suggestions for
'improving the code presented here, please forward them
'to me; your input is welcome:
'
' Brad Kaenel
' PC HELP-LINE
' 35250 Silver Leaf Circle
' Yucaipa, CA 92399
' United States
' CIS: 72357,3523
' Internet: 72357.3523@compuserve.com
'
'Although multi-column listboxes are a common
'requirement, they are difficult to accomplish
'in VB.
'A simple solution is to select a mono-spaced
'font for the listbox and align the data manually,
'but this is not always visually appealing. However,
'with a little more work you can set dynamic tabstops
'that will work with proportional fonts.
'This sample demonstrates how to set tabstops in a listbox,
'using a borderless, disabled text box for the column
'headings. It also shows how to "pre-select" a listbox
'or combobox item, using Windows API functions.
Dim sFruit(10) As String, sMyFruit As String
Dim nTabStopsSet As Integer
Sub cboSelect_Click ()
sMyFruit = cboSelect.Text
txtSearch.Text = sMyFruit 'synchronize the textbox
Call SelectFruit 'synchronize the listbox
End Sub
Sub cmdExit_Click ()
Unload frmListDemo
End Sub
Sub cmdSetColumns_Click ()
Call SetTabStops
End Sub
Sub Form_Load ()
Dim nFruitCount As Integer
Dim sTAB As String
sTAB = Chr$(9)
'add a horiz scrollbar
Call dulist_AddHorizScrollBar(lstFruits, 0)
'load up some multi-column data
txtListHeadings.Text = "Fruit" + sTAB + "Opinion" + sTAB + "Color"
sFruit(1) = "Oranges" + sTAB + "Good" + sTAB + "Orange, of course"
sFruit(2) = "Bananas" + sTAB + "Munchy" + sTAB + "Yellow"
sFruit(3) = "Apples" + sTAB + "Delicious" + sTAB + "Red"
sFruit(4) = "Blueberries" + sTAB + "Nah" + sTAB + "Blue"
sFruit(5) = "Plums" + sTAB + "Better than prunes" + sTAB + "Purple"
sFruit(6) = "Watermelons" + sTAB + "Marvelous" + sTAB + "Red and Green"
sFruit(7) = "Cherries" + sTAB + "Ummm..." + sTAB + "Bright Red"
sFruit(8) = "Mangos" + sTAB + "Juicy" + sTAB + "No idea"
sFruit(9) = "Kiwis" + sTAB + "Kinda weird" + sTAB + "Fuzzy Green"
sFruit(10) = "Peaches" + sTAB + "OK" + sTAB + "Peach, I guess(?)"
For nFruitCount = 1 To UBound(sFruit)
lstFruits.AddItem sFruit(nFruitCount)
'comboboxes don't support tabstops, so use only the first column string
cboSelect.AddItem dulist_sGetColumn(sFruit(nFruitCount), 1)
Next
For nFruitCount = 0 To Screen.FontCount - 1
lstFonts.AddItem Screen.Fonts(nFruitCount)
Next
nTabStopsSet = True
cmdSetColumns.Value = True 'trigger tab stops
End Sub
Sub lstFonts_Click ()
lstFruits.FontName = lstFonts.List(lstFonts.ListIndex)
lstFruits.Height = (lstFonts.Top - lstFruits.Top) - 20
nTabStopsSet = Not nTabStopsSet
cmdSetColumns.Value = True 'trigger tab stops
End Sub
Sub lstFruits_Click ()
sMyFruit = dulist_sGetColumn((lstFruits.List(lstFruits.ListIndex)), 1)
txtSearch.Text = sMyFruit 'synchronize the textbox
Call SelectFruit 'synchronize the combobox
End Sub
Sub SelectFruit ()
If dulist_tfSelectListItem(lstFruits, sMyFruit) Then
If dulist_tfSelectListItem(cboSelect, sMyFruit) Then
End If
End If
End Sub
Sub SetTabStops ()
If nTabStopsSet Then
If dulist_tfSetListCols(lstFruits, txtListHeadings, False, True) Then
cmdSetColumns.Caption = "Set &Custom Tab Stops"
nTabStopsSet = Not nTabStopsSet
End If
Else
If dulist_tfSetListCols(lstFruits, txtListHeadings, False, False) Then
cmdSetColumns.Caption = "Reset &Default Tab Stops"
nTabStopsSet = Not nTabStopsSet
End If
End If
End Sub
Sub txtSearch_Change ()
sMyFruit = txtSearch.Text
Call SelectFruit 'synchronize the listbox
'and the combobox
End Sub