unitm.pas

小型仓库管理系统

unit UnitM;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, DB, ADODB;

type
  TfmM = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Image1: TImage;
    LbB: TLabel;
    edtA: TEdit;
    LbC: TLabel;
    LbD: TLabel;
    edtC: TEdit;
    LbE: TLabel;
    edtD: TEdit;
    LbA: TLabel;
    edtE: TEdit;
    LbF: TLabel;
    btnA: TBitBtn;
    btnC: TBitBtn;
    Image2: TImage;
    Label4: TLabel;
    edt1: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    edt3: TEdit;
    Label7: TLabel;
    edt4: TEdit;
    Label10: TLabel;
    edt5: TEdit;
    btn1: TBitBtn;
    btn3: TBitBtn;
    btnB: TBitBtn;
    btn2: TBitBtn;
    LbG: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    comb1: TComboBox;
    mc1: TMonthCalendar;
    Label1: TLabel;
    mcA: TMonthCalendar;
    combA: TComboBox;
    Label11: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    edtI: TEdit;
    comb2: TComboBox;
    combB: TComboBox;
    combG: TComboBox;
    edtH: TEdit;
    edt6: TEdit;
    procedure btn1Click(Sender: TObject);
    procedure btnAClick(Sender: TObject);
    procedure btnCClick(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btnBClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure comb1DropDown(Sender: TObject);
    procedure combADropDown(Sender: TObject);
    procedure mcAClick(Sender: TObject);
    procedure mc1Click(Sender: TObject);
    procedure edt1KeyPress(Sender: TObject; var Key: Char);
    procedure edt2KeyPress(Sender: TObject; var Key: Char);
    procedure edt3KeyPress(Sender: TObject; var Key: Char);
    procedure edtAKeyPress(Sender: TObject; var Key: Char);
    procedure edtBKeyPress(Sender: TObject; var Key: Char);
    procedure edtCKeyPress(Sender: TObject; var Key: Char);
    procedure edtDKeyPress(Sender: TObject; var Key: Char);
    procedure edtEKeyPress(Sender: TObject; var Key: Char);
    procedure edtGKeyPress(Sender: TObject; var Key: Char);
    procedure edt4KeyPress(Sender: TObject; var Key: Char);
    procedure edt5KeyPress(Sender: TObject; var Key: Char);
    procedure FormActivate(Sender: TObject);
    procedure combBSelect(Sender: TObject);
    procedure comb2Select(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmM: TfmM;

implementation

uses  UnitDm, UnitMain;

{$R *.dfm}

Function sss(a:string):string;
var s2,s3,s4,c:string;
begin
  s2:=Copy(a,1,4);
  c:=Copy(a,7,1);
  if c='-' then
    begin
     s3:=s2+'0'+Copy(a,6,1);
     s4:=s3+Copy(a,8,2);
    end
  else
    begin
     s3:=s2+Copy(a,6,2);
     s4:=s3+Copy(a,9,2);
    end;
  result:=s4;
end;

procedure TfmM.btnAClick(Sender: TObject);
var  s,s1,s2,s3,s4,s5,s6,s7,s8:string;
begin
  s:=trim(edtA.Text);
  s1:=trim(combB.Text);
  s2:=trim(edtC.Text);
  s3:=trim(edtD.Text);
  s4:=trim(edtE.Text);
  s5:=trim(combA.Text);
  s5:=sss(s5);
  s6:=trim(combG.Text);
  s7:=trim(edtH.Text);
  s8:=trim(edtI.Text);
  if  ( Trim(edtA.Text)<>'')and
      ( Trim(combB.Text)<>'')and
      ( Trim(edtC.Text)<>'')and
      ( s5<>'')  then
      begin
            frDbm.dsetM.Close;
            frDbm.dsetM.CommandText:='select * from t_mlist where sno='+s;
            frDbm.dsetM.Open;
          if frDbm.dsetM.Fields[0].AsString='' then
            begin
              frDbm.dsetM.Close;
              frDbm.dsetM.CommandText:='select * from t_mjin where sno='+s;
              frDbm.dsetM.Open;
              if frDbm.dsetM.Fields[0].AsString='' then
            begin
              if s6<>'' then
               begin
                 frDbm.dsetM.Close;
                 frDbm.dsetM.CommandText:='select * from t_Suppliers where sno='+s6;
                 frDbm.dsetM.Open;
                 if frDbm.dsetM.Fields[0].AsString='' then
                   begin
                     showmessage('不存在编号为'+s6+'的供应商，请重新输入！');
                     exit;
                   end;
               end;
               if s7<>'' then
               begin
                 frDbm.dsetM.Close;
                 frDbm.dsetM.CommandText:='select * from t_store where cno='+s7;
                 frDbm.dsetM.Open;
                 if frDbm.dsetM.Fields[0].AsString='' then
                   begin
                     showmessage('不存在编号为'+s7+'的仓库，请重新输入！');
                     exit;
                   end;
               end;
             with   frDbm.comM1   do
             begin
               frDbm.comM1.commandType:=cmdStoredProc;
               frDbm.comM1.CommandText:='mjinAdd';
               Parameters.Refresh;
               Parameters.ParamByName('@sno').Value:=s;
               Parameters.ParamByName('@msno').Value:=s1;
               Parameters.ParamByName('@number').Value:=s2;
               Parameters.ParamByName('@price').Value:=s3;
               Parameters.ParamByName('@name').Value:=s4;
               Parameters.ParamByName('@shijian').Value:=s5;
               Parameters.ParamByName('@tsno').Value:=s6;
               Parameters.ParamByName('@cno').Value:=s7;
               Parameters.ParamByName('@remark').Value:=s8;
               frDbm.comM1.Execute;
               showmessage('数据添加成功！');
             end;
            end
            else showmessage('数据库中已经存在进库单号为'+s+'的记录，请重新输入！');
         end
        else
        showmessage('不存在该编号的材料，请重新输入!');
     end
  else
  showmessage('入库单编号，材料编号，入库数量，入库时间不能为空！')
end;

procedure TfmM.btnCClick(Sender: TObject);
begin
  edtA.Text:='';
  combB.Text:='';
  edtC.Text:='';
  edtD.Text:='';
  edtE.Text:='';
  combA.Text:='';
  combG.Text:='';
  edtH.Text:='';
  edtI.Text:='';
end;

procedure TfmM.btn1Click(Sender: TObject);
var  s,s1,s2,s3,s4,s5,s6:string;
     n:integer;
begin
  s:=trim(edt1.Text);
  s1:=trim(comb2.Text);
  s2:=trim(edt3.Text);
  s3:=trim(edt4.Text);
  s4:=trim(comb1.Text);
  s4:=sss(s4);
  s5:=trim(edt5.Text);
  s6:=trim(edt6.Text);
  if  ( Trim(edt1.Text)<>'')and
      ( Trim(comb2.Text)<>'')and
      ( Trim(edt3.Text)<>'')and
      ( s4<>'')  then
      begin
        frDbm.dsetM.Close;
        frDbm.dsetM.CommandText:='select * from t_mlist where sno='+s1+'';
        frDbm.dsetM.Open;

        if frDbm.dsetM.Fields[0].AsString<>'' then
          begin
            frDbm.dsetM.Close;
            frDbm.dsetM.CommandText:='select * from t_mout where sno='+s;
            frDbm.dsetM.Open;
            if frDbm.dsetM.Fields[0].AsString='' then
            begin
              if s6<>'' then
               begin
                 frDbm.dsetM.Close;
                 frDbm.dsetM.CommandText:='select * from t_store where cno='+s6;
                 frDbm.dsetM.Open;
                 if frDbm.dsetM.Fields[0].AsString='' then
                   begin
                     showmessage('不存在编号为'+s6+'的仓库，请重新输入！');
                     exit;
                   end;
               end;
               frDbm.dsetM.Close;
               frDbm.dsetM.CommandText:='select number from t_mstore where msno='+s1+'';
               frDbm.dsetM.Open;
               n:=frDbm.dsetM.Fields[0].AsInteger;
               n:=n-strtoint(s2);
               if n<0 then  showmessage('出库数量不能大于库存数量!');
            with   frDbm.comM2   do
             begin
               frDbm.comM2.commandType:=cmdStoredProc;
               frDbm.comM2.CommandText:='moutAdd';
               Parameters.Refresh;
               Parameters.ParamByName('@sno').Value:=s;
               Parameters.ParamByName('@msno').Value:=s1;
               Parameters.ParamByName('@number').Value:=s2;
               Parameters.ParamByName('@name').Value:=s3;
               Parameters.ParamByName('@shijian').Value:=s4;
               Parameters.ParamByName('@remark').Value:=s5;
               Parameters.ParamByName('@cno').Value:=s6;
               frDbm.comM2.Execute;