ps_main.pas

DELPHI5加SQL SERVER2000完成的进销存系统,具体哪些内容记不清了,六七年前写的,希望还能有点贡献

unit PS_main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ImgList, Buttons, ToolWin, ComCtrls, StdCtrls,dbtables, ExtCtrls,db;
type
  tablekind=(Rcomdepartment,Rcomperson,Rcomproduct,Rcomwarehouse,Rcomwareamount,
             Rcomcustomer,Rordbillmain,Rordbillsub,Rstkbillmain,Rstkbillsub);
type
  TF_main = class(TForm)
    MainMenu1: TMainMenu;
    M_system1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    M_comcustomer1: TMenuItem;
    N8: TMenuItem;
    M_basicSource: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    M_function: TMenuItem;
    M_MakeAccountWizard: TMenuItem;
    M_warehouseWizard: TMenuItem;
    N16: TMenuItem;
    M_close: TMenuItem;
    M_report1: TMenuItem;
    M_used1: TMenuItem;
    M_edit1: TMenuItem;
    M_database1: TMenuItem;
    M_set1: TMenuItem;
    M_tool1: TMenuItem;
    M_view1: TMenuItem;
    M_about1: TMenuItem;
    M_resource1: TMenuItem;
    ToolBar1: TToolBar;
    ImageList1: TImageList;
    TB_new1: TToolButton;
    TB_modify1: TToolButton;
    TB_blank1: TToolButton;
    TB_delete1: TToolButton;
    TB_save1: TToolButton;
    TB_ignore1: TToolButton;
    TB_first: TToolButton;
    TB_prior: TToolButton;
    TB_next: TToolButton;
    TB_last: TToolButton;
    TB_blank2: TToolButton;
    TB_close: TToolButton;
    TB_choose1: TToolButton;
    TB_dictionary1: TToolButton;
    TB_computer1: TToolButton;
    M_toolbar1: TMenuItem;
    TB_blank3: TToolButton;
    Timer1: TTimer;
    M_comdepartment: TMenuItem;
    M_comperson: TMenuItem;
    M_comproduct: TMenuItem;
    M_comwarehouse: TMenuItem;
    M_comwareamount: TMenuItem;
    M_comcustomer: TMenuItem;
    M_ordbill1: TMenuItem;
    M_ordbill2: TMenuItem;
    M_stkbill1: TMenuItem;
    M_stkbill2: TMenuItem;
    TB_turn: TToolButton;
    N1: TMenuItem;
    N7: TMenuItem;
    M_R_ordbill: TMenuItem;
    M_R_stkbill: TMenuItem;
    M_help: TMenuItem;
    procedure M_toolbar1Click(Sender: TObject);
    procedure M_closeClick(Sender: TObject);
    procedure TB_closeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TB_firstClick(Sender: TObject);
    procedure TB_priorClick(Sender: TObject);
    procedure TB_nextClick(Sender: TObject);
    procedure TB_lastClick(Sender: TObject);
    procedure TB_delete1Click(Sender: TObject);
    procedure TB_new1Click(Sender: TObject);
    procedure M_compersonClick(Sender: TObject);
    procedure M_comdepartmentClick(Sender: TObject);
    procedure M_comproductClick(Sender: TObject);
    procedure M_comwarehouseClick(Sender: TObject);
    procedure M_comwareamountClick(Sender: TObject);
    procedure M_comcustomerClick(Sender: TObject);
    procedure M_ordbill1Click(Sender: TObject);
    procedure M_ordbill2Click(Sender: TObject);
    procedure M_stkbill1Click(Sender: TObject);
    procedure M_stkbill2Click(Sender: TObject);
    procedure TB_save1Click(Sender: TObject);
    procedure TB_ignore1Click(Sender: TObject);
    procedure TB_modify1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TB_choose1Click(Sender: TObject);
    procedure TB_computer1Click(Sender: TObject);
    procedure TB_dictionary1Click(Sender: TObject);
    procedure ShowCurrentForm(form:Tform;table:TTable);
    procedure CloseAllChild;
    procedure buttonstate;
    function savetocache:boolean;
    procedure N1Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure TB_turnClick(Sender: TObject);
    procedure M_R_ordbillClick(Sender: TObject);
    procedure M_R_stkbillClick(Sender: TObject);
    procedure M_helpClick(Sender: TObject);
  private
    { Private declarations }
  public
    flag:integer;
    CurrentTable:ttable;
    TableName:TableKind;
    { Public declarations }
  end;
var
  F_main: TF_main;
  CurrentForm:tform;
implementation

uses
  PS_db, PS_comcustomer, PS_comproduct, PS_comperson,PS_comwareahouse,
  PS_comdepartment, PS_comwareamount, PS_ordbill, PS_stkbill, PS_P_ordbill,
  PS_comprocess;
{$R *.DFM}
//声明
//自定义函数部分
procedure TF_main.CloseAllChild;
var
  i:integer;
begin
  for i:=0 to mdichildcount-1 do begin
    mdichildren[i].close;
    end;
