Validating a String Grid

This demonstration is based on program StringGridDemo. We have added validation, some colour and a menu with a single menu item mmiFile. This menu item has its own single menu item, mmiSave.

One method of validation is to validate the complete entry once the cell has been exited. We demonstrate the use of the convenient onValidateEntry event, which makes it easy to return to the original contents of the cell if the validation fails. This method will cope with data pasted into a cell.

Another method examines each key press and rejects any invalid characters. This is based on a DelphiLand code snip.

Program StringGridValDemo in action

The essential code of the files needed for program StringGridValDemo follows. You can download the code of the three files in form_stringgrid_val_demo.zip

uStringGridValDemo

unit uStringGridValDemo;

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
  StdCtrls, Menus;

type
  TfrmGrid = class(TForm)
    btnNewRecord: TButton;
    btnDelete: TButton;
    mmiSave: TMenuItem;
    mmResults: TMainMenu;
    mmiFile: TMenuItem;
    sgMarks: TStringGrid;
    procedure btnDeleteClick(Sender: TObject);
    procedure btnNewRecordClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure mmiSaveClick(Sender: TObject);
    procedure sgMarksHeaderClick(Sender: TObject; IsColumn: Boolean;
                                 Index: Integer);
    procedure sgMarksKeyPress(Sender: TObject; var Key: char);
    procedure sgMarksValidateEntry(sender: TObject; aCol, aRow: Integer;
                                   const OldValue: string; var NewValue: String);
  end; 

var
  frmGrid: TfrmGrid;

implementation

{$R *.lfm}

type
  TStudent = record
    Forename, Surname : string[15];
    TheoryMark, PracticalMark : integer;
  end;

const
  MAX = 10;
  RESULTS_FILE = 'results.txt';

var
  Students : array[1 .. MAX] of TStudent;
  StudentFile : file of TStudent;
  NumOfRecords : integer;

function BlankCell : Boolean;
var
  i, j : integer;
begin
  BlankCell := False;
  with frmGrid.sgMarks do
    begin
      for i := 1 to NumOfRecords do
        for j := 1 to 4 do
          if Cells [j, i] = '' then
            begin
              Showmessage(Cells[j, 0] + ' in record number ' + Cells[0, i] +  ' is blank.');
              BlankCell := True;
            end;
    end;
end;

procedure Save;
var
  i : integer;
begin
  assignFile(StudentFile, RESULTS_FILE);
  rewrite(StudentFile);
  for i := 1 to NumOfRecords do
    begin
      write(StudentFile, Students[i]);
    end;
  closeFile(StudentFile);
  Showmessage('Saving records to file');
end;

procedure PopulateArray;
begin
  if FileExists(RESULTS_FILE) then
    begin
      assignFile(StudentFile, RESULTS_FILE);
      reset(StudentFile);
      NumOfRecords := 0;
      while not eof(StudentFile) do
        begin
          inc(NumOfRecords);
          read(StudentFile, Students[NumOfRecords]);
        end;
      closeFile(StudentFile);
    end
  else
    begin
      with Students[1] do
        begin
          Forename := 'Jo';
          Surname :='Wood';
          TheoryMark := 55;
          PracticalMark := 66;
        end;
      with Students[2] do
        begin
          Forename := 'John';
          Surname := 'Bode';
          TheoryMark := 73;
          PracticalMark := 58;
        end;
      with Students[3] do
        begin
          Forename := 'Kapil';
          Surname := 'Shah';
          TheoryMark := 59;
          PracticalMark := 58;
        end;
      NumOfRecords := 3;
    end;
end;

procedure FillGrid;
var
  i : integer;
begin
  with frmGrid.sgMarks do
    begin
      RowCount := NumOfRecords + 1; //Top row is for headings
      for i := 1 to NumOfRecords do
        begin
          Cells[0, i] := intToStr(i);
          Cells[1, i] := Students[i].Surname;
          Cells[2, i] := Students[i].Forename;
          Cells[3, i] := intToStr(Students[i].TheoryMark);
          Cells[4, i] := intToStr(Students[i].PracticalMark);
        end;
     end;
end;

procedure GridToArray;
var
  i : integer;
begin
  with frmGrid.sgMarks do
    begin
      for i := 1 to NumOfRecords do
        begin
          Students[i].Surname := Cells[1, i];
          Students[i].Forename := Cells[2, i];
          Students[i].TheoryMark := strToInt(Cells[3, i]);
          Students[i].PracticalMark := strToInt(Cells[4, i]);
        end;
     end;
end;

procedure TfrmGrid.FormCreate(Sender: TObject);
begin
  PopulateArray;
  FillGrid;
end;

procedure TfrmGrid.mmiSaveClick(Sender: TObject);
begin
  if not BlankCell then
    begin
      GridToArray;
      Save;
    end;
end;

procedure TfrmGrid.sgMarksHeaderClick(Sender: TObject; IsColumn: Boolean;
                                    Index: Integer);
var
  i : integer;
begin
  with sgMarks do
    if IsColumn and ((Index = 1) or (Index = 2)) then
      begin
        sortColRow(true, Index);
        for i := 1 to NumOfRecords do
          Cells[0, i] := intToStr(i);
        GridToArray;
      end;
end;

