DBGridEh控制单元格显示以及存储过程 触发器和视图以及事务的使用

做Delphi数据库开发也已经几年了，但是对ADO的一些高级应用和DBGridEh的使用一直不太熟练，趁着这周刚好双休，自己做了一个Demo，算是一个小的总结吧，也方便以后应用可以随时查阅。DBGridEh是Ehlib控件包中的一个，比起Delphi自带的DBGrid好用不少，一般也是数据库显示常使用的表格控件之一。要控制DBGridEh的单元格显示主要使用OnGetCellParams或者OnDrawColumnCell事件，根据数据集字段的值来显示不同样式。数据库高级应用一般包括存储过程、触发器和视图以及事务等，使用这些关键是写好sql语句，然后就可以直接用数据集控件比如ADOQuery或者ADOCommand执行和操作。下面是一个比较简单的Demo，也算是一个入门吧。

1.新建一个数据库Test，表结构如下：

2.新建一个Delphi工程，添加两个窗体。

工程文件代码如下：

program DBGridEhDraw;

uses
  Forms,
  DrawDemo in 'DrawDemo.pas' {FrmSeeMoney},
  AdvDBOp in 'AdvDBOp.pas' {Form1};


{$R *.res}


begin
  Application.Initialize;
  Application.CreateForm(TFrmSeeMoney, FrmSeeMoney);
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

 窗体一界面代码和窗体文件如下：

object FrmSeeMoney: TFrmSeeMoney
  Left = 385
  Top = 73
  Width = 657
  Height = 410
  Caption = '财务登记'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object dbgrdh1: TDBGridEh
    Left = 0
    Top = 0
    Width = 631
    Height = 302
    Align = alClient
    AllowedOperations = [alopUpdateEh, alopAppendEh]
    DataGrouping.GroupLevels = <>
    DataSource = ds1
    Flat = False
    FooterColor = clWindow
    FooterFont.Charset = DEFAULT_CHARSET
    FooterFont.Color = clWindowText
    FooterFont.Height = -11
    FooterFont.Name = 'MS Sans Serif'
    FooterFont.Style = []
    RowDetailPanel.Color = clBtnFace
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
    OnDrawColumnCell = dbgrdh1DrawColumnCell
    OnGetCellParams = dbgrdh1GetCellParams
    object RowDetailData: TRowDetailPanelControlEh
    end
  end
  object pnl1: TPanel
    Left = 0
    Top = 302
    Width = 631
    Height = 60
    Align = alBottom
    BevelOuter = bvNone
    TabOrder = 1
    object shp1: TShape
      Left = 16
      Top = 8
      Width = 41
      Height = 33
      Brush.Color = clMedGray
      Pen.Color = clNavy
    end
    object lbl1: TLabel
      Left = 67
      Top = 17
      Width = 46
      Height = 13
      AutoSize = False
      Caption = '未输入'
    end
    object shp2: TShape
      Left = 136
      Top = 8
      Width = 41
      Height = 33
      Brush.Color = clBackground
      Pen.Color = clNavy
    end
    object lbl2: TLabel
      Left = 184
      Top = 17
      Width = 33
      Height = 13
      AutoSize = False
      Caption = '正确'
    end
    object shp3: TShape
      Left = 232
      Top = 8
      Width = 41
      Height = 33
      Brush.Color = clRed
      Pen.Color = clNavy
    end
    object lbl3: TLabel
      Left = 283
      Top = 17
      Width = 86
      Height = 13
      AutoSize = False
      Caption = '付款大于实收'
    end
    object shp4: TShape
      Left = 400
      Top = 8
      Width = 41
      Height = 33
      Brush.Color = clBlue
      Pen.Color = clNavy
    end
    object lbl4: TLabel
      Left = 451
      Top = 17
      Width = 94
      Height = 13
      AutoSize = False
      Caption = '付款小于实收'
    end
  end
  object ds1: TDataSource
    DataSet = tbl1
    Left = 440
    Top = 64
  end
  object tbl1: TADOTable
    Active = True
    ConnectionString = 
      'Provider=SQLOLEDB.1;Password="";Persist Security Info=True;User ' +
      'ID=sa;Initial Catalog=Test;Data Source=.'
    CursorType = ctStatic
    TableName = 'tbl_finance'
    Left = 184
    Top = 120
    object strngfldtbl1billNo: TStringField
      DisplayLabel = '单据编号'
      FieldName = 'billNo'
      ReadOnly = True
    end
    object intgrfldtbl1billId: TIntegerField
      FieldName = 'billId'
      ReadOnly = True
      Visible = False
    end
    object tbl1paymoney: TFloatField
      DisplayLabel = '付款金额'
      FieldName = 'paymoney'
      ReadOnly = True
      DisplayFormat = '0.00'
    end
    object tbl1recmoney: TFloatField
      DisplayLabel = '实收金额'
      FieldName = 'recmoney'
      OnGetText = tbl1recmoneyGetText
      DisplayFormat = '0.00'
    end
  end
