Monster Media 1994 #1/monster.zip/monster/PROG_BAS/MLIST.ZIP/FORM1.FRM

Text File | 1994-02-06 | 21KB | 873 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Multi-Column Demo"
   ClientHeight    =   4404
   ClientLeft      =   456
   ClientTop       =   1800
   ClientWidth     =   8592
   FontBold        =   0   'False
   FontItalic      =   -1  'True
   FontName        =   "MS Sans Serif"
   FontSize        =   12
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   5148
   Left            =   408
   LinkTopic       =   "Form1"
   ScaleHeight     =   4404
   ScaleWidth      =   8592
   Top             =   1104
   Width           =   8688
   Begin MListBox MList4
      Alignment       =   0  'None
      AllowFocusRect  =   -1  'True
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Raised
      CheckStyle      =   0  'Cross Style
      DefPicture      =   FORM1.FRX:0000
      DrawRegions     =   1
      EnableVirtualMsgs=   0   'False
      ExtendedSelect  =   0   'False
      FallColor       =   &H00808080&
      FindDirection   =   0  'Forward
      GridColor       =   &H00000000&
      GridStyle       =   0  'Solid
      Height          =   1524
      HiliteBackColor =   &H00000000&
      HiliteForeColor =   &H00000000&
      HorizontalGrids =   0   'False
      ImageRegion     =   0
      ImageType       =   3  'Aligned Bitmap
      ItemHeight      =   300
      ItemWidth       =   1500
      Left            =   4944
      MaskingColor    =   &H00C0C0C0&
      MultiColumn     =   -1  'True
      MultiSelect     =   0   'False
      RiseColor       =   &H00FFFFFF&
      Sorted          =   0   'False
      TabIndex        =   7
      Top             =   2592
      Version         =   "04.20"
      VerticalGrids   =   0   'False
      VirtualMsgZone  =   0
      Width           =   3420
   End
   Begin MListBox MList3
      Alignment       =   1  'Left
      AllowFocusRect  =   -1  'True
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   2  'Inset
      CheckStyle      =   0  'Cross Style
      DefPicture      =   FORM1.FRX:011A
      DrawRegions     =   1
      EnableVirtualMsgs=   0   'False
      ExtendedSelect  =   0   'False
      FallColor       =   &H00808080&
      FindDirection   =   0  'Forward
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      GridColor       =   &H00000000&
      GridStyle       =   0  'Solid
      Height          =   1536
      HiliteBackColor =   &H00000000&
      HiliteForeColor =   &H00FFFFFF&
      HorizontalGrids =   0   'False
      ImageRegion     =   0
      ImageType       =   3  'Aligned Bitmap
      ItemHeight      =   500
      ItemWidth       =   780
      Left            =   4944
      MaskingColor    =   &H00C0C0C0&
      MultiColumn     =   0   'False
      MultiSelect     =   0   'False
      RiseColor       =   &H00FFFFFF&
      Sorted          =   0   'False
      TabIndex        =   4
      Top             =   480
      Version         =   "04.20"
      VerticalGrids   =   0   'False
      VirtualMsgZone  =   0
      Width           =   3420
   End
   Begin MListBox MList2
      Alignment       =   0  'None
      AllowFocusRect  =   -1  'True
      BackColor       =   &H00FFFF00&
      BorderStyle     =   0  'Normal
      CheckStyle      =   1  'Check Mark
      DefPicture      =   FORM1.FRX:0234
      DrawRegions     =   4
      EnableVirtualMsgs=   -1  'True
      ExtendedSelect  =   0   'False
      FallColor       =   &H00808080&
      FindDirection   =   0  'Forward
      FontBold        =   0   'False
      FontItalic      =   -1  'True
      FontName        =   "MS Sans Serif"
      FontSize        =   9.6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00004080&
      GridColor       =   &H00000000&
      GridStyle       =   0  'Solid
      Height          =   1524
      HiliteBackColor =   &H00000000&
      HiliteForeColor =   &H00000000&
      HorizontalGrids =   0   'False
      ImageRegion     =   1
      ImageType       =   0  'None
      ItemHeight      =   300
      ItemWidth       =   780
      Left            =   48
      MaskingColor    =   &H00C0C0C0&
      MultiColumn     =   0   'False
      MultiSelect     =   0   'False
      RiseColor       =   &H00FFFFFF&
      Sorted          =   0   'False
      TabIndex        =   0
      Top             =   2592
      Version         =   "04.20"
      VerticalGrids   =   0   'False
      VirtualMsgZone  =   10
      Width           =   4668
   End
   Begin MListBox MList1
      Alignment       =   0  'None
      AllowFocusRect  =   -1  'True
      BorderStyle     =   0  'Normal
      CheckStyle      =   0  'Cross Style
      DrawRegions     =   3
      EnableVirtualMsgs=   0   'False
      ExtendedSelect  =   -1  'True
      FallColor       =   &H00808080&
      FindDirection   =   0  'Forward
      GridColor       =   &H00C0C0C0&
      GridStyle       =   0  'Solid
      Height          =   1752
      HiliteBackColor =   &H00000000&
      HiliteForeColor =   &H00000000&
      HorizontalGrids =   -1  'True
      ImageRegion     =   0
      ImageType       =   0  'None
      ItemHeight      =   195
      ItemWidth       =   780
      Left            =   48
      MaskingColor    =   &H00FFFFFF&
      MultiColumn     =   0   'False
      MultiSelect     =   -1  'True
      RiseColor       =   &H00FFFFFF&
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   432
      Version         =   "04.20"
      VerticalGrids   =   -1  'True
      VirtualMsgZone  =   0
      Width           =   4668
   End
   Begin Label Label4
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Multi-Column Style Bitmapped List Box"
      Height          =   252
      Left            =   4944
      TabIndex        =   6
      Top             =   2304
      Width           =   3420
   End
   Begin Label Label3
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Bitmapped List Box"
      Height          =   252
      Left            =   4944
      TabIndex        =   5
      Top             =   144
      Width           =   3420
   End
   Begin Image Image1
      Height          =   240
      Left            =   96
      Picture         =   FORM1.FRX:034E
      Top             =   4176
      Visible         =   0   'False
      Width           =   180
   End
   Begin Label Label2
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Normal List Box - Color, Font, Bitmaps, CheckBoxes"
      Height          =   252
      Left            =   48
      TabIndex        =   3
      Top             =   2304
      Width           =   4668
   End
   Begin Label Label1
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Multi-Select Sorted List Box"
      Height          =   252
      Left            =   48
      TabIndex        =   2
      Top             =   144
      Width           =   4668
   End
   Begin Menu mnuMultiSelect
      Caption         =   "&Multi-Select"
      Begin Menu mnuSelected
         Caption         =   "&Selected"
      End
      Begin Menu mnuMListCount
         Caption         =   "&ListCount"
      End
      Begin Menu mnuSelCount
         Caption         =   "Sel&Count"
      End
      Begin Menu mnuMListIndex
         Caption         =   "List&Index"
      End
      Begin Menu mnuRange
         Caption         =   "Select/&Deselect Range"
      End
      Begin Menu mnuFocus
         Caption         =   "&Focus"
      End
   End
   Begin Menu mnuNormal
      Caption         =   "&Normal"
      Begin Menu mnuText
         Caption         =   "&Text"
      End
      Begin Menu mnuListCount
         Caption         =   "&ListCount"
      End
      Begin Menu mnuListIndex
         Caption         =   "List&Index"
      End
      Begin Menu mnuRegular
         Caption         =   "&Regular"
      End
      Begin Menu mnuBitmap
         Caption         =   "&Bitmap"
      End
      Begin Menu mnuCheckBox
         Caption         =   "&CheckBox"
      End
      Begin Menu mnuCheckRange
         Caption         =   "Check/&Uncheck Range"
      End
   End
   Begin Menu mnuBitmapped
      Caption         =   "&Bitmapped"
      Begin Menu mnuLeft
         Caption         =   "&Left"
      End
      Begin Menu mnuTop
         Caption         =   "&Top"
      End
      Begin Menu mnuRight
         Caption         =   "&Right"
      End
      Begin Menu mnuBottom
         Caption         =   "&Bottom"
      End
   End
   Begin Menu mnuMisc
      Caption         =   "M&isc"
      Begin Menu mnuItemData
         Caption         =   "&ItemData"
      End
      Begin Menu mnuTopIndex
         Caption         =   "&TopIndex"
      End
      Begin Menu mnuNewIndex
         Caption         =   "&NewIndex"
      End
      Begin Menu mnuList
         Caption         =   "&List"
      End
      Begin Menu mnuActiveRegion
         Caption         =   "&ActiveRegion"
      End
      Begin Menu mnuListRegion
         Caption         =   "L&istRegion"
      End
      Begin Menu mnuChecked
         Caption         =   "Checked"
      End
      Begin Menu mnuCheckItem2
         Caption         =   "Check Item 2"
      End
      Begin Menu mnuUncheckTwo
         Caption         =   "Uncheck Item Two"
      End
      Begin Menu mnuTest
         Caption         =   "Test Horz. Scroll Bar"
      End
      Begin Menu mnuRemoveItem
         Caption         =   "&Remove Item"
      End
      Begin Menu mnuMove
         Caption         =   "&Move"
      End
   End
