home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmChooseFields
- Appearance = 0 'Flat
- BackColor = &H80000005&
- BorderStyle = 3 'Fixed Dialog
- Caption = "Choose Inventory Fields"
- ClientHeight = 2295
- ClientLeft = 165
- ClientTop = 1605
- ClientWidth = 6195
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 0
- weight = 700
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- ForeColor = &H80000008&
- Height = 2700
- Left = 105
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 2295
- ScaleWidth = 6195
- Top = 1260
- Width = 6315
- Begin VB.CommandButton btnCancel
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "&Cancel"
- Height = 375
- Left = 5100
- TabIndex = 9
- Top = 480
- Width = 1035
- End
- Begin VB.CommandButton btnOK
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "&Ok"
- Height = 375
- Left = 5100
- TabIndex = 8
- Top = 60
- Width = 1035
- End
- Begin VB.ListBox ctlUsedList
- Appearance = 0 'Flat
- Height = 2175
- Left = 3120
- TabIndex = 1
- Top = 60
- Width = 1935
- End
- Begin VB.ListBox ctlUnusedList
- Appearance = 0 'Flat
- Height = 2175
- Left = 60
- TabIndex = 0
- Top = 60
- Width = 1935
- End
- Begin Threed.SSCommand btnMoveDown
- Height = 375
- Left = 5100
- TabIndex = 7
- Top = 1860
- Width = 1035
- _Version = 65536
- _ExtentX = 1826
- _ExtentY = 661
- _StockProps = 78
- Picture = "FIELDS.frx":0000
- End
- Begin Threed.SSCommand btnMoveUp
- Height = 360
- Left = 5100
- TabIndex = 6
- Top = 1440
- Width = 1020
- _Version = 65536
- _ExtentX = 1799
- _ExtentY = 635
- _StockProps = 78
- Picture = "FIELDS.frx":0112
- End
- Begin Threed.SSCommand btnDeleteAll
- Height = 375
- Left = 2040
- TabIndex = 5
- Top = 1860
- Width = 1035
- _Version = 65536
- _ExtentX = 1826
- _ExtentY = 661
- _StockProps = 78
- Picture = "FIELDS.frx":0224
- End
- Begin Threed.SSCommand btnDelete
- Height = 375
- Left = 2040
- TabIndex = 4
- Top = 1260
- Width = 1035
- _Version = 65536
- _ExtentX = 1826
- _ExtentY = 661
- _StockProps = 78
- Picture = "FIELDS.frx":03B6
- End
- Begin Threed.SSCommand btnAdd
- Height = 375
- Left = 2040
- TabIndex = 3
- Top = 660
- Width = 1035
- _Version = 65536
- _ExtentX = 1826
- _ExtentY = 661
- _StockProps = 78
- Picture = "FIELDS.frx":04C8
- End
- Begin Threed.SSCommand btnAddAll
- Height = 375
- Left = 2040
- TabIndex = 2
- Top = 60
- Width = 1035
- _Version = 65536
- _ExtentX = 1826
- _ExtentY = 661
- _StockProps = 78
- Picture = "FIELDS.frx":05DA
- End
- Attribute VB_Name = "frmChooseFields"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- ' -----------------------------------------------------------------------------
- ' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
- ' You have a royalty-free right to use, modify, reproduce and distribute
- ' the Sample Application Files (and/or any modified version) in any way
- ' you find useful, provided that you agree that Visio has no warranty,
- ' obligations or liability for any Sample Application Files.
- ' -----------------------------------------------------------------------------
- Option Explicit
- Option Base 1
- '-- Specifies if OK was pressed before unloading.
- Dim m_iOkPushed As Integer
- '-- List Declarations : We keep three globals to maintain the used and unused
- '-- list boxes. m_iUnusedCount maintains the number of
- '-- unused fields. The two global lists are self explani-
- '-- tory. Note that they are always dimension to be as
- '-- large as FieldCount since either may grow that large.
- '-- This offers a pretty easy way to manipulate the order
- '-- as well as who is used or not and isn't too tricky.
- Dim m_iUnusedCount As Integer
- Dim m_UnusedList() As Integer
- Dim m_UsedList() As Integer
- Private Sub btnAdd_Click()
- '------------------------------------
- '--- btnAdd_Click -------------------
- '-- When the add button is pressed we move the field index from the unused
- '-- list box to the end of the Used list. We must then slide all indexes past
- '-- it down one in the array.
- Dim I As Integer, iPos As Integer
- If ctlUnusedList.ListIndex = -1 Or ctlUnusedList.ListCount < 1 Then Exit Sub
- iPos = ctlUnusedList.ListIndex + 1
- m_iUnusedCount = m_iUnusedCount - 1
- m_UsedList(FieldCount() - m_iUnusedCount) = m_UnusedList(iPos)
- If iPos < ctlUnusedList.ListCount Then
- For I = iPos To m_iUnusedCount
- m_UnusedList(I) = m_UnusedList(I + 1)
- Next I
- End If
- UpdateListBoxes -1, -1
- End Sub
- Private Sub btnAddAll_Click()
- '------------------------------------
- '--- btnAddAll_Click ----------------
- '-- Adds all unused fields to the end of the used array
- Dim I As Integer
- For I = 1 To FieldCount()
- m_UsedList(I) = I - 1
- Next I
- m_iUnusedCount = 0
- UpdateListBoxes -1, -1
- End Sub
- Private Sub btnCancel_Click()
- m_iOkPushed = False
- Unload frmChooseFields
- End Sub
- Private Sub btnDelete_Click()
- '------------------------------------
- '--- btnDelete_Click ----------------
- '-- When the delete button is pressed we move the field index from the used
- '-- list to the unused one. It is appended to the end of it. We must then
- '-- slide all the indexes above it down in the array by one.
- Dim I As Integer, iPos As Integer
- If ctlUsedList.ListIndex = -1 Or ctlUsedList.ListCount < 2 Then Exit Sub
- iPos = ctlUsedList.ListIndex + 1
- m_iUnusedCount = m_iUnusedCount + 1
- m_UnusedList(m_iUnusedCount) = m_UsedList(iPos)
- If iPos < ctlUsedList.ListCount Then
- For I = iPos To FieldCount() - m_iUnusedCount
- m_UsedList(I) = m_UsedList(I + 1)
- Next I
- End If
- UpdateListBoxes -1, -1
- End Sub
- Private Sub btnDeleteAll_Click()
- '------------------------------------
- '--- btnDeleteAll_Click -------------
- '-- Moves every field to the unused list except the first field in the
- '-- used list. This is because there must be at least one field included.
- Dim I As Integer, iPos As Integer
- iPos = 0
- For I = 1 To FieldCount() '-- For Each Field...
- If m_UsedList(1) <> I - 1 Then '-- If Not First Used...
- iPos = iPos + 1 '--
- m_UnusedList(iPos) = I - 1 '-- Copy It!
- End If
- Next I
- m_iUnusedCount = FieldCount() - 1 '-- Set Unused Count
- UpdateListBoxes -1, -1 '-- Update Lists
- End Sub
- Private Sub btnMoveDown_Click()
- '------------------------------------
- '--- btnMoveDown_Click --------------
- '-- When the down arrow button is pushed we move the selected used list field
- '-- down one in the list unless it's already at the bottom.
- Dim iTemp As Integer, iPos As Integer
- If ctlUsedList.ListIndex = -1 Or ctlUsedList.ListCount < 1 Then Exit Sub
- If Not (ctlUsedList.ListIndex + 1 < ctlUsedList.ListCount) Then Exit Sub
-
- iPos = ctlUsedList.ListIndex + 1
- iTemp = m_UsedList(iPos)
- m_UsedList(iPos) = m_UsedList(iPos + 1)
- m_UsedList(iPos + 1) = iTemp
- UpdateListBoxes (ctlUnusedList.ListIndex), iPos
- End Sub
- Private Sub btnMoveUp_Click()
- '------------------------------------
- '--- btnMoveUp_Click ----------------
- '-- When the user clicks the up arrow button we move one of the fields in
- '-- the used list up a notch if and only if it's not at the top of the list.
- Dim iTemp As Integer, iPos As Integer
- If ctlUsedList.ListIndex = -1 Or ctlUsedList.ListIndex < 1 Then Exit Sub
- If ctlUsedList.ListCount < 1 Then Exit Sub
-
- iPos = ctlUsedList.ListIndex + 1
- iTemp = m_UsedList(iPos)
- m_UsedList(iPos) = m_UsedList(iPos - 1)
- m_UsedList(iPos - 1) = iTemp
- UpdateListBoxes (ctlUnusedList.ListIndex), iPos - 2
- End Sub
- Private Sub btnOK_Click()
- '------------------------------------
- '--- btnOK_Click --------------------
- '-- When OK is clicked we loop through the used and unused list and set their
- '-- include flags in the main fields list. After that we simply unload the form.
- Dim I As Integer, iTemp As Integer
- iTemp = SetIncludeFlag(m_UsedList(1), True)
- For I = 0 To FieldCount() - 1
- If I <> m_UsedList(1) Then
- If Not SetIncludeFlag(I, False) Then
- MsgBox "Error Setting Include Flag (Reset)"
- End If
- End If
- Next I
- For I = 1 To FieldCount() - m_iUnusedCount
- If Not SetIncludeFlag(m_UsedList(I), True) Then
- MsgBox "Error Setting Include Flag (Used)"
- End If
- Next I
- m_iOkPushed = True
- Unload frmChooseFields
- End Sub
- Private Sub ctlUnusedList_DblClick()
- btnAdd_Click
- End Sub
- Private Sub ctlUsedList_DblClick()
- btnDelete_Click
- End Sub
- Private Function DoModal() As Integer
- frmChooseFields.Show 1
- DoModal = m_iOkPushed
- End Function
- Private Sub Form_Load()
- '------------------------------------
- '--- Form_Load ----------------------
- '-- Upon loading we initialize the used and unused lists. Then we update
- '-- their list boxes.
- Dim I As Integer, iUnused As Integer, iTemp As Integer
- m_iUnusedCount = FieldCount() - IncludeCount()
- If FieldCount() = 0 Then Unload frmChooseFields
- ReDim m_UsedList(FieldCount())
- ReDim m_UnusedList(FieldCount())
- For I = 0 To FieldCount() - 1
- iTemp = IncludeIndex(I)
- If iTemp <> -1 Then
- m_UsedList(iTemp + 1) = I
- Else
- iUnused = iUnused + 1
- m_UnusedList(iUnused) = I
- End If
- Next I
- UpdateListBoxes -1, -1
- End Sub
- Private Sub UpdateListBoxes(iUnUsedIndex As Integer, iUsedIndex As Integer)
- '------------------------------------
- '--- UpdateListBoxes ----------------
- '-- Updates the used and unused list boxes to reflect their respective fields.
- Dim I As Integer
- ctlUsedList.Clear '-- Clear List Boxes
- ctlUnusedList.Clear
- If FieldCount() - m_iUnusedCount > 0 Then
- For I = 1 To FieldCount() - m_iUnusedCount
- ctlUsedList.AddItem FieldNames(m_UsedList(I))
- Next I
- If iUsedIndex <> -1 Then ctlUsedList.ListIndex = iUsedIndex
- End If
- If m_iUnusedCount > 0 Then
- For I = 1 To m_iUnusedCount
- ctlUnusedList.AddItem FieldNames(m_UnusedList(I))
- Next I
- If iUnUsedIndex <> -1 Then ctlUnusedList.ListIndex = iUnUsedIndex
- End If
- End Sub
-