end

源代码如下：

unit DrawDemo;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DBGridEhGrouping, DB, ADODB, StdCtrls, ExtCtrls, GridsEh,
  DBGridEh;


type
  TFrmSeeMoney = class(TForm)
    dbgrdh1: TDBGridEh;
    ds1: TDataSource;
    pnl1: TPanel;
    shp1: TShape;
    lbl1: TLabel;
    shp2: TShape;
    lbl2: TLabel;
    shp3: TShape;
    lbl3: TLabel;
    shp4: TShape;
    lbl4: TLabel;
    tbl1: TADOTable;
    strngfldtbl1billNo: TStringField;
    intgrfldtbl1billId: TIntegerField;
    tbl1paymoney: TFloatField;
    tbl1recmoney: TFloatField;
    procedure tbl1recmoneyGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure dbgrdh1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure dbgrdh1GetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
  private
  public
    { Public declarations }
  end;


var
  FrmSeeMoney: TFrmSeeMoney;


implementation


{$R *.dfm}

procedure TFrmSeeMoney.tbl1recmoneyGetText(Sender: TField;
  var Text: String; DisplayText: Boolean);
begin
  if Sender.IsNull then
  begin
    Text:=FormatFloat('0.00',tbl1paymoney.AsFloat);
  end
  else
    Text:=FormatFloat('0.00',tbl1recmoney.AsFloat);
end;


procedure TFrmSeeMoney.dbgrdh1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumnEh;
  State: TGridDrawState);
begin
//  if column.FieldName='recmoney' then
//  begin
//    if tbl1recmoney.IsNull then
//     TDBGridEh(Sender).Canvas.Font.Color:=shp1.Brush.Color
//    else if (tbl1paymoney.AsFloat-tbl1recmoney.AsFloat=0) then
//     TDBGridEh(Sender).Canvas.Font.Color:=shp2.Brush.Color
//    else if (tbl1paymoney.AsFloat-tbl1recmoney.AsFloat<0) then
//     TDBGridEh(Sender).Canvas.Font.Color:=shp4.Brush.Color
//    else if (tbl1paymoney.AsFloat-tbl1recmoney.AsFloat>0) then
//     TDBGridEh(Sender).Canvas.Font.Color:=shp3.Brush.Color;
//  end;
//  TDBGridEh(Sender).DefaultDrawColumnCell(rect,DataCol,column,state);
end;


procedure TFrmSeeMoney.dbgrdh1GetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
   if column.FieldName='recmoney' then
  begin
    if tbl1recmoney.IsNull then
     AFont.Color:=shp1.Brush.Color
    else if (tbl1paymoney.AsFloat-tbl1recmoney.AsFloat=0) then
     AFont.Color:=shp2.Brush.Color
    else if (tbl1paymoney.AsFloat-tbl1recmoney.AsFloat<0) then
     AFont.Color:=shp4.Brush.Color
    else if (tbl1paymoney.AsFloat-tbl1recmoney.AsFloat>0) then
     AFont.Color:=shp3.Brush.Color
  end;
end;

end.

窗体二窗体文件和代码如下：

object Form1: TForm1
  Left = 420
  Top = 109
  Width = 330
  Height = 305
  Caption = 'Delphi数据库开发小结'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object btnProc: TButton
    Left = 80
    Top = 24
    Width = 113
    Height = 25
    Caption = '调用存储过程'
    TabOrder = 0
    OnClick = btnProcClick
  end
  object btnTrigger: TButton
    Left = 80
    Top = 80
    Width = 113
    Height = 25
    Caption = '创建触发器'
    TabOrder = 1
    OnClick = btnTriggerClick
  end
  object btnView: TButton
    Left = 80
    Top = 128
    Width = 113
    Height = 25
    Caption = '创建视图'
    TabOrder = 2
    OnClick = btnViewClick
  end
  object btnTrans: TButton
    Left = 80
    Top = 184
    Width = 113
    Height = 25
    Caption = '使用事务'
    TabOrder = 3
    OnClick = btnTransClick
  end
  object con1: TADOConnection
    ConnectionString = 
      'Provider=SQLOLEDB.1;Password="";Persist Security Info=True;User ' +
      'ID=sa;Initial Catalog=Test;Data Source=.'
    LoginPrompt = False
    Provider = 'SQLOLEDB.1'
    Left = 216
    Top = 56
  end
  object qry1: TADOQuery
    Connection = con1
    Parameters = <>
    Left = 224
    Top = 112
  end
