home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code1 / fieldpak / fpdemo2e.frm < prev    next >
Text File  |  1993-11-09  |  20KB  |  724 lines

  1. VERSION 2.00
  2. Begin Form EditFrm 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Multi-Sortable Address Book (FieldPack demo program 2)"
  5.    ClientHeight    =   2895
  6.    ClientLeft      =   1380
  7.    ClientTop       =   2850
  8.    ClientWidth     =   7215
  9.    ClipControls    =   0   'False
  10.    Height          =   3585
  11.    Icon            =   FPDEMO2E.FRX:0000
  12.    Left            =   1320
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   2895
  16.    ScaleWidth      =   7215
  17.    Top             =   2220
  18.    Width           =   7335
  19.    Begin TextBox txtFindString 
  20.       Height          =   315
  21.       Left            =   1320
  22.       TabIndex        =   23
  23.       Top             =   2460
  24.       Width           =   1155
  25.    End
  26.    Begin ListBox lstSortingListBox 
  27.       Height          =   225
  28.       Left            =   0
  29.       Sorted          =   -1  'True
  30.       TabIndex        =   22
  31.       Top             =   0
  32.       Visible         =   0   'False
  33.       Width           =   1545
  34.    End
  35.    Begin CommandButton cmdSort 
  36.       Caption         =   "Sort by..."
  37.       Height          =   315
  38.       Left            =   5880
  39.       TabIndex        =   21
  40.       Top             =   300
  41.       Width           =   1215
  42.    End
  43.    Begin CommandButton cmdNew 
  44.       Caption         =   "New"
  45.       Height          =   315
  46.       Left            =   5880
  47.       TabIndex        =   20
  48.       Top             =   1080
  49.       Width           =   1215
  50.    End
  51.    Begin CommandButton cmdFind 
  52.       Caption         =   "<--  Find (in current sort field)"
  53.       Height          =   315
  54.       Left            =   2610
  55.       TabIndex        =   19
  56.       Top             =   2460
  57.       Width           =   2805
  58.    End
  59.    Begin CommandButton cmdReport 
  60.       Caption         =   "Report"
  61.       Height          =   315
  62.       Left            =   5880
  63.       TabIndex        =   18
  64.       Top             =   2460
  65.       Width           =   1215
  66.    End
  67.    Begin VScrollBar vscrScroller 
  68.       Height          =   1755
  69.       Left            =   5520
  70.       Min             =   1
  71.       TabIndex        =   7
  72.       Top             =   600
  73.       Value           =   1
  74.       Width           =   255
  75.    End
  76.    Begin CommandButton cmdDelete 
  77.       Caption         =   "Delete"
  78.       Height          =   315
  79.       Left            =   5880
  80.       TabIndex        =   8
  81.       Top             =   1500
  82.       Width           =   1215
  83.    End
  84.    Begin TextBox txtPhone 
  85.       Height          =   315
  86.       Left            =   3000
  87.       TabIndex        =   6
  88.       Top             =   2040
  89.       Width           =   2415
  90.    End
  91.    Begin TextBox txtAreaCode 
  92.       Height          =   315
  93.       Left            =   1320
  94.       TabIndex        =   5
  95.       Top             =   2040
  96.       Width           =   855
  97.    End
  98.    Begin TextBox txtZip 
  99.       Height          =   315
  100.       Left            =   4080
  101.       TabIndex        =   4
  102.       Top             =   1680
  103.       Width           =   1335
  104.    End
  105.    Begin TextBox txtState 
  106.       Height          =   315
  107.       Left            =   1320
  108.       TabIndex        =   3
  109.       Top             =   1680
  110.       Width           =   855
  111.    End
  112.    Begin TextBox txtCity 
  113.       Height          =   315
  114.       Left            =   1320
  115.       TabIndex        =   2
  116.       Top             =   1320
  117.       Width           =   4095
  118.    End
  119.    Begin TextBox txtAddress 
  120.       Height          =   315
  121.       Left            =   1320
  122.       TabIndex        =   1
  123.       Top             =   960
  124.       Width           =   4095
  125.    End
  126.    Begin TextBox txtName 
  127.       Height          =   315
  128.       Left            =   1320
  129.       TabIndex        =   0
  130.       Top             =   600
  131.       Width           =   4095
  132.    End
  133.    Begin Label lblCurrentSortField 
  134.       FontBold        =   -1  'True
  135.       FontItalic      =   -1  'True
  136.       FontName        =   "MS Sans Serif"
  137.       FontSize        =   8.25
  138.       FontStrikethru  =   0   'False
  139.       FontUnderline   =   0   'False
  140.       Height          =   225
  141.       Left            =   4440
  142.       TabIndex        =   25
  143.       Top             =   300
  144.       Width           =   1215
  145.    End
  146.    Begin Label Label9 
  147.       Alignment       =   1  'Right Justify
  148.       Caption         =   "...in sort sequence by:"
  149.       Height          =   225
  150.       Left            =   2400
  151.       TabIndex        =   24
  152.       Top             =   300
  153.       Width           =   1995
  154.    End
  155.    Begin Label lblRecordID 
  156.       Caption         =   " 0 of 0"
  157.       Height          =   195
  158.       Left            =   1380
  159.       TabIndex        =   17
  160.       Top             =   300
  161.       Width           =   975
  162.    End
  163.    Begin Label Label8 
  164.       Alignment       =   1  'Right Justify
  165.       Caption         =   "Record:"
  166.       Height          =   195
  167.       Left            =   60
  168.       TabIndex        =   16
  169.       Top             =   300
  170.       Width           =   1215
  171.    End
  172.    Begin Label Label7 
  173.       Alignment       =   1  'Right Justify
  174.       Caption         =   "Phone:"
  175.       Height          =   195
  176.       Left            =   2220
  177.       TabIndex        =   15
  178.       Top             =   2100
  179.       Width           =   735
  180.    End
  181.    Begin Label Label6 
  182.       Alignment       =   1  'Right Justify
  183.       Caption         =   "Area Code:"
  184.       Height          =   195
  185.       Left            =   60
  186.       TabIndex        =   14
  187.       Top             =   2100
  188.       Width           =   1215
  189.    End
  190.    Begin Label Label5 
  191.       Alignment       =   1  'Right Justify
  192.       Caption         =   "Zip:"
  193.       Height          =   195
  194.       Left            =   3420
  195.       TabIndex        =   13
  196.       Top             =   1740
  197.       Width           =   615
  198.    End
  199.    Begin Label Label4 
  200.       Alignment       =   1  'Right Justify
  201.       Caption         =   "State:"
  202.       Height          =   195
  203.       Left            =   60
  204.       TabIndex        =   12
  205.       Top             =   1740
  206.       Width           =   1215
  207.    End
  208.    Begin Label Label3 
  209.       Alignment       =   1  'Right Justify
  210.       Caption         =   "City:"
  211.       Height          =   195
  212.       Left            =   60
  213.       TabIndex        =   11
  214.       Top             =   1380
  215.       Width           =   1215
  216.    End
  217.    Begin Label Label2 
  218.       Alignment       =   1  'Right Justify
  219.       Caption         =   "Address:"
  220.       Height          =   195
  221.       Left            =   60
  222.       TabIndex        =   10
  223.       Top             =   1020
  224.       Width           =   1215
  225.    End
  226.    Begin Label Label1 
  227.       Alignment       =   1  'Right Justify
  228.       Caption         =   "Name:"
  229.       Height          =   195
  230.       Left            =   60
  231.       TabIndex        =   9
  232.       Top             =   660
  233.       Width           =   1215
  234.    End
  235.    Begin Menu mnuFile 
  236.       Caption         =   "&File"
  237.       Begin Menu mnuExit 
  238.          Caption         =   "E&xit"
  239.       End
  240.    End
  241.    Begin Menu mnuHelp 
  242.       Caption         =   "&Help"
  243.       Begin Menu mnuAbout 
  244.          Caption         =   "&About"
  245.       End
  246.    End
  247. End
  248. Option Explicit
  249.  
  250. 'FieldPack Demo Program 2
  251. '
  252. 'November 1993
  253. '
  254. 'Software Source
  255. 'Fremont, California
  256. 'tel +1(510)623-7854
  257. 'fax +1(510)651-6039
  258. '
  259. 'Original programming, including all the
  260. 'really clever report-generation work,
  261. 'by Don Wanless
  262. '
  263. 'Rewrite and debugging, including the
  264. 'tricky New/Delete/Change stuff, and
  265. 'pedantic commentary and variable
  266. 'renaming, by Sam Cohen
  267.  
  268. Sub AdjustScrollerRange ()
  269.  
  270.         Dim i As Integer
  271.  
  272.         ScrollerChangeEnabled = False
  273.  
  274.         vscrScroller.Max = NumberOfRecords
  275.         i% = NumberOfRecords / 10
  276.         If i% < 1 Then i% = 1
  277.         vscrScroller.LargeChange = i%
  278.  
  279.         ScrollerChangeEnabled = True
  280.  
  281. End Sub
  282.  
  283. Function BuildRecord () As String
  284.     Dim rec    As String
  285.     Dim wname  As String
  286.     Dim firstn As String
  287.     Dim lastn  As String
  288.     Dim n      As Integer
  289.  
  290.     wname$ = txtName.Text
  291.     n% = DS_CountDlms(wname$, ",")
  292.     If n% = 0 Then
  293.         ' no comma, so assume firstname [middle] lastname
  294.         wname$ = US_Trim(wname$)
  295.         n% = DS_CountDlms(wname$, " ")
  296.         If n% Then
  297.             lastn$ = DS_GetField(wname$, " ", n% + 1)
  298.             firstn$ = Left$(wname$, DS_FindDlm(wname$, " ", n%) - 1)
  299.             wname$ = lastn$ + ", " + firstn$
  300.         Else
  301.             ' no blanks, use as is
  302.         End If
  303.     ElseIf n% = 1 Then
  304.         ' one comma, so assume lastname, first..., use as is
  305.     Else
  306.         ' more than one comma, ???, use as is
  307.     End If
  308.  
  309.     rec$ = ""
  310.     rec$ = DS_PutField(rec$, FldDlm$, FIELDNUMBER_NAME, US_Proper(wname$))
  311.     rec$ = DS_PutField(rec$, FldDlm$, FIELDNUMBER_ADDRESS, US_Proper((txtAddress.Text)))
  312.     rec$ = DS_PutField(rec$, FldDlm$, FIELDNUMBER_CITY, US_Proper((txtCity.Text)))
  313.     rec$ = DS_PutField(rec$, FldDlm$, FIELDNUMBER_STATE, UCase((txtState.Text)))
  314.     rec$ = DS_PutField(rec$, FldDlm$, FIELDNUMBER_ZIP, (txtZip.Text))
  315.     rec$ = DS_PutField(rec$, FldDlm$, FIELDNUMBER_AREACODE, (txtAreaCode.Text))
  316.     rec$ = DS_PutField(rec$, FldDlm$, FIELDNUMBER_PHONE, (txtPhone.Text))
  317.  
  318.     'Rearrange so that the proper sort field is in front:
  319.     rec$ = DS_GetField(rec$, FldDlm$, FirstField) + FldDlm$ + DS_RemoveField(rec$, FldDlm$, FirstField)
  320.  
  321.     BuildRecord$ = rec$
  322.  
  323. End Function
  324.  
  325. Sub cmdDelete_Click ()
  326.     Dim tmp As String
  327.  
  328.     If FlagNewRecordInProgress Then 'User hit "Delete" to cancel a "New" rec (which isn't really there).
  329.         FlagNewRecordInProgress = False
  330.     Else
  331.         tmp$ = DS_RemoveField(DatabaseMemoryBuffer$, RecDlm$, CurrentRecordNumber)
  332.         DatabaseMemoryBuffer$ = tmp$
  333.         cmdFind.Enabled = False
  334.         lblCurrentSortField.Enabled = False
  335.         FlagFileChanged = True
  336.     End If
  337.     
  338.     NumberOfRecords = NumberOfRecords - 1
  339.     
  340.     If CurrentRecordNumber = 1 Then '(code to handle boundary conditions...)
  341.         If NumberOfRecords = 0 Then
  342.             CurrentRecordNumber = 0
  343.         Else
  344.             CurrentRecordNumber = NumberOfRecords   '(Show last rec if we just deleted first rec.)
  345.         End If
  346.     Else
  347.         CurrentRecordNumber = CurrentRecordNumber - 1   '(Normally, show previous record.)
  348.     End If
  349.     
  350.     AdjustScrollerRange
  351.     
  352.     DisplayRecord
  353.  
  354. End Sub
  355.  
  356. Sub cmdFind_Click ()
  357.     Dim i   As Integer
  358.     Dim FindMe As String
  359.  
  360.     UpdateIfNecessary
  361.  
  362.     FindMe$ = txtFindString.Text
  363.     i% = DS_FindField(DatabaseMemoryBuffer$, RecDlm$, 1, FindMe$, 2 + 4) ' case insensitive find "equal to or beginning with"
  364.     If i% < 0 Then
  365.         i% = -i%
  366.     End If
  367.     If i% Then
  368.         CurrentRecordNumber = i%
  369.         DisplayRecord
  370.     End If
  371.  
  372. End Sub
  373.  
  374. Sub cmdNew_Click ()
  375.  
  376.     'Note that this does NOT put a blank record into the database.
  377.     'Instead, it (falsely) increments "NumberOfRecords" and sets
  378.     'CurrentRecordNumber to a fictitious new record at the end
  379.     'of the database.  (This is not good programming technique;
  380.     'it's dangerous to lie to yourself.)
  381.  
  382.     UpdateIfNecessary
  383.  
  384.     TextChangeEnabled = False
  385.  
  386.     txtName.Text = ""
  387.     txtAddress.Text = ""
  388.     txtCity.Text = ""
  389.     txtState.Text = ""
  390.     txtZip.Text = ""
  391.     txtAreaCode.Text = ""
  392.     txtPhone.Text = ""
  393.  
  394.     NumberOfRecords = NumberOfRecords + 1
  395.     CurrentRecordNumber = NumberOfRecords
  396.     AdjustScrollerRange
  397.  
  398.     vscrScroller.Value = CurrentRecordNumber
  399.  
  400.     lblRecordID.Caption = Str$(CurrentRecordNumber) + " of" + Str$(NumberOfRecords)
  401.  
  402.     FlagNewRecordInProgress = True
  403.     FlagRecordChanged = False
  404.     TextChangeEnabled = True
  405.  
  406.     txtName.SetFocus
  407.  
  408. End Sub
  409.  
  410. Sub cmdReport_Click ()
  411.  
  412.     UpdateIfNecessary
  413.  
  414.     ReportFrm.Show 1
  415.  
  416. End Sub
  417.  
  418. Sub cmdSort_Click ()
  419.  
  420.     UpdateIfNecessary
  421.  
  422.     txtFindString.Text = ""   'Clean up
  423.  
  424.     ' select sort field
  425.     SortFrm.Show 1
  426.  
  427.     If SortForm_OK_or_Cancel = 1 Then
  428.         Exit Sub
  429.     End If
  430.  
  431.     SortRecords
  432.     DisplayRecord
  433.  
  434. End Sub
  435.  
  436. Sub DisplayRecord ()
  437.  
  438.     Dim rec As String
  439.  
  440.     TextChangeEnabled = False   'Otherwise, setting values into text boxes in
  441.                                 'code would trigger a change event!
  442.  
  443.     If CurrentRecordNumber > 0 Then
  444.  
  445.         rec$ = DS_GetField(DatabaseMemoryBuffer$, RecDlm$, CurrentRecordNumber)
  446.         'Rearrange record in "normal" field order for simplicity of field extraction:
  447.         rec$ = DS_InsertField(DS_RemoveField(rec$, FldDlm$, 1), FldDlm$, FirstField, DS_GetField(rec$, FldDlm$, 1))
  448.  
  449.         txtName.Text = DS_GetField(rec$, FldDlm$, FIELDNUMBER_NAME)
  450.         txtAddress.Text = DS_GetField(rec$, FldDlm$, FIELDNUMBER_ADDRESS)
  451.         txtCity.Text = DS_GetField(rec$, FldDlm$, FIELDNUMBER_CITY)
  452.         txtState.Text = DS_GetField(rec$, FldDlm$, FIELDNUMBER_STATE)
  453.         txtZip.Text = DS_GetField(rec$, FldDlm$, FIELDNUMBER_ZIP)
  454.         txtAreaCode.Text = DS_GetField(rec$, FldDlm$, FIELDNUMBER_AREACODE)
  455.         txtPhone.Text = DS_GetField(rec$, FldDlm$, FIELDNUMBER_PHONE)
  456.  
  457.     Else
  458.  
  459.         txtName.Text = ""
  460.         txtAddress.Text = ""
  461.         txtCity.Text = ""
  462.         txtState.Text = ""
  463.         txtZip.Text = ""
  464.         txtAreaCode.Text = ""
  465.         txtPhone.Text = ""
  466.  
  467.         NumberOfRecords = 1
  468.         CurrentRecordNumber = 1
  469.         FlagNewRecordInProgress = True
  470.  
  471.     End If
  472.  
  473.     lblRecordID.Caption = Str$(CurrentRecordNumber) + " of" + Str$(NumberOfRecords)
  474.  
  475.     vscrScroller.Value = CurrentRecordNumber
  476.  
  477.     FlagRecordChanged = False   'Initialize trigger.
  478.     TextChangeEnabled = True    'Enable trigger.
  479.  
  480.     txtName.SetFocus
  481.  
  482.  
  483. End Sub
  484.  
  485. Sub Form_Load ()
  486.     Dim fh    As Integer
  487.     Dim rc    As Integer
  488.     Dim l     As Long
  489.  
  490.     rc% = FP_Password("Sorry, you'll have to register FIELDPACK to get a password.")
  491.  
  492.     RecDlm$ = Chr$(13) + Chr$(10)  'CRLF (Carriage-return/line-feed)
  493.     FldDlm$ = ";"
  494.  
  495.     fh = FreeFile
  496.  
  497.     DatabaseFileName$ = "c:\fpdemo2.dat"
  498.  
  499.     Open DatabaseFileName$ For Binary As #fh
  500.     l& = LOF(fh)
  501.     If l& > 65530 Then  '(actually, 65536 -- but I don't trust Microsoft...)
  502.         MsgBox "File too big (over 64KB)!", 48, "FieldPack Demo Program 2"
  503.         End
  504.     End If
  505.     
  506.     DatabaseMemoryBuffer$ = String$(l&, " ")  'See the next line of code...
  507.     Get #fh, , DatabaseMemoryBuffer$    'Read entire file contents into memory (max 64 KB!!).
  508.  
  509.     Close #fh
  510.  
  511.     'Normally (see SaveIntoFile procedure), there's a final CRLF, after the last piece of data;
  512.     'we'll remove it, if it's there.
  513.     NumberOfRecords = DS_CountDlms(DatabaseMemoryBuffer$, RecDlm$)
  514.     DatabaseMemoryBuffer$ = DS_RemoveField(DatabaseMemoryBuffer$, RecDlm$, NumberOfRecords + 1)
  515.     If DatabaseMemoryBuffer = "" Then NumberOfRecords = 0
  516.  
  517.     AdjustScrollerRange
  518.  
  519.     FirstField = 1
  520.     SortField = 1
  521.     lblCurrentSortField.Enabled = True
  522.     lblCurrentSortField.Caption = "Name"
  523.  
  524.     If NumberOfRecords = 0 Then
  525.         CurrentRecordNumber = 0
  526.     Else
  527.         SortRecords 'This is redundant (see SaveIntoFile procedure), but whatthehell...
  528.         CurrentRecordNumber = 1
  529.     End If
  530.  
  531.     FlagFileChanged = False
  532.     FlagRecordChanged = False
  533.     FlagNewRecordInProgress = False
  534.     
  535.     EditFrm.Show    'Necessary because of the SetFocus
  536.                     'call in the DisplayRecord procedure.
  537.     DisplayRecord
  538.     
  539. End Sub
  540.  
  541. Sub mnuAbout_Click ()
  542.  
  543.     AboutFrm.Show 1
  544.  
  545. End Sub
  546.  
  547. Sub mnuExit_Click ()
  548.  
  549.     UpdateIfNecessary
  550.  
  551.     If FlagFileChanged Then
  552.         SortField = 1  'We chose to always save the file sorted by "Name."
  553.         SortRecords
  554.         SaveIntoFile
  555.     End If
  556.  
  557.     Unload EditFrm  'Bye...
  558.     
  559. End Sub
  560.  
  561. Sub SaveIntoFile ()
  562.     Dim fh   As Integer
  563.     Dim crlf As String
  564.  
  565.     crlf$ = Chr$(13) + Chr$(10)
  566.     fh = FreeFile
  567.     Kill DatabaseFileName$  'If we didn't do this, we couldn't shorten the file contents.
  568.     Open DatabaseFileName$ For Binary As #fh
  569.     Put #fh, , DatabaseMemoryBuffer$
  570.     Put #fh, , crlf$    'We add a final CRLF so that text editors can read the file; each
  571.                         'record appears as a line of text.  See Form_Load.
  572.     Close #fh
  573.  
  574.     FlagFileChanged = False 'We put this here in case you want to expand this example
  575.                             'into a more sophisticated program, with a "Save" menu item
  576.                             '(and maybe also "Open," "Save As," etc.)
  577.  
  578. End Sub
  579.  
  580. Sub SortRecords ()
  581.     Dim i   As Integer
  582.     Dim rec As String
  583.     Dim sf  As String
  584.  
  585.     ' sort the items using a sorted list box
  586.  
  587.     ' clear the list box
  588.     lstSortingListBox.Clear
  589.  
  590.     ' load items into list box from our buffer...
  591.  
  592.     For i% = 1 To NumberOfRecords
  593.         rec$ = DS_GetField(DatabaseMemoryBuffer$, RecDlm$, i%)
  594.         'First, rearrange record in "normal" field order for simplicity of field extraction:
  595.         rec$ = DS_InsertField(DS_RemoveField(rec$, FldDlm$, 1), FldDlm$, FirstField, DS_GetField(rec$, FldDlm$, 1))
  596.         'Now, rearrange so that the newly-chosen sort field is in front:
  597.         rec$ = DS_InsertField(DS_RemoveField(rec$, FldDlm$, SortField), FldDlm$, 1, DS_GetField(rec$, FldDlm$, SortField))
  598.         lstSortingListBox.AddItem rec$
  599.     Next i%
  600.  
  601.     ' clear our buffer
  602.     DatabaseMemoryBuffer$ = ""
  603.  
  604.     ' Take records from list box (now in sort sequence) and put them back into our buffer.
  605.  
  606.     For i% = 1 To NumberOfRecords
  607.         DatabaseMemoryBuffer$ = DS_PutField(DatabaseMemoryBuffer$, RecDlm$, i%, (lstSortingListBox.List(i% - 1)))
  608.     Next i%
  609.     FlagFileChanged = 1
  610.  
  611.     ' clear list box to give memory back
  612.     lstSortingListBox.Clear
  613.  
  614.     ' Record the new database field arrangement:
  615.     FirstField = SortField
  616.  
  617.     ' show the first record (whoever called us will then call DisplayRecord)
  618.     CurrentRecordNumber = 1
  619.  
  620.     cmdFind.Enabled = True
  621.     lblCurrentSortField.Enabled = True
  622.  
  623. End Sub
  624.  
  625. Sub txtAddress_Change ()
  626.  
  627.     If TextChangeEnabled Then FlagRecordChanged = True
  628.  
  629. End Sub
  630.  
  631. Sub txtAreaCode_Change ()
  632.  
  633.     If TextChangeEnabled Then FlagRecordChanged = True
  634.  
  635. End Sub
  636.  
  637. Sub txtCity_Change ()
  638.  
  639.     If TextChangeEnabled Then FlagRecordChanged = True
  640.  
  641. End Sub
  642.  
  643. Sub txtName_Change ()
  644.  
  645.     If TextChangeEnabled Then FlagRecordChanged = True
  646.  
  647. End Sub
  648.  
  649. Sub txtPhone_Change ()
  650.  
  651.     If TextChangeEnabled Then FlagRecordChanged = True
  652.  
  653. End Sub
  654.  
  655. Sub txtState_Change ()
  656.  
  657.     If TextChangeEnabled Then FlagRecordChanged = True
  658.  
  659. End Sub
  660.  
  661. Sub txtZip_Change ()
  662.  
  663.     If TextChangeEnabled Then FlagRecordChanged = True
  664.  
  665. End Sub
  666.  
  667. Sub UpdateIfNecessary ()
  668.  
  669.     'This routine should be called everywhere there's an indication that the user
  670.     'may be finished looking at a displayed record.
  671.  
  672.     Dim rec As String
  673.  
  674.     If FlagRecordChanged Then   '(Whether old record or new record...)
  675.  
  676.         rec$ = BuildRecord()
  677.         If (Len(rec$) < (65530 - Len(DatabaseMemoryBuffer$))) Then
  678.             DatabaseMemoryBuffer$ = DS_PutField(DatabaseMemoryBuffer$, RecDlm$, CurrentRecordNumber, rec$)
  679.             FlagFileChanged = True
  680.             cmdFind.Enabled = False
  681.             lblCurrentSortField.Enabled = False
  682.             FlagNewRecordInProgress = False
  683.         Else
  684.             MsgBox "Changes not saved -- database too large (64KB limit).", 48, "FieldPack Demo Program 2"
  685.         End If
  686.         FlagRecordChanged = False
  687.     ElseIf FlagNewRecordInProgress Then '(User had a "New" record up, but didn't enter anything.)
  688.  
  689.         NumberOfRecords = NumberOfRecords - 1
  690.         CurrentRecordNumber = CurrentRecordNumber - 1
  691.         AdjustScrollerRange
  692.         FlagNewRecordInProgress = False
  693.         DisplayRecord   'Display the last record in the buffer.  (If none, will put up "New" rec.)
  694.  
  695.     End If
  696.  
  697. End Sub
  698.  
  699. Sub vscrScroller_Change ()
  700.  
  701.     If ScrollerChangeEnabled Then UpdateIfNecessary
  702.  
  703.     If vscrScroller.Value = 0 Then
  704.         CurrentRecordNumber = 1
  705.     Else
  706.         CurrentRecordNumber = vscrScroller.Value
  707.     End If
  708.     DisplayRecord
  709.  
  710. End Sub
  711.  
  712. Sub vscrScroller_Scroll ()
  713.  
  714.     UpdateIfNecessary
  715.     If vscrScroller.Value = 0 Then
  716.         CurrentRecordNumber = 1
  717.     Else
  718.         CurrentRecordNumber = vscrScroller.Value
  719.     End If
  720.     DisplayRecord
  721.  
  722. End Sub
  723.  
  724.