a2.pas

一个delphi开发的库存管理系统源代码

unit a2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Grids, DBGridEh, ComCtrls, StdCtrls, Menus, ImgList;

type
  Tfa2 = class(TForm)
    Panel1: TPanel;
    tv: TTreeView;
    Splitter1: TSplitter;
    dg_view: TDBGridEh;
    Label11: TLabel;
    PopupMenu1: TPopupMenu;
    A1: TMenuItem;
    D1: TMenuItem;
    R1: TMenuItem;
    N1: TMenuItem;
    L1: TMenuItem;
    PopupMenu2: TPopupMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    ImageList1: TImageList;
    pl_info: TPanel;
    Panel3: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    tb_sname: TEdit;
    Label3: TLabel;
    tb_name: TEdit;
    Label4: TLabel;
    tb_num: TEdit;
    Label5: TLabel;
    tb_inprc: TEdit;
    Label6: TLabel;
    tb_je: TEdit;
    Label7: TLabel;
    tb_memo: TEdit;
    Label8: TLabel;
    tb_memo2: TEdit;
    Button1: TButton;
    Button2: TButton;
    sg: TStringGrid;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tvChange(Sender: TObject; Node: TTreeNode);
    procedure R1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure D1Click(Sender: TObject);
    procedure L1Click(Sender: TObject);
    procedure tvKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure dg_viewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure MenuItem1Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure MenuItem3Click(Sender: TObject);
    procedure MenuItem4Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure tb_snameKeyPress(Sender: TObject; var Key: Char);
    procedure tb_numKeyPress(Sender: TObject; var Key: Char);
    procedure tb_inprcKeyPress(Sender: TObject; var Key: Char);
    procedure tb_jeKeyPress(Sender: TObject; var Key: Char);
    procedure tb_memoKeyPress(Sender: TObject; var Key: Char);
    procedure tb_memo2KeyPress(Sender: TObject; var Key: Char);
    procedure sgKeyPress(Sender: TObject; var Key: Char);
    procedure sgDblClick(Sender: TObject);
  private
    { Private declarations }
  public
    flag : char;
    xflag: char;
    no,id : string;
    procedure ini(sflag :char);
    { Public declarations }
  end;

var
  fa2: Tfa2;

implementation

uses dm,main,vks;

{$R *.dfm}

procedure tfa2.ini(sflag :char);
var
  node1 : TTreeNode;
