outstore.~pas

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

unit outstore;

interface

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

type
  Toutstorefrm = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    cancel_btn: TBitBtn;
    DBGrid1: TDBGrid;
    delete_btn: TButton;
    save_btn: TButton;
    modify_btn: TButton;
    all_btn: TButton;
    outstore_ds1: TDataSource;
    outstore_cds1: TClientDataSet;
    BitBtn1: TBitBtn;
    list_codelb: TLabel;
    Label1: TLabel;
    list_datelb: TLabel;
    Label2: TLabel;
    pro_codelb: TLabel;
    pro_codeed: TComboBox;
    place_codelb: TLabel;
    place_codeed: TEdit;
    operator_idlb: TLabel;
    operator_ided: TComboBox;
    unitlb: TLabel;
    united: TEdit;
    pro_numlb: TLabel;
    pro_numed: TEdit;
    UpDown1: TUpDown;
    Label3: TLabel;
    Image1: TImage;
    Image2: TImage;
    procedure cancel_btnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure all_btnClick(Sender: TObject);
    procedure save_btnClick(Sender: TObject);
    procedure delete_btnClick(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure modify_btnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure pro_codeedClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure all_btnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure all_btnMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure save_btnMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure save_btnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure modify_btnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure modify_btnMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure delete_btnMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure delete_btnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  
  private
   product:Tproduct;
   operator:Toperator;
   place:Tplace;
   list:Tlist;
   store:Tstore;
   datestr:string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  outstorefrm: Toutstorefrm;

implementation

uses datamodule;

{$R *.dfm}

procedure Toutstorefrm.cancel_btnClick(Sender: TObject);
begin
outstorefrm.Close;
end;

procedure Toutstorefrm.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 ''O%'' ';
outstore_cds1.Data:=list.Lists(selstr);
list.Free; 
end;

procedure Toutstorefrm.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 ''O%'' ';
outstore_cds1.Data:=list.Lists(selstr);
list.Free;
end;

procedure Toutstorefrm.save_btnClick(Sender: TObject);
var
 selstr,modstr,instr:string;
 pro_num:integer;
begin
list:=Tlist.create ;
product:=Tproduct.create ;
place:=Tplace.create ;
operator:=Toperator.create ;
store:=Tstore.create ;
if label1.Caption =''  then
begin
showmessage('出库单编号不能为空！');
exit;
end;

try
 strtoint(pro_numed.Text);
 except
  showmessage('出库物品数量不对，有效值为整数！');
  exit;
  end;

if  list.ListRec(label1.Caption)  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;

selstr:='select * from store_info where '
+'pro_code='''+pro_codeed.Text+''' ';
if store.StoreRec(selstr)=false  then
begin
showmessage('库存中不存在该物品，请核查！');
exit;
end;

if strtoint(store.GetStoreNum(pro_codeed.Text))<strtoint(pro_numed.Text)  then
begin
showmessage('该库位物品数量小于出库数量，不能出库！');
exit;
end;

pro_num:=strtoint(store.GetStoreNum(pro_codeed.Text))-strtoint(pro_numed.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);

instr:='insert into list_info(list_code,operator_id,list_date,pro_code,'
+'pro_num,unit,place_code)values('''+label1.Caption+''','''+operator_ided.Text+''','
+''''+LABEL2.Caption +''','''+pro_codeed.Text+''','''+pro_numed.Text+''','''+united.Text+''','
+''''+place_codeed.Text+''')';
list.ListInsert(instr);

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 ''O%'' ';
outstore_cds1.Data:=list.Lists(selstr);
showmessage('恭喜你，该纪录成功录入！');

operator_ided.Text :='';
pro_codeed.Text :='';
united.Text :='';place_codeed.Text :='';
list.Free;
operator.Free;
product.Free;
place.Free;
store.Free;
end;

procedure Toutstorefrm.delete_btnClick(Sender: TObject);
var
 selsql,delsql:string;
begin
list:=Tlist.create ;
if  application.MessageBox('删除后不可恢复，确定要删除吗？','警告',mb_yesno+mb_iconquestion)=idyes then
begin
if label1.Caption=''  then
begin
showmessage('出库单编号不能为空！');
exit;
end;

delsql:='delete from list_info where list_code='''+label1.Caption+'''';
list.ListDelete(delsql);

selsql:='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 ''O%'' ';
outstore_cds1.Data :=list.Lists(selsql) ;
showmessage('恭喜你，该条记录已经成功删除！');

operator_ided.Text :='';
pro_codeed.Text :='';
united.Text :='';place_codeed.Text :='';
end;
list.Free;
end;

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

end;

procedure Toutstorefrm.modify_btnClick(Sender: TObject);
var
 modstr,selsql:string;
begin
list:=Tlist.create ;
operator:=Toperator.create ;
product:=Tproduct.create ;
place:=Tplace.create ;
if  application.MessageBox('真的需要修改该记录吗？','提示',mb_yesno+mb_iconquestion)=idyes then
begin

try
 strtoint(pro_numed.Text);
 except
  showmessage('入库物品数量不对，请核查！');
  exit;
  end;

if  list.ListRec(label1.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='''+label2.Caption +''',place_code='''+place_codeed.Text+''' '
+'where list_code='''+label1.Caption+'''';
list.ListUpdate(modstr);

selsql:='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='''+label1.Caption+''' ';
outstore_cds1.Data :=list.Lists(selsql);
showmessage('修改成功！');
operator_ided.Text :='';
pro_codeed.Text :='';
united.Text :='';place_codeed.Text :='';
end;
list.Free;
product.Free;
place.Free;
operator.Free;
end;

procedure Toutstorefrm.FormActivate(Sender: TObject);
begin
  list:=Tlist.create ;
 operator:=Toperator.create ;
 product:=Tproduct.create;
 store:=Tstore.create ;

 operator_ided.Items:=operator.GetIdList();
 pro_codeed.Items:=product.GetProIdList();

end;

procedure Toutstorefrm.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 Toutstorefrm.BitBtn1Click(Sender: TObject);
 var
  s,m: String;
  i: integer;
begin
  Label2.Caption := FormatDateTime('yyyy-mm-dd',Now());
  s:= 'O'+ 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 ''O%''');
    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;
  label1.Caption :=s;
  operator_ided.Text :='';
  pro_codeed.Text :='';
  united.Text :='';place_codeed.Text :='';
  
end;

procedure Toutstorefrm.BitBtn1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.BitBtn1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.all_btnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.all_btnMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.save_btnMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.save_btnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.modify_btnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.modify_btnMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.delete_btnMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

procedure Toutstorefrm.delete_btnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TBitBtn(Sender).Font.Color := clRed;
end;

end.