Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project UPSQLDEMO

Project Structure


UPSQLDEMO.DPR

program upsqldemo;

uses
  Forms,
  main in 'main.pas' {MainForm},
  data in 'data.pas' {dmData: TDataModule},
  depts in 'depts.pas' {frmDepartments},
  jobs in 'jobs.pas' {frmJobs};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TdmData, dmData);
  Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TfrmDepartments, frmDepartments);
  Application.CreateForm(TfrmJobs, frmJobs);
  Application.Run;
end.

MAIN.PAS

unit main;

interface

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

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    DBNavigator1: TDBNavigator;
    btnClose: TButton;
    btnApply: TButton;
    procedure btnCloseClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1EditButtonClick(Sender: TObject);
    procedure btnApplyClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  Data, depts, jobs;

{$R *.DFM}

resourcestring
  CloseMsg = 'Data has been modified.'#13#13'Save changes?'  ;

procedure TMainForm.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  Res: Integer;
begin
  with dmData do
    if qryEmployee.UpdatesPending then
    begin
      Res := MessageDlg(CloseMsg, mtInformation, mbYesNoCancel, 0);
      if Res = mrYes then
        AppDB.ApplyUpdates([qryEmployee]);
      CanClose := Res <> mrCancel;
    end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  dmData.qryEmployee.Open;
end;

procedure TMainForm.DBGrid1EditButtonClick(Sender: TObject);
begin
  // Department?
  if DBGrid1.SelectedField = dmData.qryEmployeeDEPARTMENT then
    with TfrmDepartments.Create(Self) do
    try
      dmData.qryDepartment.Locate('DEPT_NO',
        dmData.qryEmployeeDEPT_NO.Value, []);
      if ShowModal = mrOk then
        with dmData do
          begin
            if not (qryEmployee.State in [dsEdit, dsInsert]) then
              qryEmployee.Edit;
            qryEmployeeDEPT_NO.Value :=  qryDepartment.Fields[0].Value;
            qryEmployeeDEPARTMENT.Value := qryDepartment.Fields[1].Value;
          end;
    finally
      Free;
    end
  else
    with TfrmJobs.Create(Self) do
    try
      with dmData do
        qryJob.Locate('JOB_CODE;JOB_GRADE;JOB_COUNTRY',
          VarArrayOf([qryEmployeeJOB_CODE.Value,qryEmployeeJOB_GRADE.Value,
          qryEmployeeJOB_COUNTRY.Value]), []);
      if ShowModal = mrOk then
        with dmData do
        begin
          if not (qryEmployee.State in [dsEdit, dsInsert]) then
            qryEmployee.Edit;
          qryEmployeeJOB_CODE.Value :=  qryJob.Fields[0].Value;
          qryEmployeeJOB_GRADE.Value := qryJob.Fields[1].Value;
          qryEmployeeJOB_COUNTRY.Value := qryJob.Fields[2].Value;
          qryEmployeeJOB_TITLE.Value := qryJob.Fields[3].Value;
          // set salary to min_salary
          qryEmployeeSALARY.Value := qryJob.Fields[4].Value;
        end;
    finally
      Free;
    end;
end;

procedure TMainForm.btnApplyClick(Sender: TObject);
begin
  with dmData do
    if qryEmployee.UpdatesPending then
    begin
      AppDB.ApplyUpdates([qryEmployee]);
      // refresh data
      qryEmployee.Close;
      qryEmployee.Open;
      btnApply.Enabled := False;
    end;
end;

end.

DATA.PAS

unit data;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBTables, Db;