End
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Const LB_SETCOLUMNWIDTH = &H400 + 22

Sub Command1_Click ()

  Debug.Print "MList1 Count:" + MList1.ListCount

End Sub

Sub Command2_Click ()

  Debug.Print "MList1 SelCount: " + MList1.SelCount

End Sub

Sub Command4_Click ()

  Debug.Print "MList2 Count: " + MList2.ListCount

End Sub

Sub Command5_Click ()

  Debug.Print "MList2 Selected Text: " + MList2.Text

End Sub

Sub Command7_Click ()

  MList2.TopIndex = 3

End Sub

Sub Command8_Click ()

  Debug.Print "MList2.TopIndex = "; MList2.TopIndex

End Sub

Sub Form_Load ()

  Const DT_RIGHT = 2
  Const DT_VCENTER = 4
  Const DT_SINGLELINE = 32

' Columns are separated by the Tab character
' We could set the number of columns ourselves by setting MList1.DrawRegions = ####
  MList1.ItemLength(1) = 750
  MList1.ItemLength(2) = 4000

  MList1.AddItem "Item1" + Chr$(9) + "Information One"
  MList1.AddItem "Item2" + Chr$(9) + "Information Two"
  MList1.AddItem "Item3" + Chr$(9) + "Information Three"
  MList1.AddItem "Item4" + Chr$(9) + "Information Four"
  MList1.AddItem "Item1" + Chr$(9) + "Information One"
  MList1.AddItem "Item2" + Chr$(9) + "Information Two"
  MList1.AddItem "Item3" + Chr$(9) + "Information Three"
  MList1.AddItem "Item4" + Chr$(9) + "Information Four"

