⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fpbase.pas

📁 财务报表系统,包括系统登陆
💻 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 + -