Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/msflex3a/gridlite.frm

Visual Basic Form | 1999-09-24 | 14.0 KB | 405 lines

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form BackGrnd
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Test Grid Lite"
   ClientHeight    =   3360
   ClientLeft      =   45
   ClientTop       =   360
   ClientWidth     =   4695
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   3360
   ScaleWidth      =   4695
   StartUpPosition =   2  'CenterScreen
   Begin VB.CheckBox AutoReturn
      Caption         =   "Auto Return to Col. 1"
      Height          =   255
      Left            =   2640
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   120
      Width           =   1815
   End
   Begin VB.CommandButton Stop
      Caption         =   "STOP"
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   2880
      Width           =   975
   End
   Begin MSFlexGridLib.MSFlexGrid FG1
      Height          =   2415
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   4215
      _ExtentX        =   7435
      _ExtentY        =   4260
      _Version        =   393216
      Rows            =   30
      Cols            =   10
      AllowBigSelection=   0   'False
      ScrollTrack     =   -1  'True
      FillStyle       =   1
   End
   Begin VB.Label CellIndicator
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   120
      UseMnemonic     =   0   'False
      Width           =   105
   End
   Begin VB.Menu MnuFGridRows
      Caption         =   "Rows"
      Visible         =   0   'False
      Begin VB.Menu MnuFGridAddRow
         Caption         =   "Add a Row"
      End
      Begin VB.Menu MnuFGridInsRow
         Caption         =   "Insert a Row"
      End
      Begin VB.Menu MnuFGridSep1
         Caption         =   "-"
      End
      Begin VB.Menu MnuFGridDelRow
         Caption         =   "Delete a Row"
      End
      Begin VB.Menu MnuFGridExtrRow
         Caption         =   "Extract a Row"
      End
   End
   Begin VB.Menu MnuFGridCols
      Caption         =   "Columns"
      Visible         =   0   'False
      Begin VB.Menu MnuFGridAddCol
         Caption         =   "Add a Col"
      End
      Begin VB.Menu MnuFGridInsCol
         Caption         =   "Insert a Col"
      End
      Begin VB.Menu MnuFGridSep2
         Caption         =   "-"
      End
      Begin VB.Menu MnuFGridDelCol
         Caption         =   "Delete a Col"
      End
      Begin VB.Menu MnuFGridExtrCol
         Caption         =   "Extract a Col"
      End
   End
Attribute VB_Name = "BackGrnd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'MSFlexgrid Edit Lite: 9-17-99
'this is an effective and completely natural looking way
'to edit data in the MSFlexgrid object. I've chosen to keep
'all columns the same width that is why I've used .TextMatrix
'in Form_Load() below rather than .FormatString.
'If you don't care that numbers and chars wind up aligned
'differently in the columns then remove .ColAlignment(-1)=1
'in the Form_Load() sub.
'Move the cell around with the cursor keys or click with
'the mouse on the destination cell.
'Starting to type will add to the current value in that cell.
'If you change your mind while editing, press <ESC> to restore.
'<Del> will delete cell contents. <ESC> lets you change
'your mind an restore the original figure or the last
'figure (in curr. cell) before pressing <Del>.
'You can enter a cell, drag the mouse and then start typing and
'VOILA you fill in all the hi-lited cells. The same thing can
'be achieved by pressing the SHIFT & CURSOR keys. (This is also
'an effective way of erasing a whole block of data.)
'<ENTER> key or Arrow keys advance to the next cell.
'Navigtion keys are the usual <Home>, <End>, <Pg Up / Dn>
'along with their Ctrl alternates
'The Cell indicator - may come in handy in BIG Grids
'Also, a choice button to automatically return the focus
'to the first column or just go down 1 row.
'Similar thing can be accomplished like so:
'( in Incr_Cell() )
'   if Fg1.ColIsVisible(1) then
'       FG1.Col=1
'   end if
'This is the lite version of the MSFlexgrid file postet on
'Sept. 12,99. It does everything that version did except-
'In-Cell-Editing with In-Cell-Cursor - but, unless you do
'a lot of LONG entries this'll do the trick and is less code.
'If you can improve the code...COOL, let me know.
'9-23-99
'I took the label L1 out. Temporary strings are now stored
'in FG1.Tag (MSFlexgrid does not use it!).
'In FG1_LeaveCell() I've added a Format$("0.00") for display
'you can NIX that if you don't want it.
'Typing into a cell with existing data ADDS to the exist. If you
'want to erase the exist data press <DEL>, but if you then
'change your mind you can press <ESC> to restore the text that
'was there when you re-entered the cell.
'also added Popupmenus for Adding, Deleting, Inserting and
'Extracting either Rows or Cols.
'Just put mouse in Col 0 or Row 0 and click Right Mouse Button.
'Add - means add Row at bottom or Col at end
'Delete - means del LAST Row or LAST Col
'Insert - means INSERT a Row / Col at present cursor pos.
'Extract - means EXTRACT a Row /Col at present cursor pos.
'If you try to DELETE / EXTRACT a Row / Col that has data
'in it you will be prompted if you wish to proceed.
'The Popupmenus were created the usual way and then had their
'Titles set to : Visible = False
'Now posted as as .vbp file
'Peter Raddatz - [e-mail]
Private Sub Form_Load()
    Dim y%
    With FG1
        .ColAlignment(-1) = 1       'all Left alligned
    For y% = 1 To .Cols - 1
        .TextMatrix(0, y%) = "Col " + Str(y%)
    Next
    For y% = 1 To FG1.Rows - 1
        .TextMatrix(y%, 0) = "Row " + Str(y%)
    Next
        .Row = 1
        .Col = 1
        .CellBackColor = &HC0FFFF   'lt. yellow
        BackGrnd.CellIndicator = " " + .TextMatrix(.Row, 0) + " : " + .TextMatrix(0, .Col) + " "
        'display current row & col in a boxed label
    End With