' Print the default flags for item 1
  Debug.Print "Item1 DrawFlags: " + MList1.DrawFlags(1)

' When you set or change DrawRegions, the default flags are DT_LEFT + DT_VCENTER + DT_SINGLELINE
' You can set the flags to any legal value used by the Windows API call DrawText
' Change the dollar column to be right justified instead
  MList2.DrawFlags(3) = DT_RIGHT + DT_VCENTER + DT_SINGLELINE

  Dim I As Integer

  For I = 0 To 4
    MList2.AddItem "Item1" + Chr$(9) + "Information One" + Chr$(9) + "$45.00"
    MList2.AddItem "Item2" + Chr$(9) + "Information Two" + Chr$(9) + "$36.69"
    MList2.AddItem "Item3" + Chr$(9) + "Information Three" + Chr$(9) + "$2234.00"
    MList2.AddItem "Item4" + Chr$(9) + "Information Four" + Chr$(9) + "$4.00"
    MList2.AddItem "Item5" + Chr$(9) + "Information Five" + Chr$(9) + "$0.25"
  Next I

  MList2.ItemLength(1) = 1000
  MList2.ItemLength(2) = 1700
  MList2.ItemLength(3) = 1300

  MList2.ItemForeColor(1) = RGB(255, 255, 255)
  MList2.ItemBkColor(1) = RGB(0, 0, 0)

  MList2.ItemHiliteForeColor(1) = RGB(255, 0, 0)
  MList2.ItemHiliteBackColor(1) = RGB(0, 0, 255)
  MList2.HiliteBackColor = RGB(192, 192, 192)
  MList2.HiliteForeColor = RGB(0, 0, 0)

  MList2.ItemData(0) = 199
  MList2.ItemData(1) = 200
  MList2.ItemData(2) = 201
  MList2.ItemData(3) = 202
  MList2.ItemData(4) = 203
  MList2.ItemData(5) = 204
  MList2.ItemData(6) = 205
  MList2.ItemData(7) = 206
  MList2.ItemData(8) = 207
  MList2.ItemData(9) = 208
  MList2.ItemData(10) = 209
  MList2.ItemData(11) = 210
  MList2.ItemData(12) = 211
  MList2.ItemData(13) = 212
  MList2.ItemData(14) = 213

