base_t.pas

用delphi编写的数据库管理软件

unit Base_T;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MDIBase, MSNPopUp, FR_DSet, FR_DBSet, FR_Class, Menus, ActnList,
  DB, DBClient, Grids, DBGridEh, StdCtrls, ExtCtrls, dxExEdtr, dxTL,
  dxDBCtrl, dxCntner, dxDBTL, Mask, wwdbedit;

type
  TfrmMDIBase_T = class(TfrmMDIBase)
    Panel1: TPanel;
    FormTitle: TLabel;
    Panel3: TPanel;
    btnExit: TButton;
    Panel2: TPanel;
    btnedit: TButton;
    btndelete: TButton;
    Panel4: TPanel;
    btnrefresh: TButton;
    btnsearch: TButton;
    btnprint: TButton;
    CDSBaseinfo: TClientDataSet;
    DSbaseinfo: TDataSource;
    ActionList1: TActionList;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    Action5: TAction;
    frBaseinfo: TfrReport;
    frDBDataSet1: TfrDBDataSet;
    ActionList2: TActionList;
    acmodify: TAction;
    acdelete: TAction;
    acrefresh: TAction;
    acsearch: TAction;
    acexit: TAction;
    MSNSaveinfo: TMSNPopUp;
    Panel5: TPanel;
    dxDBTreeList1: TdxDBTreeList;
    dxDBTreeList1Column1: TdxDBTreeListColumn;
    dxDBTreeList1Column2: TdxDBTreeListColumn;
    PlEdit: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    addBaseclass: TAction;
    addsameclass: TAction;
    addchildclass: TAction;
    Label1: TLabel;
    DBedit1: TwwDBEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    wwDBEdit1: TwwDBEdit;
    wwDBEdit2: TwwDBEdit;
    wwDBEdit3: TwwDBEdit;
    Button4: TButton;
    Button5: TButton;
    acSave: TAction;
    acCancel: TAction;
    ppmreport: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnprintClick(Sender: TObject);
    procedure acexitExecute(Sender: TObject);
    procedure DSbaseinfoStateChange(Sender: TObject);
    procedure DSbaseinfoDataChange(Sender: TObject; Field: TField);
    procedure acrefreshExecute(Sender: TObject);
    procedure acsearchExecute(Sender: TObject);
    procedure acdeleteExecute(Sender: TObject);
    procedure acmodifyExecute(Sender: TObject);
    procedure acCancelExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure addBaseclassExecute(Sender: TObject);
    procedure addsameclassExecute(Sender: TObject);
    procedure addchildclassExecute(Sender: TObject);
    procedure dxDBTreeList1ChangeNode(Sender: TObject; OldNode,
      Node: TdxTreeListNode);
    procedure CDSBaseinfofCodeValidate(Sender: TField);
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure frBaseinfoGetValue(const ParName: String;
      var ParValue: Variant);
  private
    iParentID,iSelfID:Integer;
    sParentCode,sSelfCode:String;
    function CheckSave :Boolean;    
    { Private declarations }
  protected
    MainTable:string;
    KeyField:String;
    ReportName:string;
  public
    { Public declarations }
  end;

var
  frmMDIBase_T: TfrmMDIBase_T;

implementation

uses Global, DataProcess, Bsearch;

{$R *.dfm}

procedure TfrmMDIBase_T.FormDestroy(Sender: TObject);
begin
  inherited;
  frmMDIBase_T:=nil;
end;

procedure TfrmMDIBase_T.FormShow(Sender: TObject);
begin
  inherited;
  FormTitle.Caption:=Caption;
  GetSqlData(CDSBaseinfo,MainTable,KeyField,'Fid>0',20);
end;

procedure TfrmMDIBase_T.btnprintClick(Sender: TObject);
var
  Point:Tpoint;
begin
  inherited;
  Point:=GetScreenPoint(btnprint);
  ppmreport.Popup(point.X,point.Y);
end;


