dbbasic.~pas

no infomation. say it again. no infomation

unit dbBasic;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ToolWin, ComCtrls, ImgList, ActnList, Buttons,
  StdCtrls, shareunit, DB, FMTBcd, DBClient, Provider, SqlExpr, DBTables,
  cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
  cxEdit, cxDBData, cxGridLevel, cxClasses, cxControls, cxGridCustomView,
  cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid,
  cxTextEdit, cxCurrencyEdit, ADODB, cxMaskEdit;

type
  Tfmodel = class(TForm)
    Panel1: TPanel;
    ToolBar1: TToolBar;
    ImageList1: TImageList;
    ImageList2: TImageList;
    TBtn_Add: TToolButton;
    ActionList1: TActionList;
    Act_Add: TAction;
    Act_Del: TAction;
    Act_Save: TAction;
    Act_Cancel: TAction;
    Act_Refresh: TAction;
    Act_Close: TAction;
    TBtn_Del: TToolButton;
    TBtn_Save: TToolButton;
    TBtn_Cancel: TToolButton;
    TBtn_Refresh: TToolButton;
    ToolButton1: TToolButton;
    Panel2: TPanel;
    Panel3: TPanel;
    SpeedButton1: TSpeedButton;
    LabeledEdit1: TLabeledEdit;
    ds: TDataSource;
    tb: TTable;
    DView: TcxGridDBTableView;
    cxGrid1Level1: TcxGridLevel;
    cxGrid1: TcxGrid;
    DViewModel: TcxGridDBColumn;
    DViewBoxnum: TcxGridDBColumn;
    cxStyleRepository1: TcxStyleRepository;
    cxStyle1: TcxStyle;
    cxStyle2: TcxStyle;
    procedure Act_AddExecute(Sender: TObject);
    procedure Act_AddUpdate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Act_DelExecute(Sender: TObject);
    procedure Act_DelUpdate(Sender: TObject);
    procedure Act_SaveExecute(Sender: TObject);
    procedure Act_SaveUpdate(Sender: TObject);
    procedure Act_CancelExecute(Sender: TObject);
    procedure Act_CancelUpdate(Sender: TObject);
    procedure Act_RefreshExecute(Sender: TObject);
    procedure Act_RefreshUpdate(Sender: TObject);
    procedure Act_CloseExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure LabeledEdit1KeyPress(Sender: TObject; var Key: Char);
    procedure tbAfterInsert(DataSet: TDataSet);
    procedure tbBeforeInsert(DataSet: TDataSet);
    procedure tbAfterPost(DataSet: TDataSet);
    procedure tbAfterCancel(DataSet: TDataSet);
    procedure tbBeforePost(DataSet: TDataSet);
    procedure DViewModelPropertiesValidate(Sender: TObject;
      var DisplayValue: Variant; var ErrorText: TCaption;
      var Error: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmodel: Tfmodel;

implementation

{$R *.dfm}

procedure Tfmodel.Act_AddExecute(Sender: TObject);
begin
  ds.DataSet.Append;
end;

procedure Tfmodel.Act_AddUpdate(Sender: TObject);
begin
  TBtn_Add.Enabled:=not(ds.State in [dsInsert, dsEdit]);
end;

procedure Tfmodel.FormCreate(Sender: TObject);
begin
  with tb do
  begin
    DataBaseName:=ExtractFilePath(Application.ExeName);
    if not Active then Open;
  end;
end;

procedure Tfmodel.Act_DelExecute(Sender: TObject);
begin
  if PromptMsg('Are you sure you want to delete this record? ',3)=IDYes then ds.DataSet.Delete;
end;

procedure Tfmodel.Act_DelUpdate(Sender: TObject);
begin
  TBtn_Del.enabled:=not((ds.State in [dsInsert, dsEdit]) or ds.DataSet.IsEmpty)
end;

procedure Tfmodel.Act_SaveExecute(Sender: TObject);
begin
  ds.DataSet.Post;
end;

procedure Tfmodel.Act_SaveUpdate(Sender: TObject);
begin
  TBtn_Save.Enabled:=ds.State in [dsInsert, dsEdit]
end;

procedure Tfmodel.Act_CancelExecute(Sender: TObject);
begin
  if PromptMsg('Withdraw this record? Press Ctrl+Q for withdrawal! ',3)=IDNo then exit
  else  ds.DataSet.Cancel;
end;

procedure Tfmodel.Act_CancelUpdate(Sender: TObject);
begin
  TBtn_Cancel.Enabled:=ds.State in [dsInsert, dsEdit]
end;

procedure Tfmodel.Act_RefreshExecute(Sender: TObject);
begin
  screen.Cursor:=crHourglass;
  try
    ds.DataSet.Refresh;
  finally
    screen.Cursor:=crDefault;
  end;
end;

procedure Tfmodel.Act_RefreshUpdate(Sender: TObject);
begin
  TBtn_Refresh.Enabled:=not(ds.State in [dsInsert, dsEdit])
end;

procedure Tfmodel.Act_CloseExecute(Sender: TObject);
begin
  Close;
end;

procedure Tfmodel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure Tfmodel.LabeledEdit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#13 then
    if not ds.DataSet.Locate('model',LabeledEdit1.Text,[]) then
    begin
      //没有找到符合条件的记录
      PromptMsg('Required record not found！',0);
      LabeledEdit1.SetFocus;
    end;
end;

procedure Tfmodel.tbAfterInsert(DataSet: TDataSet);
begin
  DviewModel.Properties.ReadOnly:=false;
  DataSet.Fields[0].FocusControl;
end;

procedure Tfmodel.tbBeforeInsert(DataSet: TDataSet);
var
  i: integer;
begin
  with DataSet do
    for i:=0 to Fields.Count-1 do Fields[i].ReadOnly:=False;
end;

procedure Tfmodel.tbAfterPost(DataSet: TDataSet);
begin
  DviewModel.Properties.ReadOnly:=true;
end;

procedure Tfmodel.tbAfterCancel(DataSet: TDataSet);
begin
  DviewModel.Properties.ReadOnly:=true;
end;

procedure Tfmodel.tbBeforePost(DataSet: TDataSet);
begin
  with DataSet do
    begin
      if (Fields[0].IsNull) or (Fields[0].AsString='') then
        begin
          //不可为空
          PromptMsg(Fields[0].DisplayLabel+'is NOT allowed empty！');
          Fields[0].FocusControl;
          Abort;
        end;
      if not DviewModel.Properties.ReadOnly then
        begin
          if ExistData('select * from tmodel where model='''+Fields[0].AsString+'''',[]) then
            begin
            PromptMsg('Failure！Index of this record in NOT unique',1);
            Fields[0].FocusControl;
            Abort;
          end;
        end;
    end;
end;

procedure Tfmodel.DViewModelPropertiesValidate(Sender: TObject;
  var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
{var
  b: Boolean;}
begin
  if Error then
  begin
    PromptMsg('Incorrect data format！',2);
    abort;
  end;
end;

end.