VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmFlexGrid 
   Caption         =   "The Flex Grid Control"
   ClientHeight    =   4215
   ClientLeft      =   45
   ClientTop       =   510
   ClientWidth     =   8010
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   9.75
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   4215
   ScaleWidth      =   8010
   Begin VB.CommandButton cmdDown 
      Height          =   495
      Left            =   7500
      Picture         =   "FlexGrid.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   1500
      Width           =   435
   End
   Begin VB.CommandButton cmdUp 
      Height          =   495
      Left            =   7500
      Picture         =   "FlexGrid.frx":0442
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   960
      Width           =   435
   End
   Begin VB.CommandButton cmdClip 
      Caption         =   "Clip Example"
      Height          =   912
      Left            =   6660
      TabIndex        =   6
      Top             =   3240
      Width           =   1272
   End
   Begin MSFlexGridLib.MSFlexGrid grdEmps 
      Height          =   3072
      Left            =   60
      TabIndex        =   5
      Top             =   60
      Width           =   7332
      _ExtentX        =   12938
      _ExtentY        =   5424
      _Version        =   393216
      SelectionMode   =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.CommandButton cmdColumn2 
      Caption         =   "Retrieve Column 2"
      Height          =   912
      Left            =   5340
      TabIndex        =   4
      Top             =   3240
      Width           =   1272
   End
   Begin VB.CommandButton cmdColumn1 
      Caption         =   "Retrieve Column 1"
      Height          =   912
      Left            =   4020
      TabIndex        =   3
      Top             =   3240
      Width           =   1272
   End
   Begin VB.CommandButton cmdDataLoad 
      Caption         =   "Load Data From Table"
      Height          =   912
      Left            =   2700
      TabIndex        =   2
      Top             =   3240
      Width           =   1272
   End
   Begin VB.CommandButton cmdLoad 
      Caption         =   "Load Data"
      Height          =   912
      Left            =   1380
      TabIndex        =   1
      Top             =   3240
      Width           =   1272
   End
   Begin VB.CommandButton cmdInit 
      Caption         =   "Initialize Grid"
      Height          =   912
      Left            =   60
      TabIndex        =   0
      Top             =   3240
      Width           =   1272
   End
   Begin VB.Image imgCheck 
      Height          =   144
      Left            =   7500
      Picture         =   "FlexGrid.frx":0884
      Stretch         =   -1  'True
      Top             =   180
      Visible         =   0   'False
      Width           =   144
   End
End
Attribute VB_Name = "frmFlexGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mlngColPos As Long

Const COL_ID As Integer = 0
Const COL_TYPE As Integer = 1
Const COL_NAME As Integer = 2
Const COL_START As Integer = 3
Const COL_SALARY As Integer = 4
Const COL_ACTIVE As Integer = 5

Private Sub cmdClip_Click()
   MsgBox grdEmps.Clip
End Sub

Private Sub cmdColumn1_Click()
   grdEmps.Col = COL_NAME
   MsgBox "The Employee's Name is " & grdEmps.Text
End Sub

Private Sub cmdColumn2_Click()
   MsgBox "The Employee's Name is " & grdEmps.TextMatrix(grdEmps.Row, COL_NAME)
End Sub

Private Sub cmdDataLoad_Click()
   Call GridInit
   
   Call GridDataLoad
End Sub

Private Sub cmdDown_Click()
   Dim intRow As Integer
   
   intRow = grdEmps.Row
   
   If intRow < grdEmps.Rows - 1 Then
      grdEmps.RowPosition(intRow) = intRow + 1
      grdEmps.Row = intRow + 1
      If Not grdEmps.RowIsVisible(grdEmps.Row) Then
         grdEmps.TopRow = grdEmps.Row
      End If
      grdEmps.Col = COL_ID
      grdEmps.ColSel = COL_ACTIVE
   End If
End Sub

Private Sub cmdInit_Click()
   Call GridInit
End Sub

Private Sub cmdLoad_Click()
   Call GridInit
   
   Call GridLoad
End Sub

Private Sub GridInit()
   With grdEmps
      ' Get rid of any fixed rows and columns
      .FixedRows = 0
      .FixedCols = 0
      
      ' Clear the Grid
      .Clear
      
      ' Set the initial number of rows and columns
      .Rows = 1
      .Cols = 6
      
      ' Setup Headers
      Call GridHeader
      
      ' Set Column Widths
      .ColWidth(COL_ID) = 0
      .ColWidth(COL_TYPE) = 2000
      .ColWidth(COL_NAME) = 2000
      .ColWidth(COL_START) = 1000
      .ColWidth(COL_SALARY) = 1000
      .ColWidth(COL_ACTIVE) = 800
      
      ' Set Column Alignments
      .ColAlignment(COL_START) = flexAlignCenterCenter
      .ColAlignment(COL_SALARY) = flexAlignRightCenter
   End With
End Sub

Private Sub GridHeader()
   With grdEmps
      .Row = 0
      .Col = COL_ID
      .Text = "Emp ID"
      
      .Col = COL_TYPE
      .Text = "Type"
      
      .Col = COL_NAME
      .Text = "Name"
      
      .Col = COL_START
      .Text = "Start Date"
      
      .Col = COL_SALARY
      .Text = "Salary"
      
      .Col = COL_ACTIVE
      .Text = "Active"
   End With