end;

procedure TF_main.buttonstate;
begin
  with currenttable do begin
    tb_first.Enabled:=not bof;
    tb_prior.Enabled:=not bof;
    tb_last.Enabled:=not eof;
    tb_next.Enabled:=not eof;
    end;
  if activemdichild<>nil then
    if not currenttable.isempty then
      case tablename of
        Rcomdepartment:;
        Rcomperson:f_comperson.afterInsert;
        Rcomproduct:f_comproduct.AfterInsert;
        Rcomwarehouse:;
        Rcomwareamount:f_comwareamount.afterinsert;
        Rcomcustomer:f_comcustomer.afterinsert;
        Rordbillmain:f_ordbill.status;
        Rordbillsub:f_ordbill.substatus;
        Rstkbillmain:f_stkbill.Afterinsert;
        Rstkbillsub:f_stkbill.substatus;
        end
    else
      case tablename of
        Rcomdepartment:f_comdepartment.NoRecord;
        Rcomperson:f_comperson.NoRecord;
        Rcomproduct:f_comproduct.NoRecord;
        Rcomwarehouse:f_comwarehouse.NoRecord;
        Rcomwareamount:f_comwareamount.NoRecord;
        Rcomcustomer:f_comcustomer.NoRecord;
        Rordbillmain:f_ordbill.NoRecord;
        Rordbillsub:tf_ordbill(f_main.ActiveMDIChild).DBGrid2.ReadOnly:=true;
        Rstkbillmain:f_stkbill.NoRecord;
        Rstkbillsub:tf_stkbill(f_main.ActiveMDIChild).DBGrid2.ReadOnly:=true;
        end;
end;

function TF_main.savetocache:boolean;
begin
  result:=true;
  with currenttable do
    if (state=dsedit)or(state=dsinsert)then
      try
        post;
        close;
        open;
      except
        if (application.MessageBox('记录输入有误，是否完善？',
        '错误',MB_yesno)=idno)then
          currenttable.cancel
        else
          result:=false;
      end;
end;
//程序正体部分
procedure TF_main.M_toolbar1Click(Sender: TObject);
begin
if M_toolbar1.checked then begin
  M_toolbar1.checked:=false;
  toolbar1.Visible:=false;
  end
else begin
  m_toolbar1.checked:=true;
  toolbar1.visible:=true;
  end;
end;

procedure TF_main.M_closeClick(Sender: TObject);
begin
close;
end;

procedure TF_main.FormCreate(Sender: TObject);
begin
  f_main.WindowState:=wsmaximized;
end;

procedure TF_main.Timer1Timer(Sender: TObject);
begin
  if currenttable=nil then
    toolbar1.enabled:=false
  else
    toolbar1.Enabled:=true;
end;

procedure TF_main.TB_new1Click(Sender: TObject);
begin
  with comdatabase do begin
    if currenttable.IsEmpty then
      case tablename of
        Rcomdepartment:f_comdepartment.HaveRecord;
        Rcomperson:f_comperson.HaveRecord;
        Rcomproduct:f_comproduct.HaveRecord;
        Rcomwarehouse:f_comwarehouse.HaveRecord;
        Rcomwareamount:f_comwareamount.HaveRecord;
        Rcomcustomer:f_comcustomer.HaveRecord;
        Rordbillmain:f_ordbill.HaveRecord;
        Rordbillsub:tf_ordbill(f_main.ActiveMDIChild).DBGrid2.ReadOnly:=false;
        Rstkbillmain:f_stkbill.HaveRecord;
        Rstkbillsub:tf_stkbill(f_main.ActiveMDIChild).DBGrid2.ReadOnly:=false;
        end;
    case tablename of
      Rcomdepartment:f_comdepartment.beforeinsert;
      Rcomperson:f_comperson.beforeinsert;
      Rcomproduct:f_comproduct.BeforeInsert;
      Rcomwarehouse:f_comwarehouse.beforeinsert;
      Rcomwareamount:f_comwareamount.beforeInsert;
      Rcomcustomer:f_comcustomer.BeforeInsert;
      Rordbillmain:;
      Rordbillsub:;
      Rstkbillmain:f_stkbill.Beforeinsert;
      Rstkbillsub:;
      end;
    case tablename of
      Rcomcustomer:f_comcustomer.insert;
      Rordbillmain:f_ordbill.mainappend;
      Rordbillsub:f_ordbill.subAppend;
      Rstkbillmain:f_stkbill.mainappend;
      Rstkbillsub:f_stkbill.subAppend;
      else if savetocache then currenttable.append;
      end;
    end;
end;

procedure TF_main.TB_modify1Click(Sender: TObject);
begin
  case tablename of
    Rcomdepartment:f_comdepartment.beforeinsert;
    Rcomperson:f_comperson.beforeinsert;
    Rcomproduct:f_comproduct.BeforeInsert;
    Rcomwarehouse:f_comwarehouse.beforeinsert;
    Rcomwareamount:f_comwareamount.beforeInsert;
    Rcomcustomer:f_comcustomer.modify;
    Rordbillmain:;
    Rordbillsub:;
    Rstkbillmain:f_stkbill.Beforeinsert;
    Rstkbillsub:;
    end;
    currenttable.edit;
