goods.pas

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

unit goods;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, RzTabs, ComCtrls, Grids, DBGridEh, StdCtrls, Menus, EhLibADO,
  frxClass, Printers,PrViewEh, PrnDbgeh;

type
  Tfgoods = class(TForm)
    Panel1: TPanel;
    dg_view: TDBGridEh;
    pl_info: TPanel;
    Panel3: TPanel;
    Label2: TLabel;
    Label1: TLabel;
    tb_name: TEdit;
    Label3: TLabel;
    tb_sname: TEdit;
    Label4: TLabel;
    cb_vendor: TComboBox;
    Label5: TLabel;
    cb_gg: TComboBox;
    Label6: TLabel;
    cb_sort: TComboBox;
    Label7: TLabel;
    tb_bzqi: TEdit;
    Label8: TLabel;
    tb_inprc: TEdit;
    Label9: TLabel;
    tb_outprc: TEdit;
    Label10: TLabel;
    Button1: TButton;
    Button2: TButton;
    tb_memo: TMemo;
    PopupMenu1: TPopupMenu;
    A1: TMenuItem;
    M1: TMenuItem;
    D1: TMenuItem;
    R1: TMenuItem;
    N1: TMenuItem;
    L1: TMenuItem;
    lbl_info: TLabel;
    Label11: TLabel;
    cb1: TComboBox;
    cb2: TComboBox;
    cb3: TComboBox;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    MenuItem1: TMenuItem;
    A2: TMenuItem;
    M2: TMenuItem;
    D2: TMenuItem;
    R2: TMenuItem;
    N3: TMenuItem;
    L2: TMenuItem;
    N4: TMenuItem;
    PrintDBGridEh1: TPrintDBGridEh;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure A1Click(Sender: TObject);
    procedure M1Click(Sender: TObject);
    procedure D1Click(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure L1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure cb_vendorChange(Sender: TObject);
    procedure tb_nameKeyPress(Sender: TObject; var Key: Char);
    procedure tb_snameKeyPress(Sender: TObject; var Key: Char);
    procedure cb_vendorKeyPress(Sender: TObject; var Key: Char);
    procedure cb_ggKeyPress(Sender: TObject; var Key: Char);
    procedure cb_sortKeyPress(Sender: TObject; var Key: Char);
    procedure tb_bzqiKeyPress(Sender: TObject; var Key: Char);
    procedure tb_inprcKeyPress(Sender: TObject; var Key: Char);
    procedure tb_outprcKeyPress(Sender: TObject; var Key: Char);
    procedure tb_memoKeyPress(Sender: TObject; var Key: Char);
    procedure dg_viewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure MenuItem1Click(Sender: TObject);
  private 
    flag : char;
    procedure cb_ini;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fgoods: Tfgoods;

implementation
uses dm,vks,main;

{$R *.dfm}

procedure Tfgoods.cb_ini;
begin
  with fdm.q do
  begin
    close;
    sql.Text := 'select id,name from vendor where flag=0 order by name';
    cb_vendor.Clear;
    cb1.Clear;
    try
      open;
      while not eof do
      begin
        cb_vendor.Items.Add(FieldByName('name').AsString);
        cb1.Items.Add(FieldByName('id').AsString);
        next;
      end;
      cb_vendor.ItemIndex := 0;
      cb1.ItemIndex := 0;
    except
      vks.info(1012);
      exit;
    end;
    close;
    sql.Text := 'select id,name from sort where flag=0 and type=''O'' order by name';
    cb_gg.Clear;
    cb2.Clear;
    try
      open;
      while not eof do
      begin
        cb_gg.Items.Add(FieldByName('name').AsString);
        cb2.Items.Add(FieldByName('id').AsString);
        next;
      end;
      cb_gg.ItemIndex := 0;
      cb2.ItemIndex := 0;
    except
      vks.info(1012);
      exit;
    end;
    close;
    sql.Text := 'select id,name from sort where flag=0 and type=''S'' order by name';
    cb_sort.Clear;
    cb3.Clear;
    try
      open;
      while not eof do
      begin
        cb_sort.Items.Add(FieldByName('name').AsString);
        cb3.Items.Add(FieldByName('id').AsString);
        next;
      end;
      cb_sort.ItemIndex := 0;
      cb3.ItemIndex := 0;
    except
      vks.info(1012);
      exit;
    end;
  end;
end;

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

procedure Tfgoods.A1Click(Sender: TObject);
begin
  dg_view.Enabled := false;
  pl_info.Visible := true;
  flag := 'A';
  tb_name.SetFocus;
  pl_info.Left := (width - pl_info.Width) div 2;
  pl_info.Top := (Height - pl_info.Height) div 2;
end;

procedure Tfgoods.M1Click(Sender: TObject);
begin
  if fdm.qgoods.RecordCount>0 then
  begin
    dg_view.Enabled := false;
    pl_info.Visible := true;
    flag := 'M';
    tb_name.Text := dg_view.Fields[1].AsString;
    tb_sname.Text := dg_view.Fields[2].AsString;
    cb_sort.ItemIndex := cb_sort.Items.IndexOf(dg_view.Fields[3].AsString);
    cb_gg.ItemIndex := cb_gg.Items.IndexOf(dg_view.Fields[4].AsString);
    cb_vendor.ItemIndex := cb_vendor.Items.IndexOf(dg_view.Fields[5].AsString);
    tb_bzqi.Text := dg_view.Fields[6].AsString;
    tb_inprc.Text := dg_view.Fields[7].AsString;
    tb_outprc.Text := dg_view.Fields[8].AsString;
    tb_memo.Text := dg_view.Fields[10].AsString;
    tb_name.SetFocus;
    pl_info.Left := (width - pl_info.Width) div 2;
    pl_info.Top := (Height - pl_info.Height) div 2;
  end;
end;

procedure Tfgoods.D1Click(Sender: TObject);
var
  idx : integer;
begin
if (fdm.qgoods.RecordCount>0) and (vks.box('确定要删除本数据吗?'#13#10'如果没有关联数据,将能被删除.','商品数据删除窗口')) then
begin
  with fdm.q do
  begin
    close;
    sql.Text := 'delete from [goods] where id='+dg_view.Fields[0].AsString;
    try
      if dg_view.DataSource.DataSet.RecordCount<>1 then idx := dg_view.DataSource.DataSet.RecNo else idx := 0;
      execsql;
      R1Click(Sender);
      if idx<>0 then dg_view.DataSource.DataSet.RecNo := idx;
      close;
    except
      close;
      vks.info(1008);
    end;
  end;
end;
end;

procedure Tfgoods.R1Click(Sender: TObject);
begin
  fdm.qgoods.Close;
  fdm.qgoods.Open;
  lbl_info.Caption := '共'+IntToStr(fdm.qgoods.RecordCount)+'条';
end;

procedure Tfgoods.L1Click(Sender: TObject);
var
  idx : integer;
begin
if fdm.qgoods.RecordCount>0 then
begin
  with fdm.q do
  begin
    close;
    sql.Text := 'update [goods] set flag=not flag where id='+dg_view.Fields[0].AsString;
    try
      idx := dg_view.DataSource.DataSet.RecNo;
      execsql;
      R1Click(Sender);
      dg_view.DataSource.DataSet.RecNo := idx;
      dg_view.SetFocus;
      close;
    except
      close;
      vks.info(1008);
    end;
  end;
end;
end;

procedure Tfgoods.FormShow(Sender: TObject);
begin
  FormResize(Sender);
  cb_ini;
  if not fdm.qvlist.Active then fdm.qvlist.Active := true;
  if not fdm.qslist.Active then fdm.qslist.Active := true;
  if not fdm.qslist1.Active then fdm.qslist1.Active := true;
  if not fdm.qgoods.Active then R1Click(Sender)
  else lbl_info.Caption := '共'+IntToStr(fdm.qgoods.RecordCount)+'条';
end;

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

procedure Tfgoods.Button1Click(Sender: TObject);
var
  cnt : string;
  c1,c2,c3 : string;
  idx : integer;
begin
  if tb_name.Text='' then
  begin
    vks.info(1017);
    tb_name.SetFocus;
    exit;
  end;
  if tb_sname.Text='' then
  begin
    vks.info(1018);
    tb_sname.SetFocus;
    exit;
  end;
  if tb_bzqi.Text='' then
  begin
    vks.info(1019);
    tb_bzqi.SetFocus;
    exit;
  end;
  if tb_inprc.Text='' then
  begin
    vks.info(1020);
    tb_inprc.SetFocus;
    exit;
  end;
  if tb_outprc.Text='' then
  begin
    vks.info(1021);
    tb_outprc.SetFocus;
    exit;
  end;
  with fdm.q do
  begin
    close;
    sql.Text := 'select count(1) as cnt from [goods] where name='''+tb_name.Text+'''';
    if flag='M' then sql.Text := sql.Text + ' and id<>'+dg_view.Fields[0].AsString;
    try
      Open;
      cnt := FieldByName('cnt').AsString;
      close;
      if cnt<>'0' then
      begin
        vks.info(1011);
        exit;
      end;
      c1 := cb1.Items.Strings[cb_vendor.Items.IndexOf(cb_vendor.Text)];
      c2 := cb2.Items.Strings[cb_gg.Items.IndexOf(cb_gg.Text)];
      c3 := cb3.Items.Strings[cb_sort.Items.IndexOf(cb_sort.Text)];
      if flag='A' then
      begin
        sql.Text := 'insert into [goods](name,sname,vid,sid,sid1,bzqi,inprc,rtlprc,[memo]) values('''+tb_name.Text;
        sql.Text := sql.Text+''','''+tb_sname.Text+''','+c1+','+c2+','+c3+','''+tb_bzqi.Text+''','+tb_inprc.Text;
        sql.Text := sql.Text+','+tb_outprc.Text+','''+tb_memo.Text+''')';
      end
      else
      begin
        sql.Text := 'update [goods] set name='''+tb_name.Text+''',sname='''+tb_sname.Text+''',vid='+c1+',sid='+c2;
        sql.Text := sql.Text+',sid1='+c3+',bzqi='''+tb_bzqi.Text+''',inprc='+tb_inprc.Text+',rtlprc='+tb_outprc.Text;
        sql.Text := sql.Text+',[memo]='''+tb_memo.Text+''' where id='+dg_view.Fields[0].AsString;
      end;
      try
        execsql;
        if flag='A' then idx := dg_view.DataSource.DataSet.RecordCount+1
        else idx:=dg_view.DataSource.DataSet.RecNo;
        Button2Click(Sender);
        R1Click(Sender);
        dg_view.DataSource.DataSet.RecNo := idx;
        dg_view.SetFocus;
      except
        close;
        vks.info(1008);
      end;
    except
      close;
      vks.info(1008);
    end;
  end;
end;

procedure Tfgoods.Button2Click(Sender: TObject);
begin
  pl_info.Visible := false;
  tb_name.Clear;
  tb_sname.Clear;
  tb_bzqi.Clear;
  tb_inprc.Clear;
  tb_outprc.Clear;
  tb_memo.Clear;
  dg_view.Enabled := true;
end;

procedure Tfgoods.cb_vendorChange(Sender: TObject);
begin
  if (Sender as TComboBox).Name='cb_vendor' then
    cb1.ItemIndex := cb_vendor.ItemIndex
  else if (Sender as TComboBox).Name='cb_gg' then
    cb2.ItemIndex := cb_gg.ItemIndex
  else if (Sender as TComboBox).Name='cb_sort' then
    cb3.ItemIndex := cb_sort.ItemIndex;
end;

procedure Tfgoods.tb_nameKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then tb_name.Clear
  else if (key=#13) and (tb_name.Text<>'') then tb_sname.SetFocus;
end;

procedure Tfgoods.tb_snameKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then tb_sname.Clear
  else if (key=#13) and (tb_sname.Text<>'') then cb_vendor.SetFocus;
end;

procedure Tfgoods.cb_vendorKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then cb_vendor.ItemIndex :=0
  else if (key=#13) and (cb_vendor.Text<>'') then cb_gg.SetFocus;
end;

procedure Tfgoods.cb_ggKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then cb_gg.ItemIndex :=0
  else if (key=#13) and (cb_gg.Text<>'') then cb_sort.SetFocus;
end;

procedure Tfgoods.cb_sortKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then cb_sort.ItemIndex :=0
  else if (key=#13) and (cb_sort.Text<>'') then tb_bzqi.SetFocus;
end;

procedure Tfgoods.tb_bzqiKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then tb_bzqi.Clear
  else if (key=#13) and (tb_bzqi.Text<>'') then tb_inprc.SetFocus;
end;

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

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

procedure Tfgoods.tb_memoKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then tb_memo.Clear;
end;

procedure Tfgoods.dg_viewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=vk_f3 then A1Click(Sender);
  if key=vk_f4 then M1Click(Sender);
  if key=vk_delete then D1Click(Sender);
  if key=vk_f5 then R1Click(Sender);
  if key=vk_f6 then L1Click(Sender);
  //打印
  if key=vk_f11 then MenuItem1Click(Sender);
end;

procedure Tfgoods.MenuItem1Click(Sender: TObject);
begin
  PrinterPreview.Orientation := poLandscape;
  PrintDBGridEh1.Preview;
end;

end.