begin
  tv.Items.Clear;
  with fdm.q do
  begin
    Close;
    SQL.Text := 'select [no] as name from [dan] where flag=0 and type='''+sflag+''' order by [no] desc';
    try
      Open;
      while not eof do
      begin
        node1 := tv.Items.Add(nil,FieldValues['name']);
        node1.ImageIndex := 0;
        node1.SelectedIndex := 1;
        next;
      end;
    except
    end;
    Close;
  end;
end;

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

procedure Tfa2.tvChange(Sender: TObject; Node: TTreeNode);
begin
  fdm.qdan.Filter := '[no]='''+Node.Text+'''';
  fdm.qdan.Filtered := true;
  if fdm.qdan.Active then fdm.qdan.Close;
  fdm.qdan.Active := true;
end;

procedure Tfa2.R1Click(Sender: TObject);
begin
  ini(flag);
  tv.SetFocus;
  if tv.Items.Count>0 then tv.Items.Item[0].Selected := true else self.Close;
end;

procedure Tfa2.A1Click(Sender: TObject);
begin
  if flag='A' then fmain.A1Click(fmain.A1) else fmain.A1Click(fmain.A2);
end;

procedure Tfa2.FormShow(Sender: TObject);
begin
  tv.SetFocus;
  sg.Cells[0,0]:='NO';
  sg.ColWidths[0]:=20;
  sg.Cells[1,0]:='编号';
  sg.ColWidths[1]:=50;
  sg.Cells[2,0]:='商品简称';
  sg.ColWidths[2]:=80;
  sg.Cells[3,0]:='商品简称';
  sg.ColWidths[3]:=180;
end;

procedure Tfa2.D1Click(Sender: TObject);
begin
if (tv.Selected.Text<>'') and (vks.box('确定要删除本数据吗?'#13#10'如果没有关联数据,将能被删除.','供应商数据删除窗口')) then
begin
  with fdm.q do
  begin
    //删除明细
    close;
    sql.Text := 'delete from [dandetail] where [no]='''+tv.Selected.Text+'''';
    try
      execsql;
    except
      close;
      vks.info(1008);
      exit;
    end;
    //删除明细
    close;
    sql.Text := 'delete from [dan] where [no]='''+tv.Selected.Text+'''';
    try
      execsql;
      R1Click(Sender);
      close;
    except
      close;
      vks.info(1008);
    end;
  end;
end;
end;

procedure Tfa2.L1Click(Sender: TObject);
var
  icnt:integer;
begin
  if (tv.Selected.Text<>'') and (fdm.qdan.RecordCount>0) and (vks.box('确定要审核本数据吗?'#13#10'审核后的数据将不能被操作.','入库单审核窗口')) then
    with fdm do
    begin
      q2.Close;
      q2.SQL.Text := 'select gid,num,je from danlist where [no]='''+tv.Selected.Text+'''';
      try
        q2.Open;
        while not q2.eof do
        begin
          //查看物品在库存中是否存在
          q.Close;
          q.SQL.Text := 'select count(1) as cnt from [kc] where gid='+q2.FieldByName('gid').AsString;
          try
            q.open;
            icnt := q.FieldByName('cnt').AsInteger;
            q.close;
          except
            q.close;
            exit;
          end;
          //新添加物品
          if icnt=0 then
          begin
            q.Close;
            q.SQL.Text := 'insert into [kc](gid) values('+q2.FieldByName('gid').AsString+')';
            try
              q.ExecSQL;
              q.close;
            except
              q.Close;
              vks.info(1008);
              exit;
            end;
          end;
          //影响物品库存
          q.Close;
          if flag='A' then
            q.SQL.Text := 'update [kc] set num=num+'+q2.FieldByName('num').AsString+',je=je+'+q2.FieldByName('je').AsString+' where gid='+q2.FieldByName('gid').AsString
          else
            q.SQL.Text := 'update [kc] set num=num-'+q2.FieldByName('num').AsString+',je=je-'+q2.FieldByName('je').AsString+' where gid='+q2.FieldByName('gid').AsString;
          try
            q.execsql;
            q.close;
          except
            q.close;
            exit;
          end;
          q2.next;
        end;
        q2.close;
        q2.SQL.Text := 'update [dan] set flag=1 where [no]='''+tv.Selected.Text+'''';
        try
          q2.execsql;
          q2.Close;
          vks.info(1103);
          R1Click(Sender);
        except
          q2.Close;
        end;
      except
        close;
        vks.info(1008);
      end;
    end;
end;

procedure Tfa2.tvKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=vk_f3 then A1Click(Sender);
  if key=vk_f5 then R1Click(Sender);
  if key=vk_delete then D1Click(Sender);
  if key=vk_f6 then L1Click(Sender);
end;

procedure Tfa2.dg_viewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=vk_f3 then MenuItem1Click(Sender);
  if key=vk_f4 then MenuItem2Click(Sender);
  if key=vk_f5 then MenuItem4Click(Sender);
  if key=vk_delete then MenuItem3Click(Sender);
end;

procedure Tfa2.MenuItem1Click(Sender: TObject);
begin
  if (tv.Selected.Index>=0) then
  begin
    pl_info.Visible := true;
    xflag := 'A';
    no := tv.Selected.Text;
    tv.Enabled := false;
    dg_view.Enabled := false;
    tb_sname.Enabled := true;
    tb_name.Enabled := false;
    tb_num.Enabled := false;
    tb_inprc.Enabled := false;
    tb_je.Enabled := false;
    tb_memo.Enabled := false;
    tb_memo2.Enabled := false;
    tb_sname.SetFocus;
  end;
end;

procedure Tfa2.MenuItem2Click(Sender: TObject);
begin
  if (tv.Selected.Index>=0) and (fdm.qdan.RecordCount>0) then
  begin
    pl_info.Visible := true;
    xflag := 'M';
    tv.Enabled := false;
    dg_view.Enabled := false;
    sg.Visible := false;
    id := dg_view.Fields[0].AsString;
    tb_sname.Text := dg_view.Fields[1].AsString;
    no := tb_name.Text;
    tb_name.Text := dg_view.Fields[2].AsString;
    tb_sname.Enabled := false;
    tb_num.Text := dg_view.Fields[3].AsString;
    tb_inprc.Text := dg_view.Fields[4].AsString;
    tb_je.Text := dg_view.Fields[5].AsString;
    tb_memo.Text := dg_view.Fields[9].AsString;
    tb_memo2.Text := dg_view.Fields[10].AsString;
    tb_num.SetFocus;
  end;
end;

procedure Tfa2.MenuItem3Click(Sender: TObject);
var
  idx : integer;
begin
  if (tv.Items.Count>0) and (fdm.qdan.RecordCount>0) and (dg_view.Fields[2].asstring<>'') and (vks.box('确定要删除本条数据吗?'#13#10'如果删除,将不能恢复,请不要删除本窗口数据.','库存数据删除窗口')) then
  begin
    fdm.qdan.Filter := '[no]='''+tv.Selected.Text+'''';
    fdm.qdan.Filtered := true;
    if fdm.qdan.Active then fdm.qdan.Close;
    fdm.qdan.Active := true;
  end;
end;

procedure Tfa2.MenuItem4Click(Sender: TObject);
begin
  if tv.Items.Count>0 then
  begin
    fdm.qdan.Filter := '[no]='''+tv.Selected.Text+'''';
    fdm.qdan.Filtered := true;
    if fdm.qdan.Active then fdm.qdan.Close;
    fdm.qdan.Active := true;
  end;
end;

procedure Tfa2.FormResize(Sender: TObject);
begin
  pl_info.Left := (width - pl_info.Width) div 2;
  pl_info.Top := (Height - pl_info.Height) div 2;
end;

procedure Tfa2.Button2Click(Sender: TObject);
begin
  pl_info.Visible := false;
  tv.Enabled := true;
  dg_view.Enabled := true;
  tb_sname.Text := '';
  tb_name.Text := '';
  tb_sname.Enabled := true;
  tb_num.Text := '';
  tb_inprc.Text := '';
  tb_je.Text := '';
  tb_memo.Text := '';
  tb_memo2.Text := '';
  tb_num.Enabled := true;
  tb_inprc.Enabled := true;
  tb_je.Enabled := true;
  tb_memo.Enabled := true;
  tb_memo2.Enabled := true;
  sg.Visible := false;
end;

procedure Tfa2.Button1Click(Sender: TObject);
begin
  if (tb_name.text='') or (tb_num.Text='') or (tb_inprc.Text='') or(tb_je.Text='') then exit;
  with fdm.q do
  begin
    close;
    if xflag='A' then
    begin
      sql.Text := 'insert into [dandetail](gid,[no],num,inprc,je,[memo],memo2) values('+id+','''+no+''',';
      sql.Text := sql.Text+tb_num.Text+','+tb_inprc.Text+','+tb_je.Text+','''+tb_memo.Text+''',''';
      sql.Text := sql.Text+tb_memo2.Text+''')';
    end else
    begin
      sql.Text := 'update [dandetail] set num='+tb_num.Text+',inprc='+tb_inprc.Text+',je='+tb_je.Text;
      sql.Text := sql.Text+',[memo]='''+tb_memo.Text+''',memo2='''+tb_memo2.Text+''' where id='+id;
    end;
    try
      execsql;
      close;
      Button2Click(Sender);
      MenuItem4Click(Sender);
    except
      close;
      vks.info(1008);
    end;
  end;
end;

procedure Tfa2.tb_snameKeyPress(Sender: TObject; var Key: Char);
var
  y : integer;
begin
  if (key=#13) and (tb_sname.Text<>'') then
  begin
    with fdm.q do
    begin
      close;
      sql.Text:='select id,sname,name from goods where flag=0';
      if tb_sname.Text<>'*' then sql.Text :=sql.text+' and sname like ''%'+tb_sname.Text+'%''';
      try
        open;
        sg.RowCount := RecordCount+1;
        for y:=1 to sg.RowCount-1 do
        begin
          sg.Cells[0,y]:=inttostr(y);
          sg.RowHeights[y]:=20;
        end;
        y:=1;
        while not eof do
        begin
          sg.Cells[1,y]:=FieldByName('id').AsString;
          sg.Cells[2,y]:=FieldByName('sname').AsString;
          sg.Cells[3,y]:=FieldByName('name').AsString;
          y:=y+1;
          next;
        end;
        sg.Visible := true;
        sg.SetFocus;
        Button1.Enabled := false;
      except
        close;
        sg.Visible := false;
      end;
    end;
  end else if key=#27 then
  begin
    sg.Visible := false;
    Button1.Enabled := true;
  end;
