home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 November / pcwk_11_98a.iso / Wtestowe / Vistdtk / Install / Data.Z / Fields.FRM < prev    next >
Text File  |  1996-09-04  |  13KB  |  423 lines

  1. VERSION 4.00
  2. Begin VB.Form frmChooseFields 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    BorderStyle     =   3  'Fixed Dialog
  6.    Caption         =   "Choose Inventory Fields"
  7.    ClientHeight    =   2295
  8.    ClientLeft      =   165
  9.    ClientTop       =   1605
  10.    ClientWidth     =   6195
  11.    BeginProperty Font 
  12.       name            =   "MS Sans Serif"
  13.       charset         =   0
  14.       weight          =   700
  15.       size            =   8.25
  16.       underline       =   0   'False
  17.       italic          =   0   'False
  18.       strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    Height          =   2700
  22.    Left            =   105
  23.    LinkTopic       =   "Form1"
  24.    MaxButton       =   0   'False
  25.    MinButton       =   0   'False
  26.    ScaleHeight     =   2295
  27.    ScaleWidth      =   6195
  28.    Top             =   1260
  29.    Width           =   6315
  30.    Begin VB.CommandButton btnCancel 
  31.       Appearance      =   0  'Flat
  32.       BackColor       =   &H80000005&
  33.       Caption         =   "&Cancel"
  34.       Height          =   375
  35.       Left            =   5100
  36.       TabIndex        =   9
  37.       Top             =   480
  38.       Width           =   1035
  39.    End
  40.    Begin VB.CommandButton btnOK 
  41.       Appearance      =   0  'Flat
  42.       BackColor       =   &H80000005&
  43.       Caption         =   "&Ok"
  44.       Height          =   375
  45.       Left            =   5100
  46.       TabIndex        =   8
  47.       Top             =   60
  48.       Width           =   1035
  49.    End
  50.    Begin VB.ListBox ctlUsedList 
  51.       Appearance      =   0  'Flat
  52.       Height          =   2175
  53.       Left            =   3120
  54.       TabIndex        =   1
  55.       Top             =   60
  56.       Width           =   1935
  57.    End
  58.    Begin VB.ListBox ctlUnusedList 
  59.       Appearance      =   0  'Flat
  60.       Height          =   2175
  61.       Left            =   60
  62.       TabIndex        =   0
  63.       Top             =   60
  64.       Width           =   1935
  65.    End
  66.    Begin Threed.SSCommand btnMoveDown 
  67.       Height          =   375
  68.       Left            =   5100
  69.       TabIndex        =   7
  70.       Top             =   1860
  71.       Width           =   1035
  72.       _Version        =   65536
  73.       _ExtentX        =   1826
  74.       _ExtentY        =   661
  75.       _StockProps     =   78
  76.       Picture         =   "FIELDS.frx":0000
  77.    End
  78.    Begin Threed.SSCommand btnMoveUp 
  79.       Height          =   360
  80.       Left            =   5100
  81.       TabIndex        =   6
  82.       Top             =   1440
  83.       Width           =   1020
  84.       _Version        =   65536
  85.       _ExtentX        =   1799
  86.       _ExtentY        =   635
  87.       _StockProps     =   78
  88.       Picture         =   "FIELDS.frx":0112
  89.    End
  90.    Begin Threed.SSCommand btnDeleteAll 
  91.       Height          =   375
  92.       Left            =   2040
  93.       TabIndex        =   5
  94.       Top             =   1860
  95.       Width           =   1035
  96.       _Version        =   65536
  97.       _ExtentX        =   1826
  98.       _ExtentY        =   661
  99.       _StockProps     =   78
  100.       Picture         =   "FIELDS.frx":0224
  101.    End
  102.    Begin Threed.SSCommand btnDelete 
  103.       Height          =   375
  104.       Left            =   2040
  105.       TabIndex        =   4
  106.       Top             =   1260
  107.       Width           =   1035
  108.       _Version        =   65536
  109.       _ExtentX        =   1826
  110.       _ExtentY        =   661
  111.       _StockProps     =   78
  112.       Picture         =   "FIELDS.frx":03B6
  113.    End
  114.    Begin Threed.SSCommand btnAdd 
  115.       Height          =   375
  116.       Left            =   2040
  117.       TabIndex        =   3
  118.       Top             =   660
  119.       Width           =   1035
  120.       _Version        =   65536
  121.       _ExtentX        =   1826
  122.       _ExtentY        =   661
  123.       _StockProps     =   78
  124.       Picture         =   "FIELDS.frx":04C8
  125.    End
  126.    Begin Threed.SSCommand btnAddAll 
  127.       Height          =   375
  128.       Left            =   2040
  129.       TabIndex        =   2
  130.       Top             =   60
  131.       Width           =   1035
  132.       _Version        =   65536
  133.       _ExtentX        =   1826
  134.       _ExtentY        =   661
  135.       _StockProps     =   78
  136.       Picture         =   "FIELDS.frx":05DA
  137.    End
  138. End
  139. Attribute VB_Name = "frmChooseFields"
  140. Attribute VB_Creatable = False
  141. Attribute VB_Exposed = False
  142. ' -----------------------------------------------------------------------------
  143. ' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
  144. '
  145. ' You have a royalty-free right to use, modify, reproduce and distribute
  146. ' the Sample Application Files (and/or any modified version) in any way
  147. ' you find useful, provided that you agree that Visio has no warranty,
  148. ' obligations or liability for any Sample Application Files.
  149. ' -----------------------------------------------------------------------------
  150.  
  151. Option Explicit
  152. Option Base 1
  153.  
  154. '-- Specifies if OK was pressed before unloading.
  155.  
  156. Dim m_iOkPushed As Integer
  157.  
  158. '--
  159. '-- List Declarations : We keep three globals to maintain the used and unused
  160. '--                     list boxes.  m_iUnusedCount maintains the number of
  161. '--                     unused fields.  The two global lists are self explani-
  162. '--                     tory.  Note that they are always dimension to be as
  163. '--                     large as FieldCount since either may grow that large.
  164. '--                     This offers a pretty easy way to manipulate the order
  165. '--                     as well as who is used or not and isn't too tricky.
  166. '--
  167.  
  168. Dim m_iUnusedCount As Integer
  169.  
  170. Dim m_UnusedList() As Integer
  171. Dim m_UsedList() As Integer
  172.  
  173. Private Sub btnAdd_Click()
  174. '------------------------------------
  175. '--- btnAdd_Click -------------------
  176. '--
  177. '--   When the add button is pressed we move the field index from the unused
  178. '-- list box to the end of the Used list.  We must then slide all indexes past
  179. '-- it down one in the array.
  180. '--
  181.  
  182.     Dim I As Integer, iPos As Integer
  183.  
  184.     If ctlUnusedList.ListIndex = -1 Or ctlUnusedList.ListCount < 1 Then Exit Sub
  185.  
  186.     iPos = ctlUnusedList.ListIndex + 1
  187.     m_iUnusedCount = m_iUnusedCount - 1
  188.  
  189.     m_UsedList(FieldCount() - m_iUnusedCount) = m_UnusedList(iPos)
  190.     
  191.     If iPos < ctlUnusedList.ListCount Then
  192.         For I = iPos To m_iUnusedCount
  193.             m_UnusedList(I) = m_UnusedList(I + 1)
  194.         Next I
  195.     End If
  196.  
  197.     UpdateListBoxes -1, -1
  198. End Sub
  199.  
  200. Private Sub btnAddAll_Click()
  201. '------------------------------------
  202. '--- btnAddAll_Click ----------------
  203. '--
  204. '--   Adds all unused fields to the end of the used array
  205. '--
  206.  
  207.     Dim I As Integer
  208.  
  209.     For I = 1 To FieldCount()
  210.         m_UsedList(I) = I - 1
  211.     Next I
  212.  
  213.     m_iUnusedCount = 0
  214.  
  215.     UpdateListBoxes -1, -1
  216. End Sub
  217.  
  218. Private Sub btnCancel_Click()
  219.     m_iOkPushed = False
  220.  
  221.     Unload frmChooseFields
  222. End Sub
  223.  
  224. Private Sub btnDelete_Click()
  225. '------------------------------------
  226. '--- btnDelete_Click ----------------
  227. '--
  228. '--   When the delete button is pressed we move the field index from the used
  229. '-- list to the unused one.  It is appended to the end of it.  We must then
  230. '-- slide all the indexes above it down in the array by one.
  231. '--
  232.  
  233.     Dim I As Integer, iPos As Integer
  234.  
  235.     If ctlUsedList.ListIndex = -1 Or ctlUsedList.ListCount < 2 Then Exit Sub
  236.  
  237.     iPos = ctlUsedList.ListIndex + 1
  238.     m_iUnusedCount = m_iUnusedCount + 1
  239.  
  240.     m_UnusedList(m_iUnusedCount) = m_UsedList(iPos)
  241.     
  242.     If iPos < ctlUsedList.ListCount Then
  243.         For I = iPos To FieldCount() - m_iUnusedCount
  244.             m_UsedList(I) = m_UsedList(I + 1)
  245.         Next I
  246.     End If
  247.  
  248.     UpdateListBoxes -1, -1
  249. End Sub
  250.  
  251. Private Sub btnDeleteAll_Click()
  252. '------------------------------------
  253. '--- btnDeleteAll_Click -------------
  254. '--
  255. '--   Moves every field to the unused list except the first field in the
  256. '-- used list.  This is because there must be at least one field included.
  257. '--
  258.  
  259.     Dim I As Integer, iPos As Integer
  260.  
  261.     iPos = 0
  262.  
  263.     For I = 1 To FieldCount()                       '-- For Each Field...
  264.         If m_UsedList(1) <> I - 1 Then              '--   If Not First Used...
  265.             iPos = iPos + 1                         '--
  266.             m_UnusedList(iPos) = I - 1                 '--     Copy It!
  267.         End If
  268.     Next I
  269.  
  270.     m_iUnusedCount = FieldCount() - 1               '-- Set Unused Count
  271.  
  272.     UpdateListBoxes -1, -1                          '-- Update Lists
  273. End Sub
  274.  
  275. Private Sub btnMoveDown_Click()
  276. '------------------------------------
  277. '--- btnMoveDown_Click --------------
  278. '--
  279. '--   When the down arrow button is pushed we move the selected used list field
  280. '-- down one in the list unless it's already at the bottom.
  281. '--
  282.  
  283.     Dim iTemp As Integer, iPos As Integer
  284.  
  285.     If ctlUsedList.ListIndex = -1 Or ctlUsedList.ListCount < 1 Then Exit Sub
  286.     If Not (ctlUsedList.ListIndex + 1 < ctlUsedList.ListCount) Then Exit Sub
  287.         
  288.     iPos = ctlUsedList.ListIndex + 1
  289.  
  290.     iTemp = m_UsedList(iPos)
  291.     m_UsedList(iPos) = m_UsedList(iPos + 1)
  292.     m_UsedList(iPos + 1) = iTemp
  293.  
  294.     UpdateListBoxes (ctlUnusedList.ListIndex), iPos
  295. End Sub
  296.  
  297. Private Sub btnMoveUp_Click()
  298. '------------------------------------
  299. '--- btnMoveUp_Click ----------------
  300. '--
  301. '--   When the user clicks the up arrow button we move one of the fields in
  302. '-- the used list up a notch if and only if it's not at the top of the list.
  303. '--
  304.  
  305.     Dim iTemp As Integer, iPos As Integer
  306.  
  307.     If ctlUsedList.ListIndex = -1 Or ctlUsedList.ListIndex < 1 Then Exit Sub
  308.     If ctlUsedList.ListCount < 1 Then Exit Sub
  309.         
  310.     iPos = ctlUsedList.ListIndex + 1
  311.  
  312.     iTemp = m_UsedList(iPos)
  313.     m_UsedList(iPos) = m_UsedList(iPos - 1)
  314.     m_UsedList(iPos - 1) = iTemp
  315.  
  316.     UpdateListBoxes (ctlUnusedList.ListIndex), iPos - 2
  317. End Sub
  318.  
  319. Private Sub btnOK_Click()
  320. '------------------------------------
  321. '--- btnOK_Click --------------------
  322. '--
  323. '--   When OK is clicked we loop through the used and unused list and set their
  324. '-- include flags in the main fields list.  After that we simply unload the form.
  325. '--
  326.  
  327.     Dim I As Integer, iTemp As Integer
  328.  
  329.     iTemp = SetIncludeFlag(m_UsedList(1), True)
  330.  
  331.     For I = 0 To FieldCount() - 1
  332.         If I <> m_UsedList(1) Then
  333.             If Not SetIncludeFlag(I, False) Then
  334.                 MsgBox "Error Setting Include Flag (Reset)"
  335.             End If
  336.         End If
  337.     Next I
  338.  
  339.     For I = 1 To FieldCount() - m_iUnusedCount
  340.         If Not SetIncludeFlag(m_UsedList(I), True) Then
  341.             MsgBox "Error Setting Include Flag (Used)"
  342.         End If
  343.     Next I
  344.  
  345.     m_iOkPushed = True
  346.     Unload frmChooseFields
  347. End Sub
  348.  
  349. Private Sub ctlUnusedList_DblClick()
  350.     btnAdd_Click
  351. End Sub
  352.  
  353. Private Sub ctlUsedList_DblClick()
  354.     btnDelete_Click
  355. End Sub
  356.  
  357. Private Function DoModal() As Integer
  358.     frmChooseFields.Show 1
  359.  
  360.     DoModal = m_iOkPushed
  361. End Function
  362.  
  363. Private Sub Form_Load()
  364. '------------------------------------
  365. '--- Form_Load ----------------------
  366. '--
  367. '--   Upon loading we initialize the used and unused lists.  Then we update
  368. '-- their list boxes.
  369. '--
  370.  
  371.     Dim I As Integer, iUnused As Integer, iTemp As Integer
  372.  
  373.     m_iUnusedCount = FieldCount() - IncludeCount()
  374.  
  375.     If FieldCount() = 0 Then Unload frmChooseFields
  376.  
  377.     ReDim m_UsedList(FieldCount())
  378.     ReDim m_UnusedList(FieldCount())
  379.     
  380.     For I = 0 To FieldCount() - 1
  381.         iTemp = IncludeIndex(I)
  382.  
  383.         If iTemp <> -1 Then
  384.             m_UsedList(iTemp + 1) = I
  385.         Else
  386.             iUnused = iUnused + 1
  387.             m_UnusedList(iUnused) = I
  388.         End If
  389.     Next I
  390.  
  391.     UpdateListBoxes -1, -1
  392. End Sub
  393.  
  394. Private Sub UpdateListBoxes(iUnUsedIndex As Integer, iUsedIndex As Integer)
  395. '------------------------------------
  396. '--- UpdateListBoxes ----------------
  397. '--
  398. '--   Updates the used and unused list boxes to reflect their respective fields.
  399. '--
  400.  
  401.     Dim I As Integer
  402.  
  403.     ctlUsedList.Clear                           '-- Clear List Boxes
  404.     ctlUnusedList.Clear
  405.  
  406.     If FieldCount() - m_iUnusedCount > 0 Then
  407.         For I = 1 To FieldCount() - m_iUnusedCount
  408.             ctlUsedList.AddItem FieldNames(m_UsedList(I))
  409.         Next I
  410.     
  411.         If iUsedIndex <> -1 Then ctlUsedList.ListIndex = iUsedIndex
  412.     End If
  413.  
  414.     If m_iUnusedCount > 0 Then
  415.         For I = 1 To m_iUnusedCount
  416.             ctlUnusedList.AddItem FieldNames(m_UnusedList(I))
  417.         Next I
  418.  
  419.         If iUnUsedIndex <> -1 Then ctlUnusedList.ListIndex = iUnUsedIndex
  420.     End If
  421. End Sub
  422.  
  423.