instore.~pas

这是用delphi开发的一个物资管理信息系统

unit instore;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB, ComCtrls,list_unit,operator_unit,
  product_unit,place_unit,store_unit,DBClient, Buttons, ExtCtrls;

type
  Tinstorefrm = class(TForm)
    GroupBox2: TGroupBox;
    instore_ds1: TDataSource;
    instore_cds1: TClientDataSet;
    cancel_btn: TBitBtn;
    BitBtn1: TBitBtn;
    Instore: TBitBtn;
    Instore_Change: TBitBtn;
    Instore_Del: TBitBtn;
    GroupBox3: TGroupBox;
    GroupBox1: TGroupBox;
    DBGrid1: TDBGrid;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label1: TLabel;
    place_codelb: TLabel;
    Image1: TImage;
    Image2: TImage;
    pro_codeed: TComboBox;
    place_codeed: TComboBox;
    Label6: TLabel;
    pro_numlb: TLabel;
    unitlb: TLabel;
    operator_idlb: TLabel;
    pro_numed: TEdit;
    UpDown1: TUpDown;
    united: TEdit;
    operator_ided: TComboBox;
    procedure cancel_btnClick(Sender: TObject);
    procedure InstoreClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure all_btnClick(Sender: TObject);
    procedure Instore_DelClick(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure Instore_ChangeClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pro_codeedClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);

 private
    list:Tlist;
    operator:Toperator;
    product:Tproduct;
    place:Tplace;
    store:Tstore;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  instorefrm: Tinstorefrm;

implementation

uses datamodule;

{$R *.dfm}

procedure Tinstorefrm.cancel_btnClick(Sender: TObject);
begin
instorefrm.Close;
end;

procedure Tinstorefrm.InstoreClick(Sender: TObject);
var
 instr,selstr,modstr:string;
 pro_num:integer;
begin
 if list.ListRec(label3.Caption)  then
begin
showmessage('对不起，该入库单编号已经存在，请核查！');
exit;
end;
try
 strtoint(pro_numed.Text);
 except
  showmessage('入库物品数量不对，请核查！');
  exit;
  end;

if operator.OperatorRec(operator_ided.Text)=false  then
begin
showmessage('对不起，该操作员代号不存在，请核查！');
exit;
end;

if product.CheckProRec(pro_codeed.Text)=false  then
begin
showmessage('对不起，该物品编码不存在，请核查！');
exit;
end;

if place.CheckRec(place_codeed.Text)=false  then
begin
showmessage('对不起，该库位号不存在，请核查！');
exit;
end;
instr:='insert into list_info(list_code,operator_id,list_date,pro_code,'
+'pro_num,unit,place_code)values('''+label3.Caption +''','''+operator_ided.Text+''','''+label5.Caption +''','
+''''+pro_codeed.Text+''','''+pro_numed.Text+''','''+united.Text+''','''+place_codeed.Text+''')';
list.ListInsert(instr);

