Home: Code Repository: Mastering Delphi 5

Project CHECKDBG

Project Structure

CHECKDBG.DPR
CHECKF.PAS
CHECKF.DFM

program CheckDbg;

uses
  Forms,
  CheckF in 'CheckF.pas' {DbaForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TDbaForm, DbaForm);
  Application.Run;
end.

unit CheckF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, StdCtrls, Mask, DBCtrls, ExtCtrls, Grids, DBGrids, ComCtrls;

type
  TDbaForm = class(TForm)
    Table1: TTable;
    DataSource1: TDataSource;
    Table1LastName: TStringField;
    Table1FirstName: TStringField;
    Table1Department: TSmallintField;
    Table1Branch: TStringField;
    Table1Senior: TBooleanField;
    Table1HireDate: TDateField;
    DBGrid1: TDBGrid;
    DBCheckBox1: TDBCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Table1DepartmentGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure Table1DepartmentSetText(Sender: TField; const Text: String);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1ColEnter(Sender: TObject);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  end;

var
  DbaForm: TDbaForm;

implementation

{$R *.DFM}

procedure TDbaForm.FormCreate(Sender: TObject);
begin
  if not Table1.Exists then
  begin
    Table1.CreateTable;
    ShowMessage ('You can add data to this table'#13 +
      'by using the DbAware example of Chapter 9');
  end;
  Table1.Open;
end;

procedure TDbaForm.Table1DepartmentGetText(Sender: TField;
  var Text: String; DisplayText: Boolean);
begin
  case Sender.AsInteger of
    1: Text := 'Sales';
    2: Text := 'Accounting';
    3: Text := 'Production';
    4: Text := 'Management';
  else
    Text := '[Error]';
  end;
end;

procedure TDbaForm.Table1DepartmentSetText(Sender: TField;
  const Text: String);
begin
  if Text = 'Sales' then
    Sender.Value := 1
  else if Text = 'Accounting' then
    Sender.Value := 2
  else if Text = 'Production' then
    Sender.Value := 3
  else if Text = 'Management' then
    Sender.Value := 4
  else
    raise Exception.Create ('Error in Department field conversion');
end;

procedure TDbaForm.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  if (gdFocused in State) and
    (Column.Field = Table1Senior) then
  begin
    DBCheckBox1.SetBounds (
      Rect.Left + DBGrid1.Left + 1,
      Rect.Top + DBGrid1.Top + 1,
      Rect.Right - Rect.Left,
      Rect.Bottom - Rect.Top);
  end;
end;

procedure TDbaForm.DBGrid1ColEnter(Sender: TObject);
begin
  if DBGrid1.Columns [DBGrid1.SelectedIndex].
      Field = Table1Senior then
    DBCheckBox1.Visible := True
  else
    DBCheckBox1.Visible := False;
end;

procedure TDbaForm.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if DBCheckBox1.Visible and (Ord (Key) > 31) then
  begin
    Key := #0;
    Table1.Edit;
    DBCheckBox1.Checked := not
      DBCheckBox1.Checked;
    DBCheckBox1.Field.AsBoolean :=
      DBCheckBox1.Checked;
  end;
end;

end.

object DbaForm: TDbaForm
  Left = 196
  Top = 109
  Width = 620
  Height = 298
  Caption = 'Workers (Checkbox DBGrid Demo)'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 0
    Top = 0
    Width = 612
    Height = 271
    Align = alClient
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
    OnColEnter = DBGrid1ColEnter
    OnDrawColumnCell = DBGrid1DrawColumnCell
    OnKeyPress = DBGrid1KeyPress
    Columns = <
      item
        Expanded = False
        FieldName = 'LastName'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'FirstName'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'Department'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'Branch'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'Senior'
        Width = 80
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'HireDate'
        Width = 69
        Visible = True
      end>
  end
  object DBCheckBox1: TDBCheckBox
    Left = 256
    Top = 72
    Width = 65
    Height = 17
    Caption = 'Senior'
    Color = clBtnFace
    Ctl3D = True
    DataField = 'Senior'
    DataSource = DataSource1
    ParentColor = False
    ParentCtl3D = False
    TabOrder = 1
    ValueChecked = 'True'
    ValueUnchecked = 'False'
    Visible = False
  end
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    FieldDefs = <
      item
        Name = 'LastName'
        DataType = ftString
        Size = 20
      end
      item
        Name = 'FirstName'
        DataType = ftString
        Size = 20
      end
      item
        Name = 'Department'
        DataType = ftSmallint
      end
      item
        Name = 'Branch'
        DataType = ftString
        Size = 20
      end
      item
        Name = 'Senior'
        DataType = ftBoolean
      end
      item
        Name = 'HireDate'
        DataType = ftDate
      end>
    StoreDefs = True
    TableName = 'Workers'
    Left = 392
    Top = 8
    object Table1LastName: TStringField
      FieldName = 'LastName'
      FixedChar = False
    end
    object Table1FirstName: TStringField
      FieldName = 'FirstName'
      FixedChar = False
    end
    object Table1Department: TSmallintField
      Alignment = taLeftJustify
      FieldName = 'Department'
      OnGetText = Table1DepartmentGetText
      OnSetText = Table1DepartmentSetText
    end
    object Table1Branch: TStringField
      FieldName = 'Branch'
      FixedChar = False
    end
    object Table1Senior: TBooleanField
      FieldName = 'Senior'
    end
    object Table1HireDate: TDateField
      FieldName = 'HireDate'
    end
  end
  object DataSource1: TDataSource
    DataSet = Table1
    Left = 344
    Top = 8
  end
end