End Sub
Private Sub AutoReturn_Click()
    FG1.SetFocus
End Sub
Private Sub FG1_EnterCell()
    BackGrnd.CellIndicator = " " + FG1.TextMatrix(FG1.Row, 0) + " : " + FG1.TextMatrix(0, FG1.Col) + " "
    'update current row & col in boxed label
    FG1.CellBackColor = &HC0FFFF    'lt. yellow
    FG1.Tag = ""                    'clear temp storage
End Sub
Private Sub FG1_LeaveCell()
    FG1 = Format$(FG1, "0.00")      'or whatever format
    FG1.CellBackColor = &H80000005  'white
End Sub
Private Sub FG1_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
    Case 46             '<Del>, clear cell
        FG1.Tag = FG1   'assign to temp storage
        FG1 = ""        'Null
End Select
End Sub
Private Sub FG1_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 13         'ENTER key
            KeyCode = 0 'don't beep
            INCR_CELL   'advance new cell
        Case 8          'BkSpc
            If Len(FG1) Then
                FG1 = Left$(FG1, Len(FG1) - 1)  'shorten text
            End If
        Case 27                     'ESC
            If FG1.Tag > "" Then    'only if not NULL$
                FG1 = FG1.Tag       'restore orig. text
            End If
        Case Else
            FG1 = FG1 + Chr(KeyAscii)
    End Select
End Sub
Private Sub FG1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Row%, Col%
Row% = FG1.MouseRow
Col% = FG1.MouseCol
If Button = 2 And (Col% = 0 Or Row% = 0) Then
    FG1.Col = IIf(Col% = 0, 1, Col%)    'rows?
    FG1.Row = IIf(Row% = 0, 1, Row%)    'or cols?
    If Col% Then
        PopupMenu MnuFGridCols
    Else
        PopupMenu MnuFGridRows
    End If
End If
End Sub
Private Sub MnuFGridAddCol_Click()
With FG1
    .Cols = .Cols + 1
    .Col = .Cols - 1
    .TextMatrix(0, .Col) = "Col " + Str(.Col)   'add title
End With
IsCellVisible           'make sure!
End Sub
Private Sub MnuFGridAddRow_Click()
With FG1
    .Rows = .Rows + 1
    .Row = .Rows - 1
    .TextMatrix(.Row, 0) = "Row " + Str(.Row)
End With
IsCellVisible
End Sub
Private Sub MnuFGridDelCol_Click()
Dim R%, C%, Col%
If FG1.Cols > 2 Then        'make sure we don't del col 1
    Col% = FG1.Cols - 1     'last col
    For R% = 1 To FG1.Rows - 1  'Check for data in .Col
        If FG1.TextMatrix(R%, Col%) > "" Then   'data?
            C% = 1              'Yes there is!
            Exit For
        End If
    Next R%
    If C% Then                  'send warning
        R% = MsgBox("There is data in Col" + Str$(Col%) + " ! Delete anyway?", vbYesNo, "Delete Column!")
    End If
    If C% = 0 Or R% = 6 Then    'no exist data or YES
        If FG1.Col = FG1.Cols - 1 Then  'last col?
            FG1.Col = FG1.Col - 1       'move active cell
        End If
        FG1.Cols = FG1.Cols - 1         'del lat col
    End If
