untbasesingle.pas

来自「简要说明:对医院幼儿心理情况做的一个调查,统计系统.」· PAS 代码 · 共 331 行

unit untBaseSingle;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBase, DB, ADODB, Grids, DBGrids, ImgList, ComCtrls,
  untGlobalVar, StdCtrls, ExtCtrls, ActnList, DBCtrls, untDM, 
  untGlobalFun, Menus,jpeg, Buttons,
  ToolWin;

type
  TfrmBaseSingle = class(TfrmBase)
    dsSingle: TDataSource;
    adsSingle: TADODataSet;
    il4: TImageList;
    pmSingle: TPopupMenu;
    N1: TMenuItem;
    E1: TMenuItem;
    D1: TMenuItem;
    N2: TMenuItem;
    mniExport: TMenuItem;
    N3: TMenuItem;
    mniFilter: TMenuItem;
    mniFilterCur: TMenuItem;
    mniCancelFilter: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    pnlBack: TPanel;
    grdSingle: TDBGrid;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    btnNew: TToolButton;
    btnEdit: TToolButton;
    btnDel: TToolButton;
    ToolButton1: TToolButton;
    btnLocate: TToolButton;
    btnFilter: TToolButton;
    ToolButton2: TToolButton;
    btnClose: TToolButton;
    btnShowDetail: TToolButton;
    ToolButton3: TToolButton;
    btnView: TToolButton;
    pnlPalBottom: TPanel;
    imgImgBL: TImage;
    imgImgBR: TImage;
    imgImgBC: TImage;
    imgImgLeft: TImage;
    imgImgRight: TImage;
    pnlPalTop: TPanel;
    imgImgTL: TImage;
    imgImgTC: TImage;
    imgImgTR: TImage;
    btntest: TToolButton;
    procedure btnNewClick(Sender: TObject);
    procedure btnEditClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnLocateClick(Sender: TObject);
    procedure mniExportClick(Sender: TObject);
    procedure btnFilterClick(Sender: TObject);
    procedure mniFilterCurClick(Sender: TObject);
    procedure mniCancelFilterClick(Sender: TObject);
    procedure grdSingleDblClick(Sender: TObject);
  private
    FConn: TADOConnection;
    FLoginInfo: TUserRec;
    FLocateSet: TLocateSet;
    FFilterStr: string;
    procedure SetConn(const Value: TADOConnection);
    procedure SetTitle(const Value: string);
    procedure DelRecord;
    procedure SetLoginInfo(const Value: TUserRec);
    procedure ForbidenOperate(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
    LogicDel: Boolean;
    property Title: string write SetTitle;
    property Conn: TADOConnection read FConn write SetConn;
    property LoginInfo: TUserRec read FLoginInfo write SetLoginInfo;
    procedure LoadData; virtual;
  protected
    procedure SetControlStatus; virtual;
    procedure InsRecord; virtual;
    procedure EditRecord; virtual;
    procedure DeleteRecord; virtual;
    procedure LocateRecord; virtual;
    procedure FilterRecord; virtual;
    procedure BeforeDelete(var AllowDel: Boolean); virtual;
    procedure AfterDelete; virtual; 
  end;

var
  frmBaseSingle: TfrmBaseSingle;

implementation

uses untLocateOption;

{$R *.dfm}

{ TfrmBaseSingle }

procedure TfrmBaseSingle.LoadData;
begin
  if not Assigned(FConn) then Exit;
  if not FConn.Connected then FConn.Connected := true;
  if adsSingle.Active then adsSingle.Active := false;
  adsSingle.Active := true;
end;

procedure TfrmBaseSingle.SetConn(const Value: TADOConnection);
var
  i: Integer;
begin
  FConn := Value;
  for i := 0 to ComponentCount - 1 do
  begin
    if Components[i] is TCustomADODataSet then
      TCustomADODataSet(Components[i]).Connection := Value;
    if Components[i] is TADOCommand then
      TADOCommand(Components[i]).Connection := Value;
  end;
end;

procedure TfrmBaseSingle.SetControlStatus;
begin
  mniFilter.Visible := false;
  mniFilterCur.Visible := false;
  mniCancelFilter.Visible := false;
  mniExport.Visible := False;

  mniCancelFilter.Visible := (adsSingle.Active and adsSingle.Filtered);
  if adsSingle.Active and (adsSingle.RecordCount > 0) then
  begin
    btnEdit.OnClick := btnEditClick;
    btnDel.OnClick := btnDelClick;
    btnLocate.OnClick := btnLocateClick;
    btnFilter.OnClick := btnFilterClick;
    mniFilter.Visible := not adsSingle.Filtered;
    mniFilterCur.Visible := not adsSingle.Filtered;
    mniExport.Visible := true;
  end else
  begin
    btnEdit.OnClick := ForbidenOperate;
    btnDel.OnClick := ForbidenOperate;
    btnLocate.OnClick := ForbidenOperate;
    btnFilter.OnClick := ForbidenOperate;
  end;
end;

procedure TfrmBaseSingle.btnNewClick(Sender: TObject);
begin
  inherited;
  try
  InsRecord;
  SetControlStatus;
  except
  end;
end;

procedure TfrmBaseSingle.btnEditClick(Sender: TObject);
begin
  EditRecord;
end;

procedure TfrmBaseSingle.btnDelClick(Sender: TObject);
begin
  inherited;
  DelRecord;
  adsSingle.Requery;
  SetControlStatus;
end;

procedure TfrmBaseSingle.btnCloseClick(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TfrmBaseSingle.SetTitle(const Value: string);
begin
  Caption := Value;
end;

procedure TfrmBaseSingle.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  case Key of
    VK_INSERT:
    begin
      InsRecord;
    end;
    VK_DELETE:
    begin
      DelRecord;
    end;
  end;
end;

procedure TfrmBaseSingle.InsRecord;
begin
  if adsSingle.Active then
     adsSingle.Append;
end;

procedure TfrmBaseSingle.DelRecord;
var
  bAllow: Boolean;
begin
  if MessageBox(Application.Handle,'确实要删除该记录吗？','请问',MB_YESNO+MB_ICONQUESTION) = IDYES then begin
    try
      Conn.BeginTrans;
      BeforeDelete(bAllow);
      if not bAllow then Exit;
      if LogicDel then
        DeleteRecord
      else
        adsSingle.Delete;
      AfterDelete;
      Conn.CommitTrans;
      MsgOK('记录成功删除！');
    except
      Conn.RollbackTrans;
      MsgOK('删除记录失败!');
    end;
  end;
end;

procedure TfrmBaseSingle.SetLoginInfo(const Value: TUserRec);
begin
  FLoginInfo := Value;
end;

procedure TfrmBaseSingle.EditRecord;
begin
  inherited;
  if adsSingle.State in [dsInsert, dsEdit] then adsSingle.Post;
  adsSingle.Edit;
end;

procedure TfrmBaseSingle.ForbidenOperate(Sender: TObject);
begin
  if (not adsSingle.Active) or (adsSingle.RecordCount = 0) then begin
    MsgOK('数据集未打开，或尚无任何记录，无法进行' + TBitBtn(Sender).Caption + '！');
    Exit;
  end;
end;

procedure TfrmBaseSingle.btnLocateClick(Sender: TObject);
begin
  inherited;
  LocateRecord;
end;

procedure TfrmBaseSingle.LocateRecord;
begin
  FLocateSet.FirstLocate := true;
  if SetLocateData(grdSingle, FLocateSet) then
    LocateData(adsSingle, FLocateSet);
end;

procedure TfrmBaseSingle.mniExportClick(Sender: TObject);
begin
  inherited;
  TranDBGridToExcel(grdSingle);
end;

procedure TfrmBaseSingle.btnFilterClick(Sender: TObject);
begin
  inherited;
  FilterRecord;
  SetControlStatus;
end;

procedure TfrmBaseSingle.FilterRecord;
begin
  if adsSingle.Active then
 //   FFilterStr := grdSingle.SelectedField.Value;
//  if FilterDataSet(grdSingle, FFilterStr) then begin
//    if adsSingle.Filtered then adsSingle.Filtered := False;
//    adsSingle.Filter := FFilterStr;
//    adsSingle.Filtered := True;
//  end;
end;

procedure TfrmBaseSingle.mniFilterCurClick(Sender: TObject);
begin
  inherited;
  if not adsSingle.Active then Exit;
  if GetDataType(grdSingle.SelectedField.DataType) in [dtUnknow, dtBlob] then Exit;
  if adsSingle.Filtered then adsSingle.Filtered := False;
//  adsSingle.Filter := FilterCurValue(grdSingle);
  adsSingle.Filtered := True;
  SetControlStatus;
end;

procedure TfrmBaseSingle.mniCancelFilterClick(Sender: TObject);
begin
  inherited;
  if adsSingle.Filtered then adsSingle.Filtered := false;
  SetControlStatus;
end;

procedure TfrmBaseSingle.BeforeDelete(var AllowDel: Boolean);
begin
  AllowDel := true;
end;

procedure TfrmBaseSingle.DeleteRecord;
begin

end;

procedure TfrmBaseSingle.AfterDelete;
begin

end;

procedure TfrmBaseSingle.grdSingleDblClick(Sender: TObject);
begin
  inherited;
  btnEditClick(btnEdit);
end;

end.