inputgoods.pas

文具管理系统 采用VFP数据库编的

unit InputGoods;

interface

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

type
  TFrmInputGoods = class(TForm)
    Label1: TLabel;
    DTPInDate: TDateTimePicker;
    Label2: TLabel;
    CmbClass: TComboBox;
    Label3: TLabel;
    CmbGoods: TComboBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    EdtGuige: TEdit;
    EdtUnit: TEdit;
    EdtPrice: TEdit;
    EdtAmount: TEdit;
    MemoGoods: TMemo;
    Label7: TLabel;
    Label8: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    LMsg: TLabel;
    CmbID: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure CmbClassChange(Sender: TObject);
    procedure CmbGoodsChange(Sender: TObject);
    procedure EdtAmountKeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
    procedure ReadAllClassName;
    procedure ReadClassOfGoods(iParentID:integer);
    procedure InsertGoodsToStock;
    procedure UpdateGoodsTOStock;
    procedure InsertGoodsTOInHistory;
    function ResultExistAmount(sGoods:string):integer;

  public
    { Public declarations }
  end;

var
  FrmInputGoods: TFrmInputGoods;

implementation

uses Global,dm, Logo;

{$R *.dfm}

procedure TFrmInputGoods.FormCreate(Sender: TObject);
begin
self.Caption :=SFormStock;
LMsg.Caption :='';
DTPInDate.Date :=now;
CmbClass.Clear;
CmbGoods.Clear;
EdtGuige.Clear;
EdtUnit.Clear;
EdtPrice.Clear;
EdtAmount.Clear;
MemoGoods.Clear;
with FrmLogo do
  begin
    LMsg1.Caption :=sMsgLoadInfo4;
    LMsg2.Caption :=sMsgLoadInfo4;
    LMsg1.Update;
    LMsg2.Update;
  end;
ReadAllClassName;   //Read Class Name

end;

procedure TFrmInputGoods.ReadAllClassName;
begin
CmbClass.Clear;
with DM_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLReadAllClassName;
    open;
    first;
    while not eof do
      begin
        if FieldValues[SFGoodsName]<>null then
           CmbClass.Items.Add(FieldValues[SFGoodsName]);
           CmbID.Items.Add(FieldValues[SFAutoNumber]);
        next;
      end;
  end;
end;

procedure TFrmInputGoods.CmbClassChange(Sender: TObject);
begin
if CmbClass.ItemIndex =-1 then exit;
CmbId.ItemIndex :=CmbClass.ItemIndex;
ReadClassOfGoods(StrToInt(CmbId.text));
EdtGuige.Text :='';
EdtUnit.Text :='';
EdtPrice.Text :='';
LMsg.Caption :='';
end;

procedure TFrmInputGoods.ReadClassOfGoods(iParentID: integer);
begin
CmbGoods.Clear;
with DM_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLReadClassOfGoods ;
    parameters.ParamByName('pParent').Value :=iParentID;
    open;
    first;
    while not eof do
      begin
        if FieldValues[SFGoodsName]<> null then
          CmbGoods.Items.Add(FieldValues[SFGoodsName]);
        next;
      end;
    close;
  end;
end;

procedure TFrmInputGoods.CmbGoodsChange(Sender: TObject);
begin
EdtAmount.Text :='';
if CmbGoods.Text ='' then exit;
if ResultExistAmount(CmbGoods.Text) =0 then
  Lmsg.Caption := sMsgGoodsNoExist ;
if ResultExistAmount(CmbGoods.Text) >0 then
  Lmsg.Caption := format(sMsgGoodsExistAmount,
                         [CmbGoods.Text,ResultExistAmount(CmbGoods.Text)]) ;
with DM_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLReadGoodsInfo;
    parameters.ParamByName('pGoodsName').Value :=CmbGoods.Text;
    open;
    if FieldValues[SFGuiGe]<>null then
      EdtGuige.Text :=FieldValues[SFGuiGe]
      else
      EdtGuige.Text :='';
    if FieldValues[SFUnit]<>null then
      EdtUnit.Text :=FieldValues[SFUnit]
      else
      EdtUnit.Text :='';
    if FieldValues[SFPrice]<>null then
      EdtPrice.Text :=FieldValues[SFPrice]
      else
      EdtPrice.Text :='';
    close;
  end;
end;

procedure TFrmInputGoods.EdtAmountKeyPress(Sender: TObject; var Key: Char);
begin
if not ( key in['0'..'9','.',#8,#13]) then key:=#0;
end;

procedure TFrmInputGoods.InsertGoodsTOStock;
//仓库库存中无此物品时，插入
begin
with dm_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLInsertGoodsToStock ;
    parameters.ParamByName('pGoods').Value :=CmbGoods.Text;
    parameters.ParamByName('pAcount').Value :=EdtAmount.Text;
    if trim(MemoGoods.Text)='' then MemoGoods.Text:='无';
    parameters.ParamByName('pMemo').Value :=MemoGoods.Text;
    execsql;
  end;
end;

function TFrmInputGoods.ResultExistAmount(sGoods:string):integer;
begin
with dm_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLGoodsExist;
    parameters.ParamByName('pGoods').Value :=sGoods;
    open;
    if RecordCount<>0 then
      Result:=Fieldvalues[SFAmount]
      else
      Result:=0;
    close;
  end;
end;

procedure TFrmInputGoods.UpdateGoodsTOStock;
begin
with dm_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLUpdateGoodsToStock;
    parameters.ParamByName('pGoods').Value :=CmbGoods.Text;
    parameters.ParamByName('pAmount').Value :=EdtAmount.Text;
    if trim(MemoGoods.Text)='' then MemoGoods.Text:='无';
    parameters.ParamByName('pMemo').Value :=MemoGoods.Text;
    execsql;
  end;

end;

procedure TFrmInputGoods.InsertGoodsTOInHistory;
var
  yy,mm,dd:Word;
begin
decodeDate(DTPInDate.Date,yy,mm,dd);
with dm_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLInsertGoodsToInHistory ;
    parameters.ParamByName('pDate').Value :=DateToStr(DTPInDate.Date);
    parameters.ParamByName('pYm').Value :=IntToStr(yy)+'年'+IntToStr(mm)+'月';
    parameters.ParamByName('pGoods').Value :=CmbGoods.Text;
    parameters.ParamByName('pAcount').Value :=EdtAmount.Text;
    parameters.ParamByName('pMemo').Value :=MemoGoods.Text;
    execsql;
  end;
end;

procedure TFrmInputGoods.BitBtn1Click(Sender: TObject);
begin
if CmbClass.ItemIndex =-1 then
  begin
    CmbClass.SetFocus;
    exit;
  end;
if CmbGoods.ItemIndex =-1 then
  begin
    CmbGoods.SetFocus;
    exit;
  end;
if EdtAmount.Text ='' then
  begin
    EdtAmount.SetFocus;
    exit;
  end;
InsertGoodsTOInHistory;  //插入数据到 进仓历史 数据表
if ResultExistAmount(CmbGoods.Text)<>0 then  //如果该物品己存在
  UpdateGoodsTOStock   //更新该物品的数量信息
  else
  InsertGoodsTOStock;  //不存在则插入新项
LMsg.Caption :=sMsgAddGoodsOk;
end;


end.