marcocantu.com - Code Repository

Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 14 - Project upsqldemo

Project Structure

upsqldemo.dpr
main.pas
data.pas
depts.pas
jobs.pas
main.dfm
data.dfm
depts.dfm
jobs.dfm

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, Variants;

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
    DesignSize = (
      628
      33)
    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