selstr:='select * from store_info where '
+'pro_code='''+pro_codeed.Text+''' and place_code='''+place_codeed.Text+'''';

if store.StoreRec(selstr)=false  then
begin
instr:='insert into store_info(pro_code,store_pro_num,unit,place_code'
+')values('''+pro_codeed.Text+''','''+pro_numed.Text+''','''+united.Text+''','''+place_codeed.Text+''')';
store.StoreRecInsert(instr);
end
else
begin

pro_num:=strtoint(pro_numed.Text)+strtoint(store.GetStoreNum(pro_codeed.Text ));
modstr:='update store_info set store_pro_num='''+inttostr(pro_num)+''' '
+' where pro_code='''+pro_codeed.Text+''' and place_code='''+place_codeed.Text+'''';
store.StoreRecUpdate(modstr);
end;

selstr:='select list_code as 入库单编号,operator_id as 操作员代号,'
+'list_date as 入库日期,pro_code as 入库物品编码,pro_num as 入库物品数量,'
+'unit as 物品单位,place_code as  物品库位代号'
+'  from list_info where list_code like ''I%'' ';

instore_cds1.Data:=store.StoreRecs(selstr);
showmessage('恭喜你，录入成功！');
 operator_ided.Text :='';
 pro_codeed.Text :='';
 
end;

procedure Tinstorefrm.FormCreate(Sender: TObject);
var
 selstr:string;
begin
list:=Tlist.create ;
selstr:='select list_code as 入库单编号,operator_id as 操作员代号,'
+'list_date as 入库日期,pro_code as 入库物品编码,pro_num as 入库物品数量,'
+'unit as 物品单位,place_code as  物品库位代号'
+'  from list_info where list_code like ''I%'' ';
instore_cds1.Data:=list.Lists(selstr);

list.Free;
end;

procedure Tinstorefrm.all_btnClick(Sender: TObject);
var
  selstr:string;
begin
list:=Tlist.create ;
selstr:='select list_code as 入库单编号,operator_id as 操作员代号,'
+'list_date as 入库日期,pro_code as 入库物品编码,pro_num as 入库物品数量,'
+'unit as 物品单位,place_code as  物品库位代号'
+'  from list_info where list_code like ''I%'' ';
instore_cds1.Data:=list.Lists(selstr);
list.Free;
end;

procedure Tinstorefrm.Instore_DelClick(Sender: TObject);
var
  delstr,selstr:string;
begin

if  application.MessageBox('删除后不可恢复，确定要删除吗？','警告',mb_yesno+mb_iconquestion)=idyes then
begin
if  list.ListRec(label3.Caption)=false  then
begin
showmessage('对不起，该入库单编号不存在，请核查！');
exit;
end;
delstr:='delete from list_info where list_code='''+label3.Caption+'''';
list.ListDelete(delstr);
 selstr:='select list_code as 入库单编号,operator_id as 操作员代号,'
+'list_date as 入库日期,pro_code as 入库物品编码,pro_num as 入库物品数量,'
+'unit as 物品单位,place_code as  物品库位代号'
+'  from list_info where list_code like ''I%'' ';
instore_cds1.Data :=list.Lists(selstr);
showmessage('恭喜你，删除成功！');
 operator_ided.Text :='';
 pro_codeed.Text :='';
 united.Text :='';place_codeed.Text :='';
end;

end;

procedure Tinstorefrm.DBGrid1CellClick(Column: TColumn);
begin
label3.Caption:=DBGrid1.Fields[0].AsString   ;
operator_ided.Text :=DBGrid1.Fields[1].AsString    ;
pro_codeed.Text :=DBGrid1.Fields[3].AsString   ;
pro_numed.Text:=DBGrid1.Fields[4].AsString    ;
united.Text :=DBGrid1.Fields[5].AsString   ;
label5.Caption:=DBGrid1.Fields[2].AsString   ;
place_codeed.Text :=DBGrid1.Fields[6].AsString  ;
end;

procedure Tinstorefrm.Instore_ChangeClick(Sender: TObject);
var
selstr,modstr:string;
begin
if  application.MessageBox('要修改这条记录吗？','提示',mb_yesno+mb_iconquestion)=idyes then
begin
if label3.Caption=''  then
begin
showmessage('入库单编号不能为空！');
exit;
end;
try
 strtoint(pro_numed.Text);
 except
  showmessage('入库物品数量不对，请核查！');
  exit;
  end;
if  list.ListRec(label3.Caption)=false  then
begin
showmessage('对不起，该入库单编号不存在，请核查！');
exit;
end;
if operator.OperatorRec(operator_ided.Text)=false  then
begin
showmessage('对不起，该操作员代号不存在，请核查！');
exit;
end;

if product.CheckProRec(pro_codeed.Text)=false  then
begin
showmessage('对不起，该物品编码不存在，请核查！');
exit;
end;

if place.CheckRec(place_codeed.Text)=false  then
begin
showmessage('对不起，该库位号不存在，请核查！');
exit;
end;
modstr:='update list_info set operator_id='''+operator_ided.Text+''',  '
+'pro_code='''+pro_codeed.Text+''',pro_num='''+pro_numed.Text+''','
+'unit='''+united.Text+''',list_date='''+label5.Caption +''',place_code='''+place_codeed.Text+''' '
+'where list_code='''+label3.Caption+'''';
list.ListUpdate(modstr);

selstr:='select list_code as 入库单编号,operator_id as 操作员代号,'
+'list_date as 入库日期,pro_code as 入库物品编码,pro_num as 入库物品数量,'
+'unit as 物品单位,place_code as  物品库位代号'
+'  from list_info where list_code like ''I%'' ';
showmessage('这条信息修改成功！');
 operator_ided.Text :='';
 pro_codeed.Text :='';
 united.Text :='';
 place_codeed.Text :='';
end;

end;

procedure Tinstorefrm.FormActivate(Sender: TObject);
begin

 list:=Tlist.create ;
 operator:=Toperator.create ;
 product:=Tproduct.create;
 place:=Tplace.create ;
 store:=Tstore.create ;
 operator_ided.Items:=operator.GetIdList();
 pro_codeed.Items:=product.GetProIdList();
 place_codeed.Items :=place.GetPlaceIdList();
end;

procedure Tinstorefrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 list.Free ;
 operator.Free ;
 product.Free;
 place.Free ;
 store.Free;
end;

procedure Tinstorefrm.pro_codeedClick(Sender: TObject);
begin
   united.Text :=product.GetUnit(pro_codeed.Text );
   place_codeed.Text :=store.GetPlaceCode(pro_codeed.Text ) ;
   united.Enabled :=false; 
end;

procedure Tinstorefrm.BitBtn1Click(Sender: TObject);
 var
  s,m: String;
  i: integer;
begin
  Label5.Caption := FormatDateTime('yyyy-mm-dd',Now());
  s:= 'I'+ FormatDateTime('yyyymmdd',Now());
 With DataMOD.ADOQuery1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select max(list_code) as ss From list_info where list_code like ''I%'' ');
    Open;
  end;
  If Datamod.ADOQuery1.FieldByName('ss').Value = null then
    s := s + '000001'
  else
  begin
    m:= Trim(Datamod.ADOQuery1.FieldByName('ss').Value) ;
    i:= StrToInt(Trim(Copy(m,10,6))) ;
    if i<9 then
      s:= s + '00000'+ InttoStr(i +1)
    else if i<99 then
      s:= s + '0000'+ InttoStr(i +1)
    else if i<999 then
     s:=s+'000'+inttostr(i+1)
   else if i<9999 then
     s:=s+'00'+inttostr(i+1)
   else if i<99999 then
     s:=s+'0'+inttostr(i+1)
  else
   s:=s+inttostr(i+1);
  end;
  label3.Caption :=s;
  operator_ided.Text :='';
  pro_codeed.Text :='';
  united.Text :='';place_codeed.Text :='';
   place_codeed.Enabled :=true;
  
end;

end.