procedure TfrmGrid.sgMarksKeyPress(Sender: TObject; var Key: char);
begin
  //Surnames may contain letters, apostrophy, and hyphen only.
  // #8 is Backspace
  if (sgMarks.Col = 1) and not (Key in [#8, 'a' .. 'z', 'A' .. 'Z', '-', '''']) then
    begin
      ShowMessage('Letters, '' and - only in surname');
      // Discard the key
      Key := #0;
    end;
  //Forenames may contain letters only.
  if (sgMarks.Col = 2) and not (Key in [#8, 'a' .. 'z', 'A' .. 'Z']) then
    begin
      ShowMessage('Letters only in forename');
      Key := #0;
    end;
end; 

procedure TfrmGrid.sgMarksValidateEntry(sender: TObject; aCol, aRow: Integer;
                                        const OldValue: string; var NewValue: String);
var
  EntryAccepted : Boolean;
  intNewValue, intErrorCode : integer;
begin
  EntryAccepted := True;
  if NewValue = '' then
    begin
      showmessage('The cell you edited must not be blank.');
      EntryAccepted := False;
      NewValue := OldValue;
    end
  //validate integer
  else if (aCol = 3) or (aCol = 4) then
    begin
      val(NewValue, intNewValue,  intErrorCode);
      if intErrorCode > 0 then
         begin
           EntryAccepted := False;
           showmessage('Integers only. Error at character position ' + inttostr(intErrorcode));
           NewValue := OldValue;
         end
      //NewValue is an integer.  Now do range check
      else if (intNewValue < 0) or (intNewValue > 100) then
        begin
          showmessage('Must be in range 0 to 100');
          EntryAccepted := False;
          NewValue := OldValue;
        end;
    end;

  if EntryAccepted then
    //Update array
    case aCol of
      1 : Students[aRow].Surname:= sgMarks.Cells[1, aRow];
      2 : Students[aRow].Forename:= sgMarks.Cells[2, aRow];
      3 : Students[aRow].TheoryMark := strToInt(sgMarks.Cells[3, aRow]);
      4 : Students[aRow].PracticalMark := strToInt(sgMarks.Cells[4, aRow]);
    end;
end;


procedure TfrmGrid.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  if BlankCell then
    CanClose := False
  else
    Save;
end;

procedure TfrmGrid.btnNewRecordClick(Sender: TObject);
begin
  inc(NumOfRecords);
  with sgMarks do
    begin
      RowCount := RowCount + 1;
      Cells[0, RowCount - 1] := intToStr(RowCount - 1);
      Row := RowCount - 1;
    end;
end;

procedure TfrmGrid.btnDeleteClick(Sender: TObject);
var
  i, j : integer;
begin
  //Shuffle all records after deleted record down one position
  for i := sgMarks.Row to sgMarks.RowCount - 2 do  //-2 because we stop one row before
                                                   //the last and RowCount includes heading
    for j := 0 to 4 do
      sgMarks.Cells[j, i] := sgMarks.Cells[j, i + 1];
  sgMarks.RowCount := sgMarks.RowCount - 1;
  dec(NumOfRecords);
  for i := 1 to NumOfRecords do
    sgMarks.Cells[0, i] := intToStr(i);
  GridToArray;
end;

end.

uStringGridValDemo.lfm

object frmGrid: TfrmGrid
  Left = 445
  Height = 267
  Top = 205
  Width = 430
  Caption = 'Results'
  ClientHeight = 238
  ClientWidth = 440
  Color = 541106176
  Constraints.MaxHeight = 267
  Constraints.MaxWidth = 440
  Constraints.MinHeight = 267
  Constraints.MinWidth = 440
  Menu = mmResults
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  LCLVersion = '0.9.30'
  object sgMarks: TStringGrid
    Left = 0
    Height = 188
    Top = 16
    Width = 440
    AlternateColor = clLime
    Color = clYellow
    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll]
    RowCount = 4
    TabOrder = 0
    OnHeaderClick = sgMarksHeaderClick
    OnKeyPress = sgMarksKeyPress
    OnValidateEntry = sgMarksValidateEntry
    ColWidths = (
      85
      90
      90
      70
      70
    )
    Cells = (
      5
      0
      0
      'Record No'
      1
      0
      'Surname'
      2
      0
      'Forename'
      3
      0
      'Theory'
      4
      0
      'Practical'
    )
  end
  object btnNewRecord: TButton
    Left = 32
    Height = 25
    Top = 208
    Width = 98
    Caption = 'New Record'
    OnClick = btnNewRecordClick
    TabOrder = 1
  end
  object btnDelete: TButton
    Left = 240
    Height = 25
    Top = 208
    Width = 112
    Caption = 'Delete Record'
    OnClick = btnDeleteClick
    TabOrder = 2
  end
  object mmResults: TMainMenu
    left = 17
    top = 5
    object mmiFile: TMenuItem
      Caption = 'File'
      object mmiSave: TMenuItem
        Caption = 'Save'
        OnClick = mmiSaveClick
      end
    end
  end
end

StringGridValDemo.lpr

program StringGridValDemo;
uses
  Interfaces, Forms, uStringGridValDemo;
begin
  Application.Initialize;
  Application.CreateForm(TfrmGrid, frmGrid);
  Application.Run;
end.