end

unit AdvDBOp;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB;


type
  TForm1 = class(TForm)
    con1: TADOConnection;
    qry1: TADOQuery;
    btnProc: TButton;
    btnTrigger: TButton;
    btnView: TButton;
    btnTrans: TButton;
    procedure btnProcClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnTriggerClick(Sender: TObject);
    procedure btnViewClick(Sender: TObject);
    procedure btnTransClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;


implementation


{$R *.dfm}


const
  strDropProc=
   'if exists(select id from sysobjects where name=''TestProc'' and xtype=''P'')' + #13#10 +
   'drop procedure TestProc';
  strCreateProc=
   'create procedure TestProc' + #13#10 +
   'as' + #13#10 +
   'begin' + #13#10 +
   'declare @maxId int' + #13#10 +
   'select @maxId=Max(deptid) from tbl_dept' + #13#10 +
   'return @maxId' + #13#10 +
   'end';




  strDropTrigger=
    'IF OBJECT_ID (''Tri_finance'', ''TR'') IS NOT NULL' + #13#10 +
    'DROP TRIGGER Tri_finance';
  strCreateTrigger=
    'create trigger Tri_finance' + #13#10 +
    'on tbl_finance' + #13#10 +
    'for delete' + #13#10 +
    'as' + #13#10 +
    'begin' + #13#10 +
    'if object_ID(''tlb_FinanceBak'',''U'') Is Null' + #13#10 +
    'select * into tlb_FinanceBak from deleted' + #13#10 +
    'else' + #13#10 +
    'insert into tlb_FinanceBak' + #13#10 +
    'select * from deleted' + #13#10 +
    'end';


  strDropView=
   'IF OBJECT_ID (''View_User'', ''V'') IS NOT NULL' + #13#10 +
   'DROP View View_User';
  strCreateView=
   'Create View View_User' + #13#10 +
   'as' + #13#10 + 
   'select * from tbl_user';


   
procedure TForm1.btnProcClick(Sender: TObject);
begin
  with qry1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('declare @t int');
    SQL.Add('Exec @t=TestProc');
    SQL.Add('select @t as ft');
    Open;
    ShowMessage(inttostr(FieldByName('ft').AsInteger));
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  with qry1 do
  begin
    Close;
    SQL.Clear;
    SQL.Text:=strDropProc;
    ExecSQL;
    Close;
    SQL.Clear;
    SQL.Text:=strCreateProc;
    ExecSQL;
  end;
end;


procedure TForm1.btnTriggerClick(Sender: TObject);
begin
  with qry1 do
  begin
    Close;
    SQL.Clear;
    SQL.Text:=strDropTrigger;
    ExecSQL;
    Close;
    SQL.Clear;
    SQL.Text:=strCreateTrigger;
    ExecSQL;
  end;
end;


procedure TForm1.btnViewClick(Sender: TObject);
begin
  with qry1 do
  begin
    Close;
    SQL.Clear;
    SQL.Text:=strDropView;
    ExecSQL;
    Close;
    SQL.Clear;
    SQL.Text:=strCreateView;
    ExecSQL;
  end;
end;


procedure TForm1.btnTransClick(Sender: TObject);
begin
  try
   con1.BeginTrans;
   with qry1 do
   begin
     Close;
     SQL.Clear;
     SQL.Add('delete from tbl_user where deptid=2');
     SQL.Add('delete from tbl_dept where deptid=2');
     ExecSQL;
     con1.CommitTrans;
   end;
  except
   con1.RollbackTrans;
  end;
end;

end.

运行后效果如下：

在windows下开发数据库程序，用Delphi无疑是比较快，还有很多知识点需要不断学习和总结，也希望能有同道中人的不断指点，共同提高。