End Sub

Private Sub GridLoad()
   With grdEmps
      ' Add a row
      .AddItem "1" & vbTab & _
               "Manager" & vbTab & _
               "Sheriff, Paul" & vbTab & _
               "3/1/91" & vbTab & _
               Format$("70000", "Currency")
      .Row = 1
      .Col = COL_ACTIVE
      Set .CellPicture = imgCheck.Picture
      .CellFontBold = False
      .CellPictureAlignment = flexAlignCenterCenter
      
      ' Set the fixed rows
      .FixedRows = 1
   End With
End Sub

Private Sub GridDataLoad()
   Dim oRS As Recordset
   Dim strSQL As String
   Dim strLine As String
   
   ' Build the SQL String
   strSQL = "SELECT lEmp_id, "
   strSQL = strSQL & "szLast_nm, "
   strSQL = strSQL & "sFirst_nm, "
   strSQL = strSQL & "szEmployee_type, "
   strSQL = strSQL & "dtStart_dt, "
   strSQL = strSQL & "cSalary_amt, "
   strSQL = strSQL & "boolActive_fl "
   strSQL = strSQL & "FROM tblEmployees, tblEmpTypes "
   strSQL = strSQL & "WHERE tblEmployees.lEmpType_id  = tblEmpTypes.lEmpType_id  "
   strSQL = strSQL & "ORDER BY szEmployee_type "
   
   ' Open the Database
   Call DataOpen
   ' Open the Recordset
   Set oRS = gdb.OpenRecordset(strSQL)
   
   ' Set this to speed up loading
   grdEmps.Redraw = False
   
   ' Set these for Merging of Cells
   'grdEmps.MergeCells = flexMergeRestrictColumns
   'grdEmps.MergeCol(COL_TYPE) = True
   
   
   ' Loop through each record
   Do Until oRS.EOF
      ' Build string to put into grid
      ' Separate each column with tabs
      strLine = oRS!lEmp_id & vbTab & _
                oRS!szEmployee_type & "" & vbTab & _
                oRS!szLast_nm & ", " & oRS!sFirst_nm & vbTab & _
                oRS!dtStart_dt & vbTab & _
                Format$(oRS!cSalary_amt, "Currency")
      
      ' Add the row to the grid
      grdEmps.AddItem strLine
      If Field2Bool(oRS!boolActive_fl) Then
         grdEmps.Row = grdEmps.Rows - 1
         grdEmps.Col = COL_ACTIVE
         Call PictureSet
      End If
      
      ' Move to the next record
      oRS.MoveNext
   Loop
   ' Set the Fixed Rows if Grid has data
   If grdEmps.Rows > 1 Then
      grdEmps.FixedRows = 1
   End If
      
   ' Now redraw the grid
   grdEmps.Redraw = True
      
   ' Close the Recordset and Database
   oRS.Close
   gdb.Close
End Sub

Private Sub cmdUp_Click()
   Dim intRow As Integer
   
   intRow = grdEmps.Row
   
   If intRow > 1 Then
      grdEmps.RowPosition(intRow) = intRow - 1
      grdEmps.Row = intRow - 1
      If Not grdEmps.RowIsVisible(grdEmps.Row) Then
         grdEmps.TopRow = grdEmps.Row
      End If
      grdEmps.Col = COL_ID
      grdEmps.ColSel = COL_ACTIVE
   End If
End Sub

Private Sub grdEmps_DblClick()
   If mlngColPos >= grdEmps.ColPos(COL_ACTIVE) And mlngColPos < grdEmps.Width Then
      grdEmps.Col = COL_ACTIVE
      If grdEmps.CellPicture = 0 Then
         Call PictureSet
      Else
         Set grdEmps.CellPicture = Nothing
      End If
      grdEmps.Col = COL_ID
      grdEmps.ColSel = COL_ACTIVE
   End If
End Sub

Private Sub grdEmps_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Button = vbLeftButton Then
      mlngColPos = x
      If y >= grdEmps.RowPos(0) And y < grdEmps.RowPos(1) Then
         If x >= grdEmps.ColPos(COL_TYPE) And x < grdEmps.ColPos(COL_NAME) Then
            grdEmps.Col = COL_TYPE
            grdEmps.Sort = flexSortStringNoCaseAscending
         ElseIf x >= grdEmps.ColPos(COL_NAME) And x < grdEmps.ColPos(COL_START) Then
            grdEmps.Col = COL_NAME
            grdEmps.Sort = flexSortStringNoCaseAscending
            grdEmps.Col = COL_ID
            grdEmps.ColSel = COL_ACTIVE
         End If
      End If
   End If
End Sub

Private Function Field2Bool(vntValue As Variant) As Boolean
   If IsNull(vntValue) Then
      Field2Bool = False
   Else
      Field2Bool = CBool(vntValue)
   End If
End Function

Private Sub PictureSet()
   grdEmps.CellPictureAlignment = flexAlignCenterCenter
   Set grdEmps.CellPicture = imgCheck.Picture
End Sub