PC World Komputer 1999 January

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

/ PC World Komputer 1999 January / pcwk_01_1999.iso / Wtestowe / Vistdstd / Install / Data.Z / Fields.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1996-09-04 | 12.3 KB | 332 lines

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