goods.pas

来自「这是应一个市委的朋友要求给做一个物品管理软件。 初始密码:admin」· PAS 代码 · 共 409 行

unit goods;

interface

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

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;
    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);
  private 
    flag : char;
    procedure cb_ini;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fgoods: Tfgoods;

implementation
uses dm,vks;

{$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
  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;

procedure Tfgoods.D1Click(Sender: TObject);
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
      execsql;
      R1Click(Sender);
      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);
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
      execsql;
      R1Click(Sender);
      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;
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;
      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+''','+cb1.Text+','+cb2.Text+','+cb3.Text+','''+tb_bzqi.Text;
        sql.Text := sql.Text+''','+tb_inprc.Text+','+tb_outprc.Text+','''+tb_memo.Text+''')';
      end
      else
      begin
        sql.Text := 'update [goods] set name='''+tb_name.Text+''',sname='''+tb_sname.Text+''',vid='+cb1.Text;
        sql.Text := sql.Text+',sid='+cb2.Text+',sid1='+cb3.Text+',bzqi='''+tb_bzqi.Text+''',inprc='+tb_inprc.Text;
        sql.Text := sql.Text+',rtlprc='+tb_outprc.Text+',[memo]='''+tb_memo.Text+''' where id='+dg_view.Fields[0].AsString;
      end;
      try
        execsql;
        Button2Click(Sender);
        R1Click(Sender);
      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);
end;

end.