' Print the default flags for item 1
  Debug.Print "Item3 DrawFlags: " + MList2.DrawFlags(3)
  Debug.Print "ItemLength(2): "; MList2.ItemLength(2)

  MList3.AddItem "Bitmap string one"
  MList3.AddItem "Bitmap string two"
  MList3.AddItem "Bitmap string three"
  MList3.AddItem "Bitmap string four"
  MList3.AddItem "Bitmap string five"

  MList3.ItemPicture(1) = Image1.Picture

  Dim X As Integer

  For X = 1 To 20
    MList4.AddItem "DOC" + Trim$(Str$(X)) + ".DOC"
  Next X

  MList4.ItemPicture(4) = Image1.Picture

  ' X = SendMessage(MList4.hWnd, LB_SETCOLUMNWIDTH, 100, 0)

End Sub

Sub MList1_Click ()

'  MsgBox "Multi-Select List Box Click", 0, "MList1"

End Sub

Sub MList1_DblClick ()

'  MsgBox "Multi-Select List Box Double Click", 0, "MList1"

End Sub

Sub MList2_DblClick ()

  If MList2.ImageType = 1 Then

    If MList2.ItemPicture(MList2.ListIndex) <> Image1.Picture Then
      MList2.ItemPicture(MList2.ListIndex) = Image1.Picture
    Else
      MList2.ItemPicture(MList2.ListIndex) = MList2.DefPicture
    End If

  End If
End Sub

Sub MList2_KeyPress (KeyAscii As Integer)

  If MList2.ImageType = 1 Then

    If MList2.ItemPicture(MList2.ListIndex) <> Image1.Picture Then
      MList2.ItemPicture(MList2.ListIndex) = Image1.Picture
    Else
      MList2.ItemPicture(MList2.ListIndex) = MList2.DefPicture
    End If

  Else

    If KeyAscii = 32 Then
      MList2.Checked(MList2.ListIndex) = Not MList2.Checked(MList2.ListIndex)
    End If

  End If
End Sub

Sub MList2_SelChange ()

  Debug.Print "SelChange on line "; MList2.ListIndex

End Sub

Sub MList2_SelCheck (Index As Integer, CheckState As Integer)

  Dim aString As String

  If CheckState Then
    aString = " On"
  Else
    aString = " Off"
  End If

  Debug.Print "Line "; Index; " is"; aString

End Sub

