📄 fpbase.pas
字号:
unit FPBase;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, DBCtrls, Buttons, Common, DB, AppEvnts;
type
TfrmPBase = class(TForm)
bvl1: TBevel;
dbnvgr1: TDBNavigator;
btn1: TSpeedButton;
btn2: TSpeedButton;
btn3: TSpeedButton;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure dbnvgr1BeforeAction(Sender: TObject; Button: TNavigateBtn);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure btn3Click(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
{ Private declarations }
cdsEve: cdsEventsArray;
dce: TDataChangeEvent;
FdataChange: Boolean;
procedure AskForSaveData;
protected
{ Protected decalartions}
dsEdits: TDataSet;
procedure dsBeforePost(DataSet: TDataSet);
procedure dsAfterPost(DataSet: TDataSet);
function ValidateData(DataSet: TDataSet): Boolean;virtual;
procedure dsOnNewRecord(DataSet: TDataSet);virtual;
public
{ Public declarations }
strState: string;
strKeyFields: string;
end;
var
frmPBase: TfrmPBase;
implementation
{$R *.dfm}
procedure TfrmPBase.FormShow(Sender: TObject);
begin
if (dbnvgr1.DataSource <> nil) then begin
if (dbnvgr1.DataSource.DataSet <> nil) then begin
// Database Event
dsEdits := dbnvgr1.DataSource.DataSet;
cdsEve := SaveCDSEvents(dsEdits);
dce := dbnvgr1.DataSource.OnDataChange;
dsEdits.OnNewRecord := dsOnNewRecord;
dsEdits.BeforePost := dsBeforePost;
if (strState = 'N') then
dsEdits.Append;
end;
end;
// Database State
if (strState = 'N') then begin
btn3.Visible := True;
dbnvgr1.Visible := False;
end
else if (strState = 'M') then begin
btn3.Visible := False;
dbnvgr1.Visible := True;
end
else begin
Application.MessageBox('状态错误!', PChar(Application.Title), MB_OK +
MB_ICONSTOP);
Close;
end;
FdataChange := False;
end;
procedure TfrmPBase.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (dbnvgr1.DataSource <> nil) then begin
if (dbnvgr1.DataSource.DataSet <> nil) then begin
dbnvgr1.DataSource.OnDataChange := dce;
RestoreCDSEvents(dsEdits, cdsEve);
end;
end;
if FdataChange then
ModalResult := mrOk
else
ModalResult := mrCancel;
end;
procedure TfrmPBase.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
AskForSaveData;
end;
procedure TfrmPBase.AskForSaveData;
begin
if (dbnvgr1.DataSource <> nil) then begin
if (dbnvgr1.DataSource.DataSet <> nil) then begin
if dsEdits.State in [dsInsert,dsEdit] then
begin
case MessageBox(Self.Handle, '是否保存对当前资料的修改?', '提示', MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1 ) of
IDYES:
begin
dsEdits.Post;
end;
IDNO:
dsEdits.Cancel;
else
Abort;
end;
end;
end;
end;
end;
procedure TfrmPBase.dbnvgr1BeforeAction(Sender: TObject;
Button: TNavigateBtn);
begin
AskForSaveData;
end;
procedure TfrmPBase.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_RETURN:
begin
if (Self.ActiveControl is TDBMemo) then
begin
if Shift = [ssCtrl] then
Perform(WM_NEXTDLGCTL, 0, 0)
end
else if Shift = [ssShift] then
Perform(WM_NEXTDLGCTL, 1, 0)
else
Perform(WM_NEXTDLGCTL, 0, 0);
end;
end;
end;
// 继续添加
procedure TfrmPBase.btn3Click(Sender: TObject);
begin
if (dbnvgr1.DataSource <> nil) then begin
if (dbnvgr1.DataSource.DataSet <> nil) then begin
if dsEdits.State in [dsInsert, dsEdit] then
dsEdits.Post;
dsEdits.Append;
end;
end;
end;
// 确定
procedure TfrmPBase.btn1Click(Sender: TObject);
begin
if (dbnvgr1.DataSource <> nil) then begin
if (dbnvgr1.DataSource.DataSet <> nil) then begin
if dsEdits.State in [dsInsert,dsEdit] then
dsEdits.Post;
end;
end;
Close;
end;
// 取消
procedure TfrmPBase.btn2Click(Sender: TObject);
begin
if (dbnvgr1.DataSource <> nil) then begin
if (dbnvgr1.DataSource.DataSet <> nil) then begin
dsEdits.Cancel;
end;
end;
Close;
end;
// 验证字段内容
procedure TfrmPBase.dsBeforePost(DataSet: TDataSet);
var
i : integer;
dsField: TField;
begin
// 处理必填字段
for i:=0 to DataSet.FieldCount-1 do
begin
dsField := DataSet.Fields[i];
if (Pos(';'+UpperCase(dsField.FieldName) + ';', ';'+UpperCase(strKeyFields)+';') <> 0) then
begin
if (dsField is TStringField) and (dsField.AsString = '')
or (dsField is TNumericField) and (dsField.AsFloat = 0)
or (dsField is TDateTimeField) and (dsField.value = null) then
begin
Application.MessageBox(Pchar('''' + dsField.DisplayLabel + '''未录入, 请继续录入!'), PChar(Application.Title), MB_OK +
MB_ICONWARNING);
Abort;
end;
end;
end;
if not ValidateData(DataSet) then
Abort;
end;
procedure TfrmPBase.dsAfterPost(DataSet: TDataSet);
begin
FdataChange := True;
end;
// 子类重载,用来验证其他数据
// 返回 True 验证成功,否则失败
function TfrmPBase.ValidateData(DataSet: TDataSet): Boolean;
begin
Result := True;
end;
// 默认数据
procedure TfrmPBase.dsOnNewRecord(DataSet: TDataSet);
var
i: Integer;
begin
for i:=0 to DataSet.FieldCount-1 do
begin
if (DataSet.Fields[i] is TBooleanField) then
DataSet.Fields[i].AsBoolean := True;
if (DataSet.Fields[i] is TDateTimeField) then
DataSet.Fields[i].AsDateTime := Date;
if (DataSet.Fields[i] is TNumericField) and not (DataSet.Fields[i] is TAutoIncField) then
DataSet.Fields[i].AsInteger := 0;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -