Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/lb_msgs/lb_msgs.frm

Visual Basic Form | 1995-09-06 | 9.3 KB | 272 lines

VERSION 2.00
Begin Form LB_Msgs
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "ListBox Messages"
   ClientHeight    =   4260
   ClientLeft      =   1890
   ClientTop       =   1635
   ClientWidth     =   2280
   Height          =   4665
   Left            =   1830
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   4260
   ScaleWidth      =   2280
   Top             =   1290
   Width           =   2400
   Begin CommandButton More
      Caption         =   "More..."
      Height          =   372
      Left            =   1152
      TabIndex        =   12
      Top             =   3648
      Width           =   972
   End
   Begin CommandButton GetDir
      Caption         =   "Get DIR"
      Height          =   372
      Left            =   96
      TabIndex        =   11
      Tag             =   "SendMessage(GetFocus(), LB_DIR, ByVal DOS_attr&, filespecs$)"
      Top             =   3648
      Width           =   972
   End
   Begin CommandButton QuitThis
      Caption         =   "Seen it all"
      Height          =   372
      Left            =   3744
      TabIndex        =   8
      Top             =   3072
      Width           =   1212
   End
   Begin CommandButton SelectString
      Caption         =   "SelectString"
      Height          =   372
      Left            =   2304
      TabIndex        =   4
      Tag             =   "SendMessage(GetFocus(), LB_SELECTSTRING, ByVal startingAt%, ByVal theString$)"
      Top             =   3072
      Width           =   1212
   End
   Begin CommandButton SetCurSel
      Caption         =   "SetCurSel"
      Height          =   372
      Left            =   2304
      TabIndex        =   5
      Tag             =   "SendMessage(GetFocus(), LB_SETCURSEL, ByVal listEntry%, 0&)"
      Top             =   2496
      Width           =   1212
   End
   Begin CommandButton FillErUp
      Caption         =   "Fill List Box"
      Height          =   372
      Left            =   3744
      TabIndex        =   10
      Tag             =   "SendMessage(GetFocus(), LB_ADDSTRING, 0, ByVal theString$)"
      Top             =   1920
      Width           =   1212
   End
   Begin CommandButton GetCurSel
      Caption         =   "GetCurSel"
      Height          =   372
      Left            =   2304
      TabIndex        =   3
      Tag             =   "SendMessage(GetFocus(), LB_GETCURSEL, 0%, 0&)"
      Top             =   1920
      Width           =   1212
   End
   Begin CommandButton FindString
      Caption         =   "FindString"
      Height          =   372
      Left            =   2304
      TabIndex        =   2
      Tag             =   "SendMessage(GetFocus(), LB_FINDSTRING, ByVal startAt%, ByVal theString$)"
      Top             =   1344
      Width           =   1212
   End
   Begin CommandButton ResetContent
      Caption         =   "ResetContent"
      Height          =   372
      Left            =   3744
      TabIndex        =   9
      Tag             =   "SendMessage(GetFocus(), LB_RESETCONTENT, 0%, 0&)"
      Top             =   768
      Width           =   1212
   End
   Begin CommandButton SetTopIndex
      Caption         =   "SetTopIndex"
      Height          =   372
      Left            =   2304
      TabIndex        =   6
      Tag             =   "SendMessage(GetFocus(), LB_SETTOPINDEX, ByVal Index%, 0&)"
      Top             =   768
      Width           =   1212
   End
   Begin CommandButton GetTextLen
      Caption         =   "GetTextLen"
      Height          =   372
      Left            =   3744
      TabIndex        =   7
      Tag             =   "SendMessage(GetFocus(), LB_GETTEXTLEN, ByVal listEntry%, 0&)"
      Top             =   192
      Width           =   1212
   End
   Begin CommandButton TopIndex
      Caption         =   "GetTopIndex"
      Height          =   372
      Left            =   2304
      TabIndex        =   0
      Tag             =   "SendMessage(GetFocus(), LB_GETTOPINDEX, 0%, 0&)"
      Top             =   192
      Width           =   1212
   End
   Begin ListBox theList
      BackColor       =   &H00C0C0C0&
      Height          =   3345
      Left            =   96
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   96
      Width           =   2055
   End
DefInt A-Z
Dim result&
Sub FillErUp_Click ()
' fill the list box with some predictable garbage
' text strings must be terminated by Chr$(0)
  Cls                   'we'll display results on the form
  theList.SetFocus
  result& = SendMessage(GetFocus(), LB_RESETCONTENT, 0, 0&)
  For i = 0 To 24
    For j = 0 To 24
      a$ = Chr$(Asc("A") + i) + " " + Chr$(Asc("A") + j) + Str$(i * 25 + j) + Chr$(0)
      result& = SendMessage(GetFocus(), LB_ADDSTRING, 0, ByVal a$)
      ' result& at this point contains the index number of
      ' the just added item (in contrast to theList.AddItem)
    Next
    x = DoEvents()      'give other tasks some breathing space too, and see
                        'the list box fill up (if your PC is slow enough...)
  Next
  Cls
  showResult FillErUp
