Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_1 / MLIST_45 / FORM1.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1994-04-27 | 24.9 KB | 791 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 CommandButton Command3 Caption = "Price" Height = 240 Left = 3072 TabIndex = 10 Top = 2448 Width = 1644 End Begin CommandButton Command2 Caption = "Description" Height = 240 Left = 1152 TabIndex = 9 Top = 2448 Width = 1884 End Begin CommandButton Command1 Caption = "Item" Height = 240 Left = 48 TabIndex = 8 Top = 2448 Width = 1068 End Begin MListBox MList4 AddItemHeight = 0 Alignment = 0 'None AllowFocusRect = -1 'True BackColor = &H00C0C0C0& BorderStyle = 1 'Raised CheckColor = &H00000000& 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 ListBoxStyle = 0 'Fixed MaskingColor = &H00C0C0C0& MultiColumn = -1 'True MultiSelect = 0 'False NoIntegralHeight= 0 'False OwnerDraw = 0 'False RiseColor = &H00FFFFFF& SelectMode = 0 'Normal SortColumn = 0 Sorted = 0 'False StringCompare = 0 'Case Sensitive TabIndex = 7 Top = 2592 Version = "04.20" VerticalGrids = 0 'False VirtualMsgZone = 0 Width = 3420 End Begin MListBox MList3 AddItemHeight = 0 Alignment = 1 'Left AllowFocusRect = -1 'True BackColor = &H00C0C0C0& BorderStyle = 2 'Inset CheckColor = &H00000000& 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 ListBoxStyle = 0 'Fixed MaskingColor = &H00C0C0C0& MultiColumn = 0 'False MultiSelect = 0 'False NoIntegralHeight= 0 'False OwnerDraw = 0 'False RiseColor = &H00FFFFFF& SelectMode = 0 'Normal SortColumn = 0 Sorted = 0 'False StringCompare = 0 'Case Sensitive TabIndex = 4 Top = 480 Version = "04.20" VerticalGrids = 0 'False VirtualMsgZone = 0 Width = 3420 End Begin MListBox MList2 AddItemHeight = 0 Alignment = 0 'None AllowFocusRect = -1 'True BackColor = &H00FFFF00& BorderStyle = 0 'Normal CheckColor = &H00000000& 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 ListBoxStyle = 0 'Fixed MaskingColor = &H00C0C0C0& MultiColumn = 0 'False MultiSelect = 0 'False NoIntegralHeight= 0 'False OwnerDraw = 0 'False RiseColor = &H00FFFFFF& SelectMode = 0 'Normal SortColumn = 1 Sorted = -1 'True StringCompare = 0 'Case Sensitive TabIndex = 0 Top = 2688 Version = "04.20" VerticalGrids = 0 'False VirtualMsgZone = 10 Width = 4668 End Begin MListBox MList1 AddItemHeight = 0 Alignment = 0 'None AllowFocusRect = -1 'True BorderStyle = 0 'Normal CheckColor = &H00000000& CheckStyle = 0 'Cross Style DragIcon = FORM1.FRX:034E 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 ListBoxStyle = 0 'Fixed MaskingColor = &H00FFFFFF& MultiColumn = 0 'False MultiSelect = -1 'True NoIntegralHeight= 0 'False OwnerDraw = 0 'False RiseColor = &H00FFFFFF& SelectMode = 1 'Drag Mode SortColumn = 0 Sorted = -1 'True StringCompare = 0 'Case Sensitive 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:0650 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 = 2208 Width = 4668 End Begin Label Label1 BorderStyle = 1 'Fixed Single Caption = "Multi-Select Sorted List Box/Drag Drop ---->" 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 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 () If MList2.SortColumn <> 1 Then MList2.SortColumn = 1 MList2.Resort = 1 End If End Sub Sub Command2_Click () If MList2.SortColumn <> 2 Then MList2.SortColumn = 2 MList2.Resort = 1 End If End Sub Sub Command3_Click () If MList2.SortColumn <> 3 Then MList2.SortColumn = 3 MList2.Resort = 1 End If 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 ' Set MList1.ListBoxStyle to FIXED and uncomment these lines for a variable line ' list box. Uncomment the code in MList3.Click for more examples! ' MList1.AddItemHeight = 195 MList1.AddItem "Item1" + Chr$(9) + "Information One" ' MList1.AddItemHeight = 295 MList1.AddItem "Item2" + Chr$(9) + "Information Two" ' MList1.AddItemHeight = 195 MList1.AddItem "Item3" + Chr$(9) + "Information Three" ' MList1.AddItemHeight = 295 MList1.AddItem "Item4" + Chr$(9) + "Information Four" ' MList1.AddItemHeight = 295 MList1.AddItem "Item1" + Chr$(9) + "Information One" ' MList1.AddItemHeight = 195 MList1.AddItem "Item2" + Chr$(9) + "Information Two" ' MList1.AddItemHeight = 295 MList1.AddItem "Item3" + Chr$(9) + "Information Three" ' MList1.AddItemHeight = 195 MList1.AddItem "Item4" + Chr$(9) + "Information Four" ' Change the font of item 1 MList1.ItemFontName(1) = "MS Sans Serif" MList1.ItemFontSize(1) = 7.8 MList1.ItemFontItalic(1) = True MList1.ItemFontBold(1) = True ' MList1.ItemFontUnderline(1) = True ' MList1.ItemFontStrikeThru(1) = True MList1.ItemFontSize(4) = 9 MList1.ItemFontName(4) = "Courier" MList1.ItemFontItalic(4) = True MList1.ItemFontBold(4) = True MList1.ItemFontUnderline(4) = True ' MList1.ItemFontStrikeThru(4) = True ' Print the default flags for item 1 Debug.Print "Item1 DrawFlags: " + MList1.DrawFlags(1) Debug.Print "Font Size: "; MList1.ItemFontSize(1) Debug.Print "Font Name: "; MList1.ItemFontName(1) Debug.Print "Italic: "; MList1.ItemFontItalic(1) Debug.Print "Bold: "; MList1.ItemFontBold(1) Debug.Print "Underline: "; MList1.ItemFontUnderline(1) Debug.Print "StrikeThru:"; MList1.ItemFontStrikeThru(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 MList1_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) If Button And 1 Then MList1.Drag 1 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_ScrollMessage (Offset As Integer) Debug.Print "Scroll Message:" + Str$(Offset) 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 MList3_Click () ' Uncomment this line to test adjusting individual line heights ' MList1.IndItemHeight(2) = 495 End Sub Sub MList3_DragDrop (Source As Control, X As Single, Y As Single) MList3.ItemX = X MList3.ItemY = Y Debug.Print "MList3 has been dropped upon at Item" + Str$(MList3.Item) + "!" End Sub Sub MList3_DragOver (Source As Control, X As Single, Y As Single, State As Integer) MList3.ItemX = X MList3.ItemY = Y If MList3.ListIndex <> MList3.Item Then MList3.ListIndex = MList3.Item 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