end;

procedure TF_main.TB_delete1Click(Sender: TObject);
begin
  if comprocess.isdelete then
  try
    case tablename of
      Rordbillmain:f_ordbill.MainDelete;
      Rordbillsub:f_ordbill.SubDelete;
      Rstkbillmain:f_stkbill.MainDelete;
      Rstkbillsub:f_stkbill.SubDelete;
      else currenttable.delete;
      end;
    buttonstate;
  except
    on edatabaseerror do application.MessageBox('原因如下:'+#13+#13+'1.记录被参考'+#13+'2.数据库已无记录','错误',MB_ok);
    end;
end;

procedure TF_main.TB_save1Click(Sender: TObject);
begin
  case tablename of
    Rcomperson:f_comperson.post;
    Rordbillmain,Rordbillsub:f_ordbill.send;
    Rstkbillmain,Rstkbillsub:f_stkbill.send;
    else savetocache;
    end;
    buttonstate;
end;

procedure TF_main.TB_ignore1Click(Sender: TObject);
begin
  case tablename of
    Rordbillmain,Rordbillsub:f_ordbill.cancel;
    Rstkbillmain,Rstkbillsub:f_stkbill.cancel;
    else currenttable.cancel;
    end;
  buttonstate;
//  currenttable.CancelUpdates;
end;

procedure TF_main.TB_firstClick(Sender: TObject);
begin
  if savetocache then begin
    currenttable.First;
    buttonstate;
    end;
end;

procedure TF_main.TB_priorClick(Sender: TObject);
begin
  if savetocache then begin
    currenttable.Prior;
    buttonstate;
    end;
end;

procedure TF_main.TB_nextClick(Sender: TObject);
begin
  if savetocache then begin
    currenttable.Next;
    buttonstate;
    end;
end;

procedure TF_main.TB_lastClick(Sender: TObject);
begin
  if savetocache then begin
    currenttable.Last;
    buttonstate;
    end;
end;

procedure TF_main.TB_closeClick(Sender: TObject);
begin
close;
end;

procedure TF_main.TB_choose1Click(Sender: TObject);
begin
//
end;

procedure TF_main.TB_computer1Click(Sender: TObject);
begin
//
end;

procedure TF_main.TB_dictionary1Click(Sender: TObject);
begin
//
end;

procedure TF_main.ShowCurrentForm(form: Tform; table: TTable);//善未投入使用
var
  currentform:tform;
begin
//  currenttable:=table;
//  closeallchild;
  currentform:=form.Create(self);
//  form.show;
  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_comdepartmentClick(Sender: TObject);
begin
//  showcurrentform(f_comdepartment,comdatabase.comdepartment);
  currentform:=tf_comdepartment.create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_compersonClick(Sender: TObject);
begin
  currentform:=tf_comperson.Create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_comproductClick(Sender: TObject);
begin
   currentform:=tf_comproduct.Create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_comwarehouseClick(Sender: TObject);
begin
  currentform:=tf_comwarehouse.Create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_comwareamountClick(Sender: TObject);
begin
  currentform:=tf_comwareamount.Create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_comcustomerClick(Sender: TObject);
begin
  currentform:=tf_comcustomer.Create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_ordbill1Click(Sender: TObject);
begin
  flag:=1;
  currentform:=tf_ordbill.Create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_ordbill2Click(Sender: TObject);
begin
  flag:=2;
  currentform:=tf_ordbill.Create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_stkbill1Click(Sender: TObject);
begin
  flag:=1;
  currentform:=tf_stkbill.create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.M_stkbill2Click(Sender: TObject);
begin
  flag:=2;
  currentform:=tf_stkbill.Create(application);
//  currenttable.CachedUpdates:=true;
  currentform.show;
end;

procedure TF_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  action:=cafree;
end;

procedure TF_main.N1Click(Sender: TObject);
var
  i:integer;
begin
  for i:=mdichildcount-1 downto 0 do
    mdichildren[i].WindowState:=wsMinimized;
end;

procedure TF_main.N7Click(Sender: TObject);
var
  i:integer;
begin
  for i:=mdichildcount-1 downto 0 do
    mdichildren[i].close;
end;

procedure TF_main.TB_turnClick(Sender: TObject);
begin
  f_ordbill.Turn;
end;

procedure TF_main.M_R_ordbillClick(Sender: TObject);
begin
  if (tablename=Rordbillmain)or
     (tablename=Rordbillsub)and
     (not comdatabase.ordbillsub.IsEmpty)
  then
    currentform:=tf_r_ordbill.create(application);
  currentform.free;
end;

procedure TF_main.M_R_stkbillClick(Sender: TObject);
begin
//
end;

procedure TF_main.M_helpClick(Sender: TObject);
begin
  application.HelpCommand(help_finder,0);
end;

end.