procedure TfrmMDIBase_T.acexitExecute(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TfrmMDIBase_T.DSbaseinfoStateChange(Sender: TObject);
var
  i:integer;
begin
  inherited;
  acSave.Enabled:=CDSBaseinfo.State in [dsInsert,dsEdit];
  addBaseClass.Enabled:=not acSave.Enabled;
  addSameClass.Enabled:=not acSave.Enabled;
  addChildClass.Enabled:=not acSave.Enabled;
  acCancel.Enabled:=acSave.Enabled;
  acmodify.Enabled:=not acsave.Enabled;
  acsearch.Enabled:=not acsave.Enabled;
  acrefresh.Enabled:=not acsave.Enabled;
  acdelete.Enabled:=not acSave.Enabled;
  btnPrint.Enabled:=not acSave.Enabled;


dxdbTreelist1.Enabled := Not acSave.Enabled ;
if acSave.Enabled  then
   dxDBTreelist1.OptionsDB := dxDBTreeList1.OptionsDB - [etoCanNavigation]
   else
   if not (etoCanNavigation in dxDBTreeList1.OptionsDB ) then
      dxDBTreelist1.OptionsDB := dxDBTreeList1.OptionsDB + [etoCanNavigation];

With PlEdit do
   for i:= 0 to ControlCount-1 do
     if Controls[i] is TwwDBEdit then
        (Controls[i] as TwwDBEdit).ReadOnly := Not acSave.Enabled
end;

procedure TfrmMDIBase_T.DSbaseinfoDataChange(Sender: TObject;
  Field: TField);
begin
  inherited;
  DSbaseinfoStateChange(Self);
end;

procedure TfrmMDIBase_T.acrefreshExecute(Sender: TObject);
begin
  inherited;
  GetSqlData(CDSBaseinfo,MainTable,KeyField,'Fid>0',20);
end;

procedure TfrmMDIBase_T.acsearchExecute(Sender: TObject);
begin
  inherited;
  searchtiao:='';
  FromInterface:=Maintable;
  if not assigned(frmSearch) then
    FrmSearch:=TfrmSearch.Create(Application);
    FrmSearch.showModal;
    frmSearch.free;

  if Searchtiao<>'' then
    try
      Getsqldata(CDSBaseinfo,Maintable,Keyfield,Searchtiao,20);
    except
      on E:Exception do
        begin
          messagedlg('条件设置不正确 ! '+#10#13+E.Message,mtError,[mbok],0);
          GetSqlData(CDSBaseinfo,MainTable,KeyField,'Fid>0',20);
          Exit;
        end;
    end;
end;

procedure TfrmMDIBase_T.acdeleteExecute(Sender: TObject);
var
  Cid:integer;
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0  then
    begin
      messagedlg('没有记录，不能删除 ! ',mtError,[mbok],0);
      Exit;
    end;
  if messagedlg('你真的要删除当前记录吗 ? ',mtConfirmation,[mbok,mbcancel],0)=mrok then
    begin
     Cid:=CDSbaseinfo.Fieldbyname(Keyfield).AsInteger;
     CDSbaseinfo.Delete;
     if CDSbaseinfo.ChangeCount > 0 then
      begin
       if baseformapplyupdata(CDSbaseinfo,Maintable,Keyfield) then
         begin
            MSNsaveinfo.Title:='信息提示';
            MSNsaveinfo.Text:='删除记录 id='+inttostr(Cid);
            MSNsaveinfo.ShowPopUp;
          end
          else
          begin
            MSNsaveinfo.Title:='提示信息';
            MSNsaveinfo.Text:='删除失败';
            MSNsaveinfo.ShowPopUp;
          end;
        CDSbaseinfo.MergeChangeLog;
      end;
    end;
end;

procedure TfrmMDIBase_T.acmodifyExecute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount > 0 then
    CDSbaseinfo.Edit;
    wwDBEdit1.SetFocus;
end;

procedure TfrmMDIBase_T.acCancelExecute(Sender: TObject);
begin
  inherited;
  if CDSBaseinfo.State in [dsEdit,dsInsert] then
    CDSbaseinfo.Cancel;
end;

procedure TfrmMDIBase_T.acSaveExecute(Sender: TObject);
begin
  inherited;
  if wwDBedit1.Text='' then
    begin
      messagedlg('代码不能为空 ! ',mtError,[mbok],0);
      Exit;
    end;
  if wwDBedit2.Text='' then
    begin
      messagedlg('名称不能为空  ！ ',mtError,[mbok],0);
      Exit;
    end;

  if CDSbaseinfo.State = dsInsert then
    begin
      CDSBaseinfo.FieldByName('fid').AsInteger:=GetMaxid(Maintable,KeyField)+1;
    end;

  if CDSbaseinfo.State in [dsEdit,dsInsert] then
    CDSbaseinfo.Post;

  if CDSbaseinfo.ChangeCount > 0 then
      begin
       if baseformapplyupdata(CDSbaseinfo,Maintable,Keyfield) then
         begin
            MSNsaveinfo.Title:='信息提示';
            MSNsaveinfo.Text:='保存成功';
            MSNsaveinfo.ShowPopUp;
          end
          else
          begin
            MSNsaveinfo.Title:='信息提示';
            MSNsaveinfo.Text:='保存失败';
            MSNsaveinfo.ShowPopUp;
          end;
        CDSbaseinfo.MergeChangeLog;
      end;
end;

procedure TfrmMDIBase_T.addBaseclassExecute(Sender: TObject);
begin
  inherited;
CDSBaseinfo.Append ;
CDSBaseinfo.FieldByName('fParentID').AsInteger :=0;
CDSBaseinfo.fieldbyname('fParentCode').asString :='';
wwDBedit1.SetFocus;
end;

procedure TfrmMDIBase_T.addsameclassExecute(Sender: TObject);
begin
  inherited;
CDSBaseinfo.Append ;
CDSBaseinfo.FieldByName('fParentID').AsInteger :=iParentID;
CDSBaseinfo.fieldbyname('fParentCode').asString :=sParentCode;
CDSBaseinfo.fieldbyname('fCode').asString :=sParentCode+'-';
DbEdit1.SelStart:=Length(Dbedit1.Text);
wwDBedit1.SetFocus;
end;

procedure TfrmMDIBase_T.addchildclassExecute(Sender: TObject);
begin
  inherited;
CDSBaseinfo.Append ;
CDSBaseinfo.FieldByName('fParentID').AsInteger :=iSelfID;
CDSBaseinfo.fieldbyname('fParentCode').asString :=sSelfCode;
CDSBaseinfo.fieldbyname('fCode').asString :=sSelfCode+'-';
DbEdit1.SelStart:=Length(Dbedit1.Text);
wwDBedit1.SetFocus;
end;

procedure TfrmMDIBase_T.dxDBTreeList1ChangeNode(Sender: TObject; OldNode,
  Node: TdxTreeListNode);
begin
  inherited;
  if Not (CDSBaseInfo.State in [dsInsert,dsEdit]) then
  begin
    iParentId:=CDSBaseInfo.fieldbyname('fParentID').asInteger;
    iSelfID:=CDSBaseInfo.fieldbyname('fID').asInteger;
    sParentCode:= CDSBaseInfo.fieldbyname('fParentCode').asString;
    sSelfCode:= CDSBaseInfo.fieldbyname('fCode').asString;
  end;
end;

procedure TfrmMDIBase_T.CDSBaseinfofCodeValidate(Sender: TField);
var
sParentCode,sCode: String;
begin
  inherited;
sParentCode:=CDSBaseInfo.FieldByName('fParentCode').asstring;
sCode:=CDSBaseInfo.FieldByName('fCode').asstring;
if sParentCode<>Copy(sCode,1,Length(sParentCode)) then
   Raise Exception.Create('不能与父件相同 ');

if CIsUnique(Maintable,'fCode',CDSBaseInfo.FieldByName('fCode').asstring) then
  begin
  messagedlg('已存在同名的产品代码 ! ',mtError,[mbok],0);
  Exit;
  end;
end;
procedure TfrmMDIBase_T.Action1Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.ShowReport;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('打印预览出错 ! '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmMDIBase_T.Action2Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.PrepareReport;
    frbaseinfo.PrintPreparedReport('',1,True,frAll);
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('直接打印出错 ！'+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmMDIBase_T.Action3Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.PrepareReport;
    frbaseinfo.PrintPreparedReportDlg;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('打印设置出错  ! '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmMDIBase_T.Action4Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.DesignReport;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('报表设置出错 ！ '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

function TfrmMDIBase_T.CheckSave: Boolean;
begin
Result:=true;
if CDSbaseinfo.State in [dsEdit,dsInsert] then
   Case Messagedlg('您要保存当前的修改吗 ! ',mtWarning,[mbYes,mbNo,mbCancel],0) of
   mrYes:
     begin
     acSaveExecute(Self);
     Result := CDSBaseInfo.State = dsBrowse;
     end;
   mrNo:
     begin
     CDSbaseinfo.Cancel;
     Result := CDSBaseInfo.State = dsBrowse;
     end;
   mrCancel:
     Result := False ;
   End
end;

procedure TfrmMDIBase_T.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  CanClose:=CheckSave;
end;

procedure TfrmMDIBase_T.frBaseinfoGetValue(const ParName: String;
  var ParValue: Variant);
begin
  inherited;
  if ParName='sNow' then
    ParValue:=srNow;
end;

end.