home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code1 / m_query / mgrid.frm < prev    next >
Text File  |  1994-05-24  |  19KB  |  737 lines
  1. VERSION 2.00
  2. Begin Form fGridFrm 
  3.    BackColor       =   &H00C0C0C0&
  4.    ClientHeight    =   3135
  5.    ClientLeft      =   1455
  6.    ClientTop       =   2640
  7.    ClientWidth     =   6675
  8.    ClipControls    =   0   'False
  9.    Height          =   3540
  10.    Icon            =   MGRID.FRX:0000
  11.    Left            =   1395
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   3125.913
  14.    ScaleMode       =   0  'User
  15.    ScaleWidth      =   6692.959
  16.    Tag             =   "Dynaset"
  17.    Top             =   2295
  18.    Width           =   6795
  19.    Begin Grid cGrid 
  20.       Height          =   2715
  21.       Left            =   0
  22.       TabIndex        =   9
  23.       Top             =   420
  24.       Width           =   6675
  25.    End
  26.    Begin PictureBox ViewButtons 
  27.       BackColor       =   &H00C0C0C0&
  28.       BorderStyle     =   0  'None
  29.       Height          =   375
  30.       Left            =   0
  31.       ScaleHeight     =   372
  32.       ScaleMode       =   0  'User
  33.       ScaleWidth      =   5171.607
  34.       TabIndex        =   0
  35.       Top             =   24
  36.       Width           =   5175
  37.       Begin CommandButton SortButton 
  38.          Caption         =   "&Sort"
  39.          Height          =   372
  40.          Left            =   3720
  41.          TabIndex        =   8
  42.          Top             =   0
  43.          Width           =   612
  44.       End
  45.       Begin CommandButton FilterButton 
  46.          Caption         =   "Fil&ter"
  47.          Height          =   372
  48.          Left            =   3120
  49.          TabIndex        =   7
  50.          Top             =   0
  51.          Width           =   612
  52.       End
  53.       Begin CommandButton RefreshButton 
  54.          Caption         =   "&Redo"
  55.          Height          =   372
  56.          Left            =   2520
  57.          TabIndex        =   6
  58.          Top             =   0
  59.          Width           =   612
  60.       End
  61.       Begin CommandButton CloseButton 
  62.          Cancel          =   -1  'True
  63.          Caption         =   "&Close"
  64.          Height          =   372
  65.          Left            =   4320
  66.          TabIndex        =   5
  67.          Top             =   0
  68.          Width           =   612
  69.       End
  70.       Begin CommandButton MoreButton 
  71.          Caption         =   "&More"
  72.          Height          =   372
  73.          Left            =   1320
  74.          TabIndex        =   4
  75.          Top             =   0
  76.          Width           =   612
  77.       End
  78.       Begin CommandButton NextButton 
  79.          Caption         =   "&Next"
  80.          Height          =   372
  81.          Left            =   120
  82.          TabIndex        =   3
  83.          Top             =   0
  84.          Width           =   612
  85.       End
  86.       Begin CommandButton FirstButton 
  87.          Caption         =   "&First"
  88.          Height          =   372
  89.          Left            =   720
  90.          TabIndex        =   2
  91.          Top             =   0
  92.          Width           =   612
  93.       End
  94.       Begin CommandButton FindButton 
  95.          Caption         =   "F&ind"
  96.          Height          =   372
  97.          Left            =   1920
  98.          TabIndex        =   1
  99.          Top             =   0
  100.          Width           =   612
  101.       End
  102.    End
  103. End
  104.  
  105. Option Explicit
  106.  
  107. 'form variables
  108. 'Dim FDS As dynaset         'current form's dynaset
  109. Dim FDS As snapshot        'current form's snapshot
  110. Dim FDynSt As String       'dynaset open string
  111. Dim FTblname As String     'form dynaset table name
  112. Dim FCurrentRow As Long    'current row in dynaset
  113. Dim FGridRow As Integer    'current grid row
  114. Dim FNotFound As Integer   'find not found flag
  115. Dim FFindForm As New fFind 'find form
  116. Dim FNumbRows As Long      'total number of rows in table
  117. Dim FDynaString As String  'dynaset open string
  118.  
  119. Sub cGrid_DblClick ()
  120.   Dim r As Integer       'return from execute sql
  121.   Dim fn As String       'field name
  122.  
  123.   On Error GoTo ZoomErr
  124.   r = cGrid.Row
  125.   cGrid.Row = 0
  126.   'get field name
  127.   fn = cGrid.Text
  128.   cGrid.Row = r
  129.  
  130.   'make sure it's a string or memo field
  131.   'If FDS(fn).Type = FT_STRING Or FDS(fn).Type = FT_MEMO Then
  132.     ' gstZoomData = cGrid.Text
  133.     ' fZoom.Caption = fn
  134.     ' fZoom.Top = Top + 1200
  135.     ' fZoom.Left = Left + 250
  136.     ' fZoom.CloseZoomButton.Visible = True
  137.      'fZoom.Show MODAL
  138.   'End If
  139.   GoTo ZoomEnd
  140.  
  141. ZoomErr:
  142.   ShowError
  143.   Resume ZoomEnd
  144.  
  145. ZoomEnd:
  146.  
  147. End Sub
  148.  
  149. Sub cGrid_KeyUp (KeyCode As Integer, Shift As Integer)
  150.   'zoom on F4 key press
  151.   If KeyCode = &H73 Then   'F4
  152.     cGrid_DblClick
  153.   End If
  154. End Sub
  155.  
  156. Sub CloseButton_Click ()
  157.   If Not gStoredFlag Then ' this query did not come from storage
  158.     fQuery.RunSaveQryButton.Caption = "&Store Query "
  159.     fQuery.RunSaveQryButton.Enabled = True
  160.     fQuery.RunQueryButton.Enabled = False
  161.     Else
  162.     fQuery.RunSaveQryButton.Caption = "&Load Query"
  163.     fQuery.RunSaveQryButton.Enabled = False
  164.     fQuery.RunQueryButton.Enabled = False
  165.     'gStoredFlag = False
  166.   End If
  167.  
  168.   fQuery.Show
  169.   Unload Me
  170. End Sub
  171.  
  172. Sub FilterButton_Click ()
  173.   On Error GoTo FilterErr
  174.  
  175. '  Dim ds1 As dynaset, ds2 As dynaset
  176.   Dim ds1 As snapshot, ds2 As snapshot
  177.   'Dim gFilterStr As String
  178.   Dim numbrows As Long    'local number of rows
  179.  
  180.   Set ds1 = FDS            'save the dynaset
  181.    Dim i As Integer, r As Integer, c As Integer
  182.  
  183.    'On Error GoTo FindErr
  184.  
  185.    'load the column names into the filter form
  186.    'the 1st time it is loaded
  187.      fFilter.cExpr.Text = ""
  188.      fFilter.cFieldList.Clear
  189.      r = cGrid.Row
  190.      c = cGrid.Col
  191.      cGrid.Row = 0
  192.      cGrid.Col = 0
  193.      For i = 1 To cGrid.Cols - 1
  194.        cGrid.Col = cGrid.Col + 1
  195.        fFilter.cFieldList.AddItem cGrid.Text
  196.      Next
  197.      cGrid.Row = r
  198.      cGrid.Col = c
  199.    
  200.  
  201.    MsgBar "Enter Search Parameters without quotes", False
  202.  
  203.   fFilter.Show MODAL
  204.  
  205.   'gFilterStr = InputBox("Enter Filter Expression:")
  206.   If gFilterStr = "" Then Exit Sub
  207.   
  208.   FDS.Filter = gFilterStr
  209. '  Set ds2 = FDS.CreateDynaset()            'establish the filter
  210.   Set ds2 = FDS.CreateSnapshot()            'establish the filter
  211.   Set FDS = ds2            'assign back to original dynaset object
  212.  
  213.   'everything must be okay so redisplay form on 1st record
  214.   FNumbRows = GetNumbRecsSS(FDS)          'query numb of recs
  215.    If FNumbRows = -1 Then
  216.      'error occurred but go on anyway
  217.      'because row count is non-critical
  218.      Caption = "Dynaset: " + FTblname
  219.      numbrows = gwMaxGridRows
  220.      FCurrentRow = numbrows
  221.    ElseIf FNumbRows = 0 Then
  222.      Beep
  223.      MsgBox "No Records found!", 48
  224.      ResetMouse Me
  225.      Unload Me
  226.      fQuery.Show
  227.      Exit Sub
  228.    ElseIf FNumbRows > gwMaxGridRows Then
  229.      Caption = "Dynaset: " + FTblname + " [" + CStr(FNumbRows) + " total rows]"
  230.      numbrows = gwMaxGridRows
  231.      FCurrentRow = numbrows
  232.    Else
  233.      numbrows = FNumbRows
  234.      Caption = "Dynaset: " + FTblname + " [" + CStr(FNumbRows) + " rows]"
  235.    End If
  236.   If LoadGrid(cGrid, FDS, FDynSt, numbrows, 0) = False Then
  237.     Unload Me
  238.     fQuery.Show
  239.     Exit Sub
  240.   End If
  241.   GoTo FilterEnd
  242.  
  243. FilterErr:
  244.   ShowError
  245.   Set FDS = ds1            're-assign back to original
  246.   Resume FilterEnd
  247.  
  248. FilterEnd:
  249.  
  250. End Sub
  251.  
  252. Sub FindButton_Click ()
  253.    Dim i As Integer, r As Integer, c As Integer
  254.  
  255.    On Error GoTo FindErr
  256.  
  257.    'load the column names into the find form
  258.    'the 1st time it is loaded
  259.    If FFindForm.cFieldList.ListCount = 0 Then
  260.      FFindForm.cFieldList.Clear
  261.      r = cGrid.Row
  262.      c = cGrid.Col
  263.      cGrid.Row = 0
  264.      cGrid.Col = 0
  265.      For i = 1 To cGrid.Cols - 1
  266.        cGrid.Col = cGrid.Col + 1
  267.        FFindForm.cFieldList.AddItem cGrid.Text
  268.      Next
  269.      cGrid.Row = r
  270.      cGrid.Col = c
  271.    End If
  272.  
  273. FindStart:       'used to loop around on not found
  274.  
  275.    'reset the flags
  276.    gfFindFailed = False
  277.    gfFromTableView = True
  278.  
  279.    MsgBar "Enter Search Parameters", False
  280.  
  281.    FFindForm.Show MODAL
  282.   
  283.    MsgBar "Searching for record", True
  284.  
  285.    If gfFindFailed = True Then Exit Sub
  286.  
  287.    FNotFound = False
  288.  
  289.    SetHourGlass Me
  290.  
  291.    'search for the record
  292.    cGrid.SetFocus        'start at the top
  293.    SendKeys "^{Home}"
  294.    cGrid.Col = 1
  295.    cGrid.Row = 0
  296.    'move the right column
  297.    While cGrid.Text <> UCase(gstFindField)
  298.      If cGrid.Col = cGrid.Cols Then 'reached max col
  299.      Else
  300.        cGrid.Col = cGrid.Col + 1
  301.        SendKeys "{Right}"
  302.      End If
  303.    Wend
  304.    cGrid.Row = 1
  305.    While cGrid.Row < cGrid.Rows - 1
  306.        If gfFindMatch = False Then
  307.          Select Case gstFindOp
  308.            Case "="
  309.              If UCase(cGrid.Text) = UCase(gstFindExpr) Then GoTo AfterWhile
  310.            Case "<>"
  311.              If UCase(cGrid.Text) <> UCase(gstFindExpr) Then GoTo AfterWhile
  312.            Case ">="
  313.              If UCase(cGrid.Text) >= UCase(gstFindExpr) Then GoTo AfterWhile
  314.            Case "<="
  315.              If UCase(cGrid.Text) <= UCase(gstFindExpr) Then GoTo AfterWhile
  316.            Case ">"
  317.              If UCase(cGrid.Text) > UCase(gstFindExpr) Then GoTo AfterWhile
  318.            Case "<"
  319.              If UCase(cGrid.Text) < UCase(gstFindExpr) Then GoTo AfterWhile
  320.            Case "Like"
  321.              If UCase(cGrid.Text) Like UCase(gstFindExpr) Then GoTo AfterWhile
  322.          End Select
  323.        Else
  324.          Select Case gstFindOp
  325.            Case "="
  326.              If cGrid.Text = gstFindExpr Then GoTo AfterWhile
  327.            Case "<>"
  328.              If cGrid.Text <> gstFindExpr Then GoTo AfterWhile
  329.            Case ">="
  330.              If cGrid.Text >= gstFindExpr Then GoTo AfterWhile
  331.            Case "<="
  332.              If cGrid.Text <= gstFindExpr Then GoTo AfterWhile
  333.            Case ">"
  334.              If cGrid.Text > gstFindExpr Then GoTo AfterWhile
  335.            Case "<"
  336.              If cGrid.Text < gstFindExpr Then GoTo AfterWhile
  337.            Case "Like"
  338.              If cGrid.Text Like gstFindExpr Then GoTo AfterWhile
  339.          End Select
  340.        End If
  341.      cGrid.Row = cGrid.Row + 1
  342.      SendKeys "{Down}"
  343.    Wend
  344.    FNotFound = True       'didn't find it
  345.  
  346. AfterWhile:
  347.    ResetMouse Me
  348.  
  349.    'show the first record
  350.    If FNotFound Then
  351.      Beep
  352.      MsgBox "Record Not Found", 48
  353.      GoTo FindStart
  354.    End If
  355.    DoEvents
  356.    cGrid.SelStartRow = cGrid.Row
  357.    cGrid.SelStartCol = 1
  358.    cGrid.SelEndRow = cGrid.Row
  359.    cGrid.SelEndCol = FDS.Fields.Count
  360.  
  361.    GoTo FindEnd
  362.  
  363. FindErr:
  364.    ResetMouse Me
  365.    ShowError
  366.    Resume FindEnd
  367.  
  368. FindEnd:
  369.    MsgBar "", False
  370.  
  371. End Sub
  372.  
  373. Sub FirstButton_Click ()
  374.    Dim numbrows As Long         'number of rows
  375.  
  376.    On Error GoTo GoFirstError
  377.  
  378.    SetHourGlass Me
  379.    MsgBar "Going to first record", True
  380.    cGrid.SetFocus
  381.    cGrid.Row = 1
  382.    cGrid.Col = 0
  383.    'get current starting row in grid
  384.    If cGrid.Text <> "1" Then
  385.      FDS.Close
  386. '     Set FDS = gCurrentDB.CreateDynaset(FDS.Name)
  387.      Set FDS = gCurrentDB.CreateSnapshot(FDS.Name)
  388.  
  389.      FNumbRows = GetNumbRecsSS(FDS)
  390.      If FNumbRows > gwMaxGridRows Then
  391.        numbrows = gwMaxGridRows
  392.        FCurrentRow = numbrows
  393.      Else
  394.        numbrows = FNumbRows
  395.      End If
  396.  
  397.      If LoadGrid(cGrid, FDS, FDynSt, numbrows, 0) = False Then
  398.        Unload Me
  399.        fQuery.Show
  400.        Exit Sub
  401.      End If
  402.   End If
  403.   cGrid.Col = 1
  404.   SendKeys "{Home}"
  405.  
  406.   GoTo GoFirstEnd
  407.  
  408. GoFirstError:
  409.   ShowError
  410.   Resume GoFirstEnd
  411.  
  412. GoFirstEnd:
  413.   ResetMouse Me
  414.   MsgBar "", False
  415.  
  416. End Sub
  417.  
  418. Sub Form_Load ()
  419.  
  420.    Dim t As TableDef       'local table structure
  421.    Dim sp As Integer       'starting point of table name
  422.    Dim ep As Integer       'ending point of table name
  423.    Dim wh As String        'where clause
  424.  
  425.    Dim i As Integer, j As Integer
  426.    Dim fn As String        'field name
  427.    Dim rc As Integer       'record count
  428.    Dim numbrows As Long    'local number of rows
  429.    Dim ss As snapshot
  430.    Dim ds As String
  431.    gwMaxGridRows = 250
  432.  
  433.    On Error GoTo DynasetErr
  434.  
  435.    SetHourGlass Me
  436.    MsgBar "Opening Dynaset", True
  437.  
  438.    If gfFROMSQL = True Then
  439.      ds = fQuery!cCriteria
  440.         If gfFROMSQL Then
  441.             gstDynaString = fQuery!cCriteria
  442.         End If
  443.    Else
  444.        ds = gstDynaString
  445.    End If
  446.    
  447.  
  448.    'attemp to open the dynaset
  449.    Set FDS = gCurrentDB.CreateSnapshot(ds)
  450.    'parse off table name to store in global gstTblName
  451.    wh = ""
  452.    sp = InStr(1, UCase(ds), "FROM")
  453.    If sp > 0 Then
  454.      'must be a "select from" statement
  455.      sp = sp + 5
  456.      For ep = sp To Len(ds)
  457.        'search for a space or the end of ds
  458.        If Mid$(ds, ep, 1) = " " Then
  459.          'get where clause if there is one
  460.          wh = Mid$(ds, sp, Len(ds) - sp + 1)
  461.          Exit For
  462.        End If
  463.      Next
  464.      FTblname = UCase(Mid$(ds, sp, ep - sp))
  465.      If wh = "" Then wh = FTblname
  466.    Else
  467.      'must be a table name only
  468.      FTblname = UCase(ds)
  469.      
  470.      wh = FTblname
  471.    End If
  472.    gTblname = FTblname
  473.    FDynaString = wh
  474.  
  475.    'show the first record
  476.    FNumbRows = GetNumbRecsSS(FDS)          'query numb of recs
  477.  
  478.    If FNumbRows = -1 Then
  479.      'error occurred but go on anyway
  480.      'because row count is non-critical
  481.      Caption = "SnapShot: " + FTblname
  482.      numbrows = gwMaxGridRows
  483.      FCurrentRow = numbrows
  484.    ElseIf FNumbRows = 0 Then
  485.      Beep
  486.      MsgBox "No Records found!", 48
  487.      ResetMouse Me
  488.      Unload Me
  489.      fQuery.Show
  490.      Exit Sub
  491.    ElseIf FNumbRows > gwMaxGridRows Then
  492.      Caption = "SnapShot: " + FTblname + " [" + CStr(FNumbRows) + " total rows]"
  493.      numbrows = gwMaxGridRows
  494.      FCurrentRow = numbrows
  495.    Else
  496.      numbrows = FNumbRows
  497.      Caption = "SnapShot: " + FTblname + " [" + CStr(FNumbRows) + " rows]"
  498.    End If
  499.  
  500.    If LoadGrid(cGrid, FDS, ds, numbrows, 0) = False Then
  501.      Unload Me
  502.      fQuery.Show
  503.      Exit Sub
  504.    End If
  505.  
  506.    Height = 3800 + numbrows * 20
  507.    Width = 5450 + gsumcolwid / 2
  508.    'Left = 1000
  509.    'Top = 1000
  510.  
  511.    Me.Left = (screen.Width - Me.Width) / 2
  512.    Me.Top = (screen.Height - Me.Height) / 2
  513.    
  514.     Me.Show
  515.     fQuery.Hide
  516.  
  517.    GoTo OkayEnd
  518.  
  519. DynasetErr:
  520.    ShowError
  521.    ResetMouse Me
  522.    MsgBar "", False
  523.    Unload Me
  524.    fQuery.Show
  525.    Exit Sub
  526.    Resume OkayEnd
  527.  
  528. OkayEnd:
  529.    ResetMouse Me
  530.    MsgBar "", False
  531.  
  532. End Sub
  533.  
  534. Sub Form_Resize ()
  535.   On Error Resume Next
  536.  
  537.   'resize grid to window
  538.   If WindowState <> 1 Then   'not minimized
  539.     cGrid.Height = Height - 900
  540.     cGrid.Width = Width - 100
  541.   End If
  542. End Sub
  543.  
  544. Sub Form_Unload (Cancel As Integer)
  545.   On Error Resume Next
  546.  
  547.   'unload the find form
  548.   Unload FFindForm
  549.  
  550.   'close the associated dynaset
  551.   FDS.Close
  552.   MsgBar "", False
  553. End Sub
  554.  
  555. Sub MoreButton_Click ()
  556.   Dim ret As Integer   'return value from loadgrid
  557.  
  558.   On Error Resume Next
  559.  
  560.   MsgBar "Getting more records", True
  561.   If FDS.EOF <> True Then
  562.     SetHourGlass Me
  563.  
  564.     ret = LoadGrid(cGrid, FDS, FDynSt, gwMaxGridRows, FCurrentRow)
  565.     If ret = False Then
  566.       'failed so bail out of form
  567.       FDS.Close
  568.       Unload Me
  569.       fQuery.Show
  570.     End If
  571.     'set new current row
  572.     FCurrentRow = FCurrentRow + ret
  573.     
  574.     ResetMouse Me
  575.     Else
  576.     MsgBox "All Records Loaded!", 48
  577.   End If
  578.   MsgBar "", False
  579.  
  580. End Sub
  581.  
  582. Sub NextButton_Click ()
  583.    Dim c As Integer      'current column
  584.  
  585.    On Error GoTo GoNextError
  586.  
  587.    c = cGrid.Col
  588.    cGrid.Col = 0
  589.    If cGrid.Text = "" Then
  590.      Beep
  591.    ElseIf cGrid.Row = gwMaxGridRows Then
  592.      MoreButton_Click
  593.    Else
  594.      cGrid.SetFocus
  595.      SendKeys "{Down}"
  596.    End If
  597.    cGrid.Col = c
  598.  
  599.    GoTo GoNextEnd
  600.  
  601. GoNextError:
  602.    ShowError
  603.    Resume GoNextEnd
  604.  
  605. GoNextEnd:
  606.  
  607. End Sub
  608.  
  609. 'needed for multi-user situations so
  610. 'new records can be viewed imediately
  611. Sub RefreshButton_Click ()
  612.    Dim numbrows As Long
  613.  
  614.    On Error GoTo RefreshError
  615.  
  616.    MsgBar "Reopening Dynaset", True
  617.    SetHourGlass Me
  618. '   Set FDS = gCurrentDB.CreateDynaset(FDS.Name)
  619.    Set FDS = gCurrentDB.CreateSnapshot(FDS.Name)
  620.  
  621.    FNumbRows = GetNumbRecsSS(FDS)
  622.    If FNumbRows = -1 Then
  623.      'error occurred but go on anyway
  624.      'because row count is non-critical
  625.      Caption = "Dynaset: " + FTblname
  626.      numbrows = gwMaxGridRows
  627.      FCurrentRow = numbrows
  628.    ElseIf FNumbRows = 0 Then
  629.      Beep
  630.      MsgBox "No Records found!", 48
  631.      ResetMouse Me
  632.      Unload Me
  633.      fQuery.Show
  634.    ElseIf FNumbRows > gwMaxGridRows Then
  635.      Caption = "Dynaset: " + FTblname + " [" + CStr(FNumbRows) + " total rows]"
  636.      numbrows = gwMaxGridRows
  637.      FCurrentRow = numbrows
  638.    Else
  639.      numbrows = FNumbRows
  640.      Caption = "Dynaset: " + FTblname + " [" + CStr(FNumbRows) + " rows]"
  641.    End If
  642.  
  643.    If LoadGrid(cGrid, FDS, FDynSt, numbrows, 0) = False Then
  644.      Unload Me
  645.      fQuery.Show
  646.      Exit Sub
  647.    End If
  648.  
  649.   GoTo RefreshEnd
  650.  
  651. RefreshError:
  652.   ShowError
  653.   Resume RefreshEnd
  654.  
  655. RefreshEnd:
  656.   ResetMouse Me
  657.   MsgBar "", False
  658.  
  659. End Sub
  660.  
  661. Sub SortButton_Click ()
  662.   On Error GoTo SortErr
  663.  
  664. '  Dim ds1 As dynaset, ds2 As dynaset
  665.   Dim ds1 As snapshot, ds2 As snapshot
  666.   'Dim gSortStr As String
  667.   Dim numbrows As Long    'local number of rows
  668.  
  669.   Set ds1 = FDS            'save the dynaset
  670.    Dim i As Integer, r As Integer, c As Integer
  671.  
  672.    'On Error GoTo FindErr
  673.  
  674.    'load the column names into the filter form
  675.    'the 1st time it is loaded
  676.    fSort.cFieldList.Clear
  677.      r = cGrid.Row
  678.      c = cGrid.Col
  679.      cGrid.Row = 0
  680.      cGrid.Col = 0
  681.      For i = 1 To cGrid.Cols - 1
  682.        cGrid.Col = cGrid.Col + 1
  683.        fSort.cFieldList.AddItem cGrid.Text
  684.      Next
  685.      cGrid.Row = r
  686.      cGrid.Col = c
  687.    
  688.   
  689.   fSort.Show MODAL
  690.   'gSortStr = InputBox("Enter Sort Column:")
  691.   If gSortStr = "" Then Exit Sub
  692.  
  693.   FDS.Sort = gSortStr
  694. '  Set ds2 = FDS.CreateDynaset()            'establish the Sort
  695.   Set ds2 = FDS.CreateSnapshot()            'establish the Sort
  696.   Set FDS = ds2            'assign back to original dynaset object
  697.  
  698.   'everything must be okay so redisplay form on 1st record
  699.   FNumbRows = GetNumbRecsSS(FDS)          'query numb of recs
  700.    If FNumbRows = -1 Then
  701.      'error occurred but go on anyway
  702.      'because row count is non-critical
  703.      Caption = "Dynaset: " + FTblname
  704.      numbrows = gwMaxGridRows
  705.      FCurrentRow = numbrows
  706.    ElseIf FNumbRows = 0 Then
  707.      Beep
  708.      MsgBox "No Records found!", 48
  709.      ResetMouse Me
  710.      Unload Me
  711.      fQuery.Show
  712.      Exit Sub
  713.    ElseIf FNumbRows > gwMaxGridRows Then
  714.      Caption = "Dynaset: " + FTblname + " [" + CStr(FNumbRows) + " total rows]"
  715.      numbrows = gwMaxGridRows
  716.      FCurrentRow = numbrows
  717.    Else
  718.      numbrows = FNumbRows
  719.      Caption = "Dynaset: " + FTblname + " [" + CStr(FNumbRows) + " rows]"
  720.    End If
  721.   If LoadGrid(cGrid, FDS, FDynSt, numbrows, 0) = False Then
  722.     Unload Me
  723.     fQuery.Show
  724.     Exit Sub
  725.   End If
  726.   GoTo SortEnd
  727.  
  728. SortErr:
  729.   ShowError
  730.   Set FDS = ds1            're-assign back to original
  731.   Resume SortEnd
  732.  
  733. SortEnd:
  734.  
  735. End Sub
  736.  
  737.