end;

procedure Tfa2.tb_numKeyPress(Sender: TObject; var Key: Char);
begin
  if (key=#13) and (tb_num.Text<>'') then tb_inprc.SetFocus
  else if not (key in ['0'..'9','.',#8]) then key:=#0;
end;

procedure Tfa2.tb_inprcKeyPress(Sender: TObject; var Key: Char);
begin
  if (key=#13) and (tb_inprc.Text<>'') then
  begin
    tb_je.Text := floattostr(strtofloat(tb_num.Text)*strtofloat(tb_inprc.Text));
    tb_je.SetFocus;
  end else if not (key in ['0'..'9','.',#8]) then key:=#0;
end;

procedure Tfa2.tb_jeKeyPress(Sender: TObject; var Key: Char);
begin
  if (key=#13) and (tb_je.Text<>'') then tb_memo.SetFocus
  else if not (key in ['0'..'9','.',#8]) then key:=#0;
end;

procedure Tfa2.tb_memoKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then tb_memo2.SetFocus;
end;

procedure Tfa2.tb_memo2KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then Button1Click(Sender);
end;

procedure Tfa2.sgKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then
  begin
    sg.Visible := false;
    Button1.Enabled := true;
  end;
  if key=#13 then sgDblClick(Sender);
end;

procedure Tfa2.sgDblClick(Sender: TObject);
var
  y:integer;
begin
  with fdm.q do
  begin
    close;
    y:=sg.Row;
    id := sg.Cells[1,y];
    sql.Text := 'select * from goods where id='+id;
    try
      open;
      tb_sname.Text := FieldByName('sname').asstring;
      tb_name.Text := FieldByName('name').asstring;
      tb_num.Text := '0';
      tb_inprc.Text := FieldByName('inprc').asstring;
      tb_je.Text := '0';
      tb_memo.Text := FieldByName('memo').asstring;
      tb_memo2.Text :='';
      tb_num.Enabled := true;
      tb_inprc.Enabled := true;
      tb_je.Enabled := true;
      tb_memo.Enabled := true;
      tb_memo2.Enabled := true;
      button1.enabled := true;
      sg.Visible := false;
      tb_num.SetFocus;
      close;
    except
      close;
    end;
  end;
end;

end.