End Sub
Sub FindString_Click ()
' finds a string (MS call it "prefix") but doesn't select it
' (see LB_SELECTSTRING for find-and-select)
' the search string must be terminated by Chr$(0)
' "startingAt" selects the entry at which the search starts
' (wraps around if necessary). "-1" starts at the top.
  theList.SetFocus
  startingAt = -1
  a$ = Chr$(Asc("A") + Rnd * 24) + " " + Chr$(Asc("A") + Rnd * 24) + Chr$(0)
  result& = SendMessage(GetFocus(), LB_FINDSTRING, ByVal startingAt, ByVal a$)
  Cls
  showResult FindString
End Sub
Sub Form_Load ()
  LB_function.Show
End Sub
Sub Form_Unload (Cancel As Integer)
  Unload LB_function
End Sub
Sub GetCurSel_Click ()
' returns the index number of the currently selected
' list box entry or LB_ERR if none selected
  theList.SetFocus
  result& = SendMessage(GetFocus(), LB_GETCURSEL, 0, 0&)
  Cls
  showResult GetCurSel
End Sub
Sub GetDir_Click ()
  filespecs$ = "c:\*.*" 'filespec string; anything valid in a DIR command
  DOS_attr& = &H4037
                        'DOS attributes as follows (combine as needed using OR):
                        '&H0000 = read/write files, no add'l attributes
                        '&H0001 = read-only files
                        '&H0002 = hidden files
                        '&H0004 = system files
                        '&H0010 = subdirectories
                        '&H0020 = archives
                        '&H4000 = drives
                        '&H8000 = exclusive bit. If set, only files of the
                        '         specified type are listed.
  theList.SetFocus
  result& = SendMessage(GetFocus(), LB_DIR, ByVal DOS_attr&, filespecs$)
  'result& = number of items minus one
  Cls
  showResult GetDir
End Sub
Sub GetTextLen_Click ()
' gets the length in characters of an entry in the list box
' (here: length of currently selected entry found by
' LB_GETCURSEL).
  theList.SetFocus
  curr = SendMessage(GetFocus(), LB_GETCURSEL, 0, 0&)
  result& = SendMessage(GetFocus(), LB_GETTEXTLEN, ByVal curr, 0&)
  Cls
  showResult GetTextLen
End Sub
Sub More_Click ()
  theList.SetFocus
  result& = SendMessage(GetFocus(), LB_RESETCONTENT, 0, 0&)
  GetDir.Visible = False
  More.Visible = False
  LB_msgs.Height = More.Top + 550
  LB_msgs.Width = QuitThis.Left + QuitThis.Width + 250
  FillErUp_Click
End Sub
Sub QuitThis_Click ()
  Unload LB_msgs       'self-documenting, don't you think?
End Sub
Sub ResetContent_Click ()
' clear list box contents. Much faster than VB
  theList.SetFocus
  result& = SendMessage(GetFocus(), LB_RESETCONTENT, 0, 0&)
  Cls
  showResult ResetContent
End Sub
Sub SelectString_Click ()
' finds a search string and selects the list box entry (unlike LB_FINDSTRING).
' the search string must be terminated by Chr$(0). "startingAt"
' sets the entry where searching should start (wraps around if
' necessary). "-1" starts at the top.
  theList.SetFocus
  startingAt = -1
  a$ = Chr$(Asc("A") + Rnd * 24) + " " + Chr$(Asc("A") + Rnd * 24) + Chr$(0)
  result& = SendMessage(GetFocus(), LB_SELECTSTRING, ByVal startingAt, ByVal a$)
  Cls
  showResult SelectString
End Sub
Sub SetCurSel_Click ()
' sets current selection
  theList.SetFocus
  a = Rnd * 25 * 25         'random nth entry
  result& = SendMessage(GetFocus(), LB_SETCURSEL, ByVal a, 0&)
  Cls
  result& = a
  showResult SetCurSel
End Sub
Sub SetTopIndex_Click ()
' sets current top (= visible) entry in list box
  theList.SetFocus
  a = Rnd * 25 * 25             'random nth entry
  result& = SendMessage(GetFocus(), LB_SETTOPINDEX, ByVal a, 0&)
  Cls
  result& = a
  showResult SetTopIndex
End Sub
Sub showResult (c As Control)
  LB_msgs.CurrentX = c.Left
  LB_msgs.CurrentY = c.Top + c.Height
  Print Format$(result&, "0")
  LB_function.Label1.Caption = c.Tag
End Sub
Sub TopIndex_Click ()
' returns the index of the top (= first visible) item
  theList.SetFocus
  result& = SendMessage(GetFocus(), LB_GETTOPINDEX, 0, 0&)
  Cls
  showResult TopIndex
End Sub