type
  TdmData = class(TDataModule)
    spDelEmployee: TStoredProc;
    EmpDS: TDataSource;
    EmpUpdate: TUpdateSQL;
    qryEmployee: TQuery;
    qryEmployeeEMP_NO: TSmallintField;
    qryEmployeeFIRST_NAME: TStringField;
    qryEmployeeLAST_NAME: TStringField;
    qryEmployeeDEPARTMENT: TStringField;
    qryEmployeeJOB_TITLE: TStringField;
    qryEmployeeSALARY: TFloatField;
    AppDB: TDatabase;
    qryDepartment: TQuery;
    DepDS: TDataSource;
    qryEmployeeDEPT_NO: TStringField;
    qryJob: TQuery;
    JobDS: TDataSource;
    qryEmployeeJOB_CODE: TStringField;
    qryEmployeeJOB_GRADE: TSmallintField;
    qryEmployeeJOB_COUNTRY: TStringField;
    procedure qryEmployeeUpdateRecord(DataSet: TDataSet;
      UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    procedure EmpDSUpdateData(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  dmData: TdmData;

implementation

uses main;

{$R *.DFM}

procedure TdmData.qryEmployeeUpdateRecord(DataSet: TDataSet;
  UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
begin
  // when deleting the record, use the Stored Procedure
  if UpdateKind = ukDelete then
  begin
    // assign emp_no value
    with dmData do
      spDelEmployee.Params[0].Value := qryEmployeeEMP_NO.OldValue;
    try
      // invoke stored proc that tries to delete employee
      dmData.spDelEmployee.ExecProc;
      UpdateAction := uaApplied; // success
    except
      UpdateAction := uaFail;
    end;
  end
  else
  try
    // apply updates
    dmData.EmpUpdate.Apply(UpdateKind);
    UpdateAction := uaApplied;
  except
    UpdateAction := uaFail;
  end;
end;

procedure TdmData.EmpDSUpdateData(Sender: TObject);
begin
  MainForm.btnApply.Enabled := True;
end;

end.

DEPTS.PAS

unit depts;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, StdCtrls;

type
  TfrmDepartments = class(TForm)
    btnAccept: TButton;
    DBGrid1: TDBGrid;
    Label1: TLabel;
    btnCancel: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmDepartments: TfrmDepartments;

implementation

uses data;

{$R *.DFM}

procedure TfrmDepartments.FormCreate(Sender: TObject);
begin
  try
    dmData.qryDepartment.Open;
  except
    Close;
  end;
end;

procedure TfrmDepartments.FormDestroy(Sender: TObject);
begin
  dmData.qryDepartment.Close;
end;

end.

JOBS.PAS

unit jobs;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids;

type
  TfrmJobs = class(TForm)
    DBGrid1: TDBGrid;
    Label1: TLabel;
    btnAccept: TButton;
    btnCancel: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmJobs: TfrmJobs;

implementation

uses data;

{$R *.DFM}

procedure TfrmJobs.FormCreate(Sender: TObject);
begin
  try
    dmData.qryJob.Open;
  except
    Close;
  end;
end;

procedure TfrmJobs.FormDestroy(Sender: TObject);
begin
  dmData.qryJob.Close;
end;

end.

MAIN.DFM

object MainForm: TMainForm
  Left = 188
  Top = 134
  Width = 636
  Height = 391
  ActiveControl = DBGrid1
  Caption = 'UpdateSQL Sample'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 331
    Width = 628
    Height = 33
    Align = alBottom
    TabOrder = 0
    object DBNavigator1: TDBNavigator
      Left = 4
      Top = 4
      Width = 234
      Height = 25
      DataSource = dmData.EmpDS
      VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete, nbEdit, nbPost, nbCancel]
      Flat = True
      TabOrder = 0
    end
    object btnClose: TButton
      Left = 548
      Top = 4
      Width = 75
      Height = 25
      Anchors = [akRight]
      Caption = '&Close'
      TabOrder = 2
      OnClick = btnCloseClick
    end
    object btnApply: TButton
      Left = 244
      Top = 4
      Width = 89
      Height = 25
      Caption = '&Apply changes'
      Enabled = False
      TabOrder = 1
      OnClick = btnApplyClick
    end
  end
  object DBGrid1: TDBGrid
    Left = 0
    Top = 0
    Width = 628
    Height = 331
    Align = alClient
    DataSource = dmData.EmpDS
    TabOrder = 1
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
    OnEditButtonClick = DBGrid1EditButtonClick
    Columns = <
      item
        Expanded = False
        FieldName = 'FIRST_NAME'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'LAST_NAME'
        Width = 64
        Visible = True
      end
      item
        ButtonStyle = cbsEllipsis
        Expanded = False
        FieldName = 'DEPARTMENT'
        Width = 64
        Visible = True
      end
      item
        ButtonStyle = cbsEllipsis
        Expanded = False
        FieldName = 'JOB_TITLE'
        Width = 64
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'SALARY'
        Visible = True
      end>
  end
end

DATA.DFM

object dmData: TdmData
  OldCreateOrder = False
  Left = 358
  Top = 268
  Height = 479
  Width = 741
  object spDelEmployee: TStoredProc
    DatabaseName = 'AppDB'
    StoredProcName = 'DELETE_EMPLOYEE'
    Left = 44
    Top = 128
    ParamData = <
      item
        DataType = ftInteger
        Name = 'EMP_NUM'
        ParamType = ptInput
      end>
  end
  object EmpDS: TDataSource
    DataSet = qryEmployee
    OnUpdateData = EmpDSUpdateData
    Left = 188
    Top = 8
  end
  object EmpUpdate: TUpdateSQL
    ModifySQL.Strings = (
      'update EMPLOYEE'
      'set'
      '  FIRST_NAME = :FIRST_NAME,'
      '  LAST_NAME = :LAST_NAME,'
      '  SALARY = :SALARY,'
      '  DEPT_NO = :DEPT_NO,'
      '  JOB_CODE = :JOB_CODE,'
      '  JOB_GRADE = :JOB_GRADE,'
      '  JOB_COUNTRY = :JOB_COUNTRY'
      'where'
      '  EMP_NO = :OLD_EMP_NO')
    InsertSQL.Strings = (
      'insert into EMPLOYEE'
      '  (FIRST_NAME, LAST_NAME, SALARY, DEPT_NO, JOB_CODE, JOB_GRADE, '
      'JOB_COUNTRY)'
      'values'

              '  (:FIRST_NAME, :LAST_NAME, :SALARY, :DEPT_NO, :JOB_CODE, :JOB_G' +
        'RADE, '
      ':JOB_COUNTRY)')
    DeleteSQL.Strings = (
      'delete from EMPLOYEE'
      'where'
      '  EMP_NO = :OLD_EMP_NO')
    Left = 128
    Top = 8
  end
  object qryEmployee: TQuery
    CachedUpdates = True
    OnUpdateRecord = qryEmployeeUpdateRecord
    DatabaseName = 'AppDB'
    SQL.Strings = (

              'SELECT Employee.EMP_NO, Employee.FIRST_NAME, Employee.LAST_NAME,' +
        ' Department.DEPARTMENT, Job.JOB_TITLE, Employee.SALARY, Employee' +
        '.DEPT_NO, Employee.JOB_CODE, Employee.JOB_GRADE, Employee.JOB_CO' +
        'UNTRY'
      'FROM EMPLOYEE Employee'
      '   INNER JOIN DEPARTMENT Department'
      '   ON  (Department.DEPT_NO = Employee.DEPT_NO)  '
      '   INNER JOIN JOB Job'
      '   ON  (Job.JOB_CODE = Employee.JOB_CODE)  '
      '   AND  (Job.JOB_GRADE = Employee.JOB_GRADE)  '
      '   AND  (Job.JOB_COUNTRY = Employee.JOB_COUNTRY)  '
      'ORDER BY Department.DEPARTMENT')
    UpdateMode = upWhereKeyOnly
    UpdateObject = EmpUpdate
    Left = 60
    Top = 8
    object qryEmployeeEMP_NO: TSmallintField
      FieldName = 'EMP_NO'
      Visible = False
    end
    object qryEmployeeFIRST_NAME: TStringField
      FieldName = 'FIRST_NAME'
      FixedChar = False
      Size = 15
    end
    object qryEmployeeLAST_NAME: TStringField
      FieldName = 'LAST_NAME'
      FixedChar = False
    end
    object qryEmployeeDEPARTMENT: TStringField
      FieldName = 'DEPARTMENT'
      FixedChar = False
      Size = 25
    end
    object qryEmployeeJOB_TITLE: TStringField
      FieldName = 'JOB_TITLE'
      FixedChar = False
      Size = 25
    end
    object qryEmployeeSALARY: TFloatField
      FieldName = 'SALARY'
    end
    object qryEmployeeDEPT_NO: TStringField
      FieldName = 'DEPT_NO'
      Visible = False
      FixedChar = False
      Size = 3
    end
    object qryEmployeeJOB_CODE: TStringField
      FieldName = 'JOB_CODE'
      FixedChar = False
      Size = 5
    end
    object qryEmployeeJOB_GRADE: TSmallintField
      FieldName = 'JOB_GRADE'
    end
    object qryEmployeeJOB_COUNTRY: TStringField
      FieldName = 'JOB_COUNTRY'
      FixedChar = False
      Size = 15
    end
  end
  object AppDB: TDatabase
    AliasName = 'IBLocal'
    Connected = True
    DatabaseName = 'AppDB'
    LoginPrompt = False
    Params.Strings = (

              'SERVER NAME=C:\Program Files\Common Files\Borland Shared\Data\em' +
        'ployee.gdb'
      'USER NAME=SYSDBA'
      'OPEN MODE=READ/WRITE'
      'SCHEMA CACHE SIZE=8'
      'LANGDRIVER='
      'SQLQRYMODE='
      'SQLPASSTHRU MODE=SHARED AUTOCOMMIT'
      'SCHEMA CACHE TIME=-1'
      'MAX ROWS=-1'
      'BATCH COUNT=200'
      'ENABLE SCHEMA CACHE=FALSE'
      'SCHEMA CACHE DIR='
      'ENABLE BCD=FALSE'
      'BLOBS TO CACHE=64'
      'BLOB SIZE=32'
      'PASSWORD=masterkey')
    SessionName = 'Default'
    Left = 8
    Top = 8
  end
  object qryDepartment: TQuery
    DatabaseName = 'AppDB'
    SQL.Strings = (
      'SELECT DEPT_NO,Department'
      'FROM Department')
    Left = 26
    Top = 66
  end
  object DepDS: TDataSource
    DataSet = qryDepartment
    Left = 84
    Top = 68
  end
  object qryJob: TQuery
    DatabaseName = 'AppDB'
    SQL.Strings = (

              'SELECT JOB_CODE, JOB_GRADE, JOB_COUNTRY, JOB_TITLE, MIN_SALARY, ' +
        'MAX_SALARY'
      'FROM JOB Job')
    Left = 136
    Top = 68
  end
  object JobDS: TDataSource
    DataSet = qryJob
    Left = 184
    Top = 68
  end
end

DEPTS.DFM

object frmDepartments: TfrmDepartments
  Left = 192
  Top = 133
  ActiveControl = DBGrid1
  BorderStyle = bsDialog
  Caption = 'Select a Department'
  ClientHeight = 256
  ClientWidth = 338
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 8
    Width = 100
    Height = 13
    Caption = 'Select a Department:'
  end
  object btnAccept: TButton
    Left = 8
    Top = 224
    Width = 75
    Height = 25
    Caption = '&Accept'
    Default = True
    ModalResult = 1
    TabOrder = 1
  end
  object DBGrid1: TDBGrid
    Left = 9
    Top = 28
    Width = 320
    Height = 185
    DataSource = dmData.DepDS
    Options = [dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect, dgConfirmDelete, dgCancelOnExit]
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object btnCancel: TButton
    Left = 253
    Top = 224
    Width = 75
    Height = 25
    Cancel = True
    Caption = '&Cancel'
    ModalResult = 2
    TabOrder = 2
  end
end

JOBS.DFM

object frmJobs: TfrmJobs
  Left = 195
  Top = 232
  ActiveControl = DBGrid1
  BorderStyle = bsDialog
  Caption = 'Select a Job'
  ClientHeight = 256
  ClientWidth = 338
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 8
    Width = 62
    Height = 13
    Caption = 'Select a Job:'
  end
  object DBGrid1: TDBGrid
    Left = 9
    Top = 28
    Width = 320
    Height = 185
    DataSource = dmData.JobDS
    Options = [dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect, dgConfirmDelete, dgCancelOnExit]
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object btnAccept: TButton
    Left = 8
    Top = 224
    Width = 75
    Height = 25
    Caption = '&Accept'
    Default = True
    ModalResult = 1
    TabOrder = 1
  end
  object btnCancel: TButton
    Left = 253
    Top = 224
    Width = 75
    Height = 25
    Cancel = True
    Caption = '&Cancel'
    ModalResult = 2
    TabOrder = 2
  end
end