End If
End Sub
Private Sub MnuFGridDelRow_Click()
Dim R%, C%, Row%
If FG1.Rows > 2 Then        'make sure we don't del row 1
    Row% = FG1.Rows - 1
    For R% = 1 To FG1.Cols - 1
        If FG1.TextMatrix(Row%, R%) > "" Then   'data?
            C% = 1
            Exit For
        End If
    Next R%
    If C% Then
        R% = MsgBox("There is data in Row" + Str$(Row%) + " ! Delete anyway?", vbYesNo, "Delete Row!")
    End If
    If C% = 0 Or R% = 6 Then        'no exist. data or YES
        If FG1.Row = FG1.Rows - 1 Then  'last row?
            FG1.Row = FG1.Row - 1       'move active cell
        End If
        FG1.Rows = FG1.Rows - 1     'del last row
    End If
End If
End Sub
Private Sub MnuFGridInsRow_Click()
Dim R%, Row%, Col%
With FG1
    R% = .Row
    .Rows = .Rows + 1               'add a row
    .TextMatrix(.Rows - 1, 0) = "Row " + Str$(.Rows - 1)    'new row title
    For Row% = .Rows - 1 To R% + 1 Step -1 'move data dn 1 row
        For Col% = 1 To .Cols - 1
            .TextMatrix(Row%, Col%) = .TextMatrix(Row% - 1, Col%)
        Next Col%
    Next Row%
    For Col% = 1 To .Cols - 1       ' clear all cells in this row
        .TextMatrix(R%, Col%) = ""
    Next Col%
End With
End Sub
Private Sub MnuFGridInsCol_Click()
Dim C%, Row%, Col%
With FG1
    C% = .Col
    .Cols = .Cols + 1               'add a col
    .ColAlignment(-1) = 1           'set col alignment
    .TextMatrix(0, .Cols - 1) = "Col " + Str(.Cols - 1) 'new col title
    For Row% = 1 To .Rows - 1       'move exist. data over
        For Col% = .Cols - 1 To C% + 1 Step -1
            .TextMatrix(Row%, Col%) = .TextMatrix(Row%, Col% - 1)
        Next Col%
    Next Row%
    For Row% = 1 To .Rows - 1       'clear all cells in this col
        .TextMatrix(Row%, C%) = ""
    Next Row%
End With
End Sub
Private Sub MnuFGridExtrRow_Click()
Dim Row%, R%, C%
With FG1
    If .Rows > 2 Then        'make sure we don't del row 1
        Row% = .Row
        For R% = 1 To .Cols - 1
            If .TextMatrix(Row%, R%) > "" Then   'data?
                C% = 1
                Exit For
            End If
        Next R%
        If C% Then
            R% = MsgBox("There is data in Row" + Str$(Row%) + " ! Delete anyway?", vbYesNo, "Delete Row!")
        End If
        If C% = 0 Or R% = 6 Then        'no exist. data or YES
            For R% = .Row To .Rows - 2      'move exist data up 1 row
                For C% = 1 To FG1.Cols - 1
                    .TextMatrix(R%, C%) = .TextMatrix(R% + 1, C%)
                Next C%
            Next R%
            If Row% = .Rows - 1 Then    'set new cursor row
                .Row = .Rows - 2
            End If
            .Rows = .Rows - 1           'delete last row
        End If
    End If
End With
End Sub
Private Sub MnuFGridExtrCol_Click()
Dim Col%, R%, C%
With FG1
    If .Cols > 2 Then        'make sure we don't del col 1
        Col% = .Col
        For R% = 1 To FG1.Rows - 1
            If .TextMatrix(R%, Col%) > "" Then   'data?
                C% = 1
                Exit For
            End If
        Next R%
        If C% Then
            R% = MsgBox("There is data in Col" + Str$(Col%) + " ! Delete anyway?", vbYesNo, "Delete Column!")
        End If
        If C% = 0 Or R% = 6 Then    'no exist data or YES
            For R% = 1 To .Rows - 1     'move exist. data left 1 col
                For C% = Col% To .Cols - 2
                    .TextMatrix(R%, C%) = .TextMatrix(R%, C% + 1)
                Next C%
            Next R%
            If Col% = .Cols - 1 Then
                .Col = .Cols - 2
            End If
            .Cols = .Cols - 1           'delete last col
        End If
    End If
End With
End Sub
Private Sub Stop_Click()
    End
End Sub
Private Sub INCR_CELL()                     'advance to next cell
With FG1
    .HighLight = flexHighlightNever         'turn off hi-lite
    If .Col < .Cols - 1 Then
        .Col = .Col + 1
    Else
        If .Row < .Rows - 1 Then
            .Row = .Row + 1                 'down 1 row
            If AutoReturn.Value = 1 Then    'auto return?
                .Col = 1                    'first column
            End If
        End If
    End If
    If .CellTop + .CellHeight > .Top + .Height Then
        .TopRow = .TopRow + 1               'make sure row is visible
    End If
    .HighLight = flexHighlightAlways        'turn on hi-lite
End With
End Sub
'this sub scrolls the cols / rows if they're not visible! (? why)
Private Sub IsCellVisible()
    Dim a As Boolean
    a = FG1.CellTop
End Sub