Sub MList2_VirtualMessage (Message As Integer)

  Dim aString As String

  Select Case Message
    Case 1
      aString = "Add At Bottom"
    Case 2
      aString = "Add At Top"
    Case 3
      aString = "Home"
    Case 4
      aString = "End"
  End Select

  Debug.Print "Scroll Message: "; aString

End Sub

Sub mnuActiveRegion_Click ()

  MList2.ActiveRegion = 2

  If MList2.ListIndex <> -1 Then

    Dim aString As String

    aString = "MList2.TextRegion = " + MList2.TextRegion
    MsgBox aString, 0, "MList2"

    MList2.TextRegion = "Replace"
    MList2.ActiveRegion = 3
    MList2.TextRegion = "$1.00"

  End If

  aString = "MList2.ListRegion(3) = " + MList2.ListRegion(3)
  MsgBox aString, 0, "MList2"

  MList2.ListRegion(3) = "Replace"

  MList1.ActiveRegion = 1

  If MList1.ListIndex <> -1 Then

    aString = "MList1.TextRegion = " + MList1.TextRegion
    MsgBox aString, 0, "MList1"

    MList1.TextRegion = "Replace"

  End If

End Sub

Sub mnuBitmap_Click ()

  MList2.ItemLength(1) = 300
  MList2.ItemLength(2) = 1000
  MList2.ItemLength(3) = 1700
  MList2.ItemLength(4) = 1300

  MList2.ItemPicture(1) = Image1.Picture

  If MList2.ImageType <> 1 Then
    MList2.ImageType = 1
    MList2.Refresh
    MList2.ItemBkColor(1) = MList2.BackColor
    MList2.ItemForeColor(1) = MList2.ForeColor
  End If

End Sub

Sub mnuBottom_Click ()

  MList3.Alignment = 4
  MList3.Refresh

End Sub

Sub mnuCheckBox_Click ()

  MList2.ItemLength(1) = 300
  MList2.ItemLength(2) = 1000
  MList2.ItemLength(3) = 1700
  MList2.ItemLength(4) = 1300

  If MList2.ImageType <> 2 Then
    MList2.ImageType = 2
    MList2.Refresh
    MList2.ItemBkColor(1) = MList2.BackColor
    MList2.ItemForeColor(1) = MList2.ForeColor
  End If

End Sub

Sub mnuChecked_Click ()

  MList2.Checked(1) = True

  Dim X%

  For X% = 0 To MList2.ListCount - 1

    If MList2.Checked(X%) Then
      Debug.Print "MList2.Checked("; X%; ") = Checked"
    Else
      Debug.Print "MList2.Checked("; X%; ") = Unchecked"
    End If

  Next X%

End Sub

Sub mnuCheckItem2_Click ()

  If MList2.ImageType = 2 Then
    MList2.Checked(2) = True
  End If

End Sub

Sub mnuCheckRange_Click ()

  If MList2.ImageType = 2 Then

    MList2.RangeStart = 0
    MList2.RangeEnd = 3

    If MList2.Checked(0) Then
      MList2.RangeChecked = False
    Else
      MList2.RangeChecked = True
    End If
  End If

End Sub

Sub mnuFocus_Click ()

  MList1.SetFocus

End Sub

Sub mnuItemData_Click ()

  Dim Count As Integer
  Dim X As Integer
  Dim aString As String

  Count = MList2.ListCount

  For X = 0 To Count - 1
    Debug.Print "ItemData" + Str$(X) + ": " + Str$(MList2.ItemData(X))
  Next

End Sub

Sub mnuLeft_Click ()

  MList3.Alignment = 1
  MList3.Refresh

End Sub

Sub mnuList_Click ()

  For I = 0 To MList2.ListCount - 1
    Debug.Print I; " - "; MList2.List(I)
  Next I

  MList2.List(2) = "Rep" + Chr$(9) + "Replacement" + Chr$(9) + "$100.00"

End Sub

Sub mnuListCount_Click ()

  Dim aString As String

  aString = "MList2.ListCount = " + Str$(MList2.ListCount)
  MsgBox aString, 0, "MList2"

End Sub

Sub mnuListIndex_Click ()

  Dim aString As String

  aString = "MList2.ListIndex = " + Str$(MList2.ListIndex)
  MsgBox aString, 0, "MList2"
  MList2.ListIndex = 2

End Sub

Sub mnuListRegion_Click ()

  MList1.ListIndex = 4
  MList1.ActiveRegion = 1
  MList1.ListRegion(4) = "List"

  MList1.ActiveRegion = 2
  MList1.TextRegion = "Change by menu"

End Sub

Sub mnuMListCount_Click ()

  Dim aString As String

  aString = "MList1.ListCount = " + Str$(MList1.ListCount)
  MsgBox aString, 0, "MList1"

End Sub

Sub mnuMListIndex_Click ()

  Dim aString As String

  aString = "MList1.ListIndex = " + Str$(MList1.ListIndex)
  MsgBox aString, 0, "MList1"

  MList1.ListIndex = 2

End Sub

Sub mnuMove_Click ()

  MList1.Move 0, 0

End Sub

Sub mnuMSText_Click ()

  MsgBox MList1.Text, 0, "Text-MList1"

End Sub

Sub mnuNewIndex_Click ()

  MList1.AddItem "Item21" + Chr$(9) + "Information TwoOne"

  Dim aString As String

  aString = "MList1.NewIndex = " + Str$(MList1.NewIndex)
  MsgBox aString, 0, "MList1"

End Sub

Sub mnuRange_Click ()

  MList1.RangeStart = 0
  MList1.RangeEnd = 3

  If MList1.Selected(1) Then
    MList1.RangeSelected = False
  Else
    MList1.RangeSelected = True
  End If

End Sub

Sub mnuRegular_Click ()

  MList2.ItemLength(1) = 1000
  MList2.ItemLength(2) = 1700
  MList2.ItemLength(3) = 1300

  If MList2.ImageType Then
    MList2.ImageType = 0
    MList2.Refresh
    MList2.ItemForeColor(1) = RGB(255, 255, 255)
    MList2.ItemBkColor(1) = RGB(0, 0, 0)
  End If

End Sub

Sub mnuRemoveItem_Click ()

  MList2.RemoveItem 2

End Sub

Sub mnuRight_Click ()

  MList3.Alignment = 3
  MList3.Refresh

End Sub

Sub mnuSelCount_Click ()

  Dim aString As String

  aString = "MList1.SelCount = " + Str$(MList1.SelCount)
  MsgBox aString, 0, "MList1"

End Sub

Sub mnuSelected_Click ()

  Dim Count As Integer
  Dim X As Integer
  Dim aString As String

  Count = MList1.ListCount

  If MList1.SelCount Then
    For X = 0 To Count - 1

      If MList1.Selected(X) Then
        aString = "True"
      Else
        aString = "False"
      End If

      Debug.Print "Item" + Str$(X) + ": " + aString
    Next
  End If

End Sub

Sub mnuTest_Click ()

  MList2.ImageType = 0
  MList2.ItemLength(1) = 1000
  MList2.ItemLength(2) = 1000
  MList2.ItemLength(3) = 1700
  MList2.ItemLength(4) = 1300

  MList2.SetHzScroll = True
End Sub

Sub mnuText_Click ()

  MsgBox MList2.Text, 0, "MList2"

End Sub

Sub mnuTop_Click ()

  MList3.Alignment = 2
  MList3.Refresh

End Sub

Sub mnuTopIndex_Click ()

  MList2.TopIndex = 6

  Dim aString As String

  aString = "MList2.TopIndex = " + Str$(MList2.TopIndex)
  MsgBox aString, 0, "MList2"

End Sub

Sub mnuUncheckTwo_Click ()

  If MList2.ImageType = 2 Then
    MList2.Checked(2) = False
  End If

End Sub