instore.pas

物流管理系统是一个典型的数据库应用程序

unit instore;

interface

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

type
  Tf_instore = class(Tf_frame)
    Label1: TLabel;
    Panel1: TPanel;
    Reginfo: TStringGrid;
    Panel2: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Date: TDateTimePicker;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Panel3: TPanel;
    Save: TBitBtn;
    Cancel: TBitBtn;
    Quit: TBitBtn;
    Grid: TDBGrid;
    RegSource: TDataSource;
    List: TListBox;
    Comstorage: TComboBox;
    Providername: TEdit;
    Principal: TEdit;
    Operator: TEdit;
    Rebate: TEdit;
    Stocktotal: TEdit;
    paymoney: TEdit;
    factmoney: TEdit;
    procedure ListExit(Sender: TObject);
    procedure ListDblClick(Sender: TObject);
    procedure ListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ProvidernameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DateKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RebateKeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);  virtual;
    procedure RebateKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ReginfoSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure ReginfoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);virtual;
    procedure ReginfoSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);virtual;
    procedure GridExit(Sender: TObject);
    procedure GridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure GridDblClick(Sender: TObject);
    procedure ReginfoKeyPress(Sender: TObject; var Key: Char);
    procedure ComstorageKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ComstorageExit(Sender: TObject);
    procedure StocktotalChange(Sender: TObject);
    procedure QuitClick(Sender: TObject);
    procedure ProvidernameEnter(Sender: TObject);
    procedure CancelClick(Sender: TObject);
    procedure factmoneyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SaveClick(Sender: TObject); virtual;
    procedure FormCreate(Sender: TObject);virtual;
  private
    { Private declarations }
  public
    barcode: Integer;
    storename: Integer;
    basicunit: integer;
    stockunit: Integer;
    convertions: Integer;
    unitprice: Integer;
    num: Integer;
    money: Integer;
    storagename: Integer;
    //barcode,storename,basicunit,stockunit,convertion,unitprice,num,money,storagename: Integer;
    Procedure SetListPos(Control: TControl); //设置列表出现的位置
    Function SelectTableinfo(TableName: String;FieldName: String;Value: Variant):Boolean;//有数据返回,返回指为True
    { Public declarations }
    Function CurrentIsNull: Boolean;//判断表格当前行是否为空
    Procedure ClearCurRow;//清空当前行
    Procedure ClearEndRow;//清空最后一行
    Function CalculateMoney: Real;//统计金额
    Procedure ClearEdit;//清空编辑框中的文本
    Procedure IniGrid;//初试化表格
    Function EditIsNull: Boolean;//判断编辑框文本是否为空
    Function GridIsNull: Boolean;//判断表格信息是否为空
    Function EndRowIsNull: Boolean;//判断表格最后一行是否为空
  end;
var
  f_instore: Tf_instore;
  row: Integer = 1; //记录当前单元格横坐标
  col: integer = 0;//记录当前单元格纵坐标
  Reg: Boolean= False; //在表格中输入登记信息时,防止再次触发列表的OnSetEditText事件
implementation
  uses data,main;
{$R *.dfm}

{ Tf_instore }
//自定义过程,设置列表框出现的位置
procedure Tf_instore.SetListPos(Control: TControl);
begin
  List.Top := Control.Top+Control.Parent.Top;
  List.Left := Control.Left+Control.Width;
  List.Visible := True;
  List.SetFocus;
end;
//在列表框失去焦点时不可见
procedure Tf_instore.ListExit(Sender: TObject);
begin
  inherited;
  List.Visible := False;
end;
//双击列表框,模拟列表框的按键操作,读取列表框信息
procedure Tf_instore.ListDblClick(Sender: TObject);
var
  Key: Word;
begin
  inherited;
  Key:= vk_ReTurn;
  List.OnKeyDown(nil,Key,[ssLeft]);
end;
//处理列表框的OnKeyDown事件,将列表框当前文本显示在文本框中
procedure Tf_instore.ListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
  begin
    case List.Tag of //根据列表框不同的Tag值设置相应的文本框文本
      0: begin
           Providername.Text := List.Items[List.ItemIndex];
           Providername.OnKeyDown(Providername,Key,shift);
           Providername.SetFocus;
         end;
      1: begin
           Principal.Text := List.Items[List.ItemIndex];
           Principal.SetFocus;
         end;
    end;
    List.Visible := False;
  end;
end;
//处理编辑框的OnKeyDown事件, 用户按PageDown键将以列表框形式显示信息供用户选择
procedure Tf_instore.ProvidernameKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
  procedure SelectTable(TableName: String;FieldIndex: integer);//将指定表某一字段数据显示在列表中
  begin
    List.Clear;
    with t_data.Query1 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select * from '+ TableName);
      Open;
    end;
    if t_data.Query1.RecordCount>0 then
    begin
      while Not t_data.Query1.Eof do
      begin
        List.Items.Add(t_data.Query1.Fields[FieldIndex].AsString);
        t_data.Query1.Next;
      end;
    end;
    if FieldIndex = 0 then
      SetListPos(Providername)
    else
      SetListPos(Principal);
    List.SetFocus;
    List.ItemIndex := 0;
  end;
begin
  inherited;
  if (Key = VK_Next)and(Sender is TEdit)  then
  begin
    case TEdit(Sender).Tag of
      0: begin
           SelectTable('tb_providerinfo',0);
           List.Tag := 0;
         end;
      1: begin
           SelectTable('tb_employeeinfo',1);
           List.Tag := 1;
         end;
    end;
  end
  else if Key = vk_Return then
  begin
    if Sender is TEdit then
    begin
      if Trim(TEdit(Sender).Text)='' then
      begin
        Application.MessageBox('信息不能为空.','提示',64);
        Exit;
      end;
      case TEdit(Sender).Tag of
        0: begin
             if SelectTableInfo('tb_providerinfo','providername',Providername.Text)= False then
             begin
               Application.MessageBox('该供应商不存在,如果是新的供应商,请先建立供应商档案.','提示',64);
               Providername.SelectAll;
               Exit;
             end;
           end;
        1: begin
             if SelectTableInfo('tb_employeeinfo','workername',principal.Text)= False then
             begin
               Application.MessageBox('该负责人不存在,请重新输入.','提示',64);
               principal.SelectAll;
               Exit;
             end;
           end;
      end;
    end;
    FindNext(True); //使下一个控件获得焦点
  end;
end;

//自定义函数,根据表名\字段名\字段值查询信息,如果有数据返回,返回值为True,否则为False
function Tf_instore.SelectTableinfo(TableName, FieldName: String;
  Value: Variant): Boolean;
begin
  Result := False;
  with t_data.Query1 do
  begin
    CLose;
    SQL.Clear;
    SQL.Add('select * from '+ TableName+' where '+ FieldName+' = :Value');
    Parameters.ParamByName('Value').Value := Value;
    Open;
  end;
  if t_data.Query1.RecordCount>0 then
    Result := True;
end;

procedure Tf_instore.DateKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
    Reginfo.SetFocus;
end;
//防止输入非法字符,只允许输入数字
procedure Tf_instore.RebateKeyPress(Sender: TObject; var Key: Char);
begin
  inherited;
  if Sender is TEdit then
  begin
    if  not (Key in ['0'..'9','.',#8]) then
      Key := #0;
    if key = '.' then
      if Pos('.',Trim(TEdit(Sender).Text)) <>0 then
        Key := #0;
  end;
end;
//处理窗体显示时的事件
procedure Tf_instore.FormShow(Sender: TObject);
begin
  inherited;
  with Reginfo do
  begin
    //设置字段名称
    Cells[barcode,0]:='条形码';
    Cells[storename,0]:= '物资名称';
    Cells[basicunit,0]:='基本单位';
    Cells[stockunit,0]:= '采购单位';
    Cells[convertions,0]:= '换算关系';
    Cells[unitprice,0]:= '单价';
    Cells[num,0]:='数量';
    Cells[money,0]:= '金额';
    Cells[storagename,0]:='仓库名称';
  end;
  with t_data.Query1 do  //查询仓库名称,将其添加到组合框中
  begin
    CLose;
    SQL.Clear;
    SQL.Add('select storagename from tb_storageinfo');
    Open;
  end;
  if t_data.Query1.RecordCount>0 then
  begin
    while not t_data.Query1.Eof do
    begin
      Comstorage.Items.Add(Trim(t_data.Query1.FieldByName('storagename').AsString));
      t_data.Query1.Next;
    end;
    Comstorage.ItemIndex := 0;
  end;
  Cancel.Click;
end;

procedure Tf_instore.RebateKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
    FindNext(True);
end;

procedure Tf_instore.ReginfoSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  inherited;
  row := ARow;
  col := ACol;
  //当物资名称为空时可以编辑条形码,当条形码为空时可以编辑物资名称,当条形码不为空时可以编辑单价、数量
  if (col = barcode)and(Trim(Reginfo.Cells[storename,row])='')or(col = storename)and(Trim(Reginfo.Cells[barcode,row])='')or
    (col = unitprice)and(Trim(Reginfo.Cells[barcode,row])<>'')or(col = num)and(Trim(Reginfo.Cells[barcode,row])<>'')or
    (col = convertions)and(Trim(Reginfo.Cells[barcode,row])<>'')then
    Reginfo.Options := Reginfo.Options + [goEditing]
  else
    Reginfo.Options := Reginfo.Options - [goEditing];
end;
//自定义函数,判断当前行数据是否为空
function Tf_instore.CurrentIsNull: Boolean;
var
  i: integer;
begin
  Result := False;
  For i := 0 to Reginfo.ColCount-1 do
    if Trim(Reginfo.Cells[i,Row])= '' then
    begin
      Result := True;
      Break;
    end;
end;
//处理表格的OnKeyDown事件,在表格中按Ctrl键,将使下一行获得焦点,如果辅助录入表格可见时,按
//Shift键将使其获得焦点,在表格中按Insert键将添加新行,按Delete键删除行,按回车键将使下一
//个单元格获得焦点
procedure Tf_instore.ReginfoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  x,y: Integer;//记录单元格索引
  CellRect: TRect; //记录组合框出现的位置
begin
  inherited;
  Reg := False;
  if Key = VK_CONTROL then
  begin
    if row<>Reginfo.RowCount-1 then
    begin
      Reginfo.Row := Row+1;
      Reginfo.Col := 0;
      Reginfo.SetFocus;
    end;
  end;
  if (Key = vk_Shift)and(Grid.Visible = True) then
  begin
    Reg := True;
    Grid.SetFocus;
    Exit;
  end;
  //按insert键,如果当前行不为空,并且当前行是最后一行,将添加新行
  if (Key = vk_Insert)and(CurrentIsNull = False)and(Row = Reginfo.RowCount-1) then
  begin
    Reginfo.RowCount := Reginfo.RowCount+1;
    Reginfo.Row := Reginfo.Row+1;
    Reginfo.Col := Barcode;
  end
  //按Delete键将删除行
  else if Key = vk_Delete then
  begin
    if Application.MessageBox('确实要删除当前行吗.','提示',mb_YesNo)= ID_Yes then
    begin
      Reg := True;
      ClearCurRow;
      if Reginfo.RowCount>2 then
      begin
        if row<>Reginfo.RowCount-1 then
        begin
          For x := row+1to (Reginfo.RowCount-1) do
            For y:=0 to Reginfo.ColCount-1 do
              Reginfo.Cells[y,x-1]:= Reginfo.Cells[y,x];
        end;
        ClearEndRow;
        Reginfo.RowCount := Reginfo.RowCount-1;
      end;
      Reginfo.Col := 0;
      Stocktotal.Text := FloatToStr(Calculatemoney);
    end;
  end
  else if Key = vk_Return then
  begin
    reg := True;
    Grid.Visible := False;
    if (Trim(Reginfo.Cells[barcode,row])<>'')and(Trim(Reginfo.Cells[storename,row])='') then
    begin
      with t_data.Query1 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select * from tb_storeinfo where barcode = :barcode');
        Parameters.ParamByName('barcode').Value := Trim(Reginfo.Cells[barcode,row]);
        Open;
      end;
      if t_data.Query1.RecordCount>0 then
      begin
        with t_data.Query1 do
        begin
          Reginfo.Cells[storename,row]:= Trim(FieldByName('storename').AsString);
          Reginfo.Cells[basicunit,row]:= Trim(FieldByName('basicunit').AsString);
          Reginfo.Cells[stockunit,row]:= Trim(FieldByName('stockunit').AsString);
          Reginfo.Cells[convertions,row]:= (FieldByName('conversion').AsString);
          Reginfo.Cells[unitprice,row]:= Trim(FieldByName('defaultprice').AsString);
        end;
      end
      else
      begin
        Reginfo.Cells[barcode,row]:= '';
        Application.MessageBox('该条形码不存在.','提示',64);
        Exit;
      end;
    end
    else if (Trim(Reginfo.Cells[storename,row])<>'')and(Trim(Reginfo.Cells[barcode,row])='') then
    begin
      with t_data.Query1 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select * from tb_storeinfo where storename = :storename or nameshort = :nameshort');
        Parameters.ParamByName('storename').Value := Trim(Reginfo.Cells[storename,row]);
        Parameters.ParamByName('nameshort').Value := Trim(Reginfo.Cells[storename,row]);
        Open;
      end;
      if t_data.Query1.RecordCount>0 then
      begin
        with t_data.Query1 do
        begin
          Reginfo.Cells[barcode,row]:= Trim(FieldByName('barcode').AsString);
          Reginfo.Cells[storename,row]:= Trim(FieldByName('storename').AsString);
          Reginfo.Cells[basicunit,row]:= Trim(FieldByName('basicunit').AsString);
          Reginfo.Cells[stockunit,row]:= Trim(FieldByName('stockunit').AsString);
          Reginfo.Cells[convertions,row]:= FloatToStr(FieldByName('conversion').AsCurrency);
          Reginfo.Cells[unitprice,row]:= Trim(FieldByName('Defaultprice').AsString);
        end;
      end
      else
      begin
        Application.MessageBox('该物资不存在,请重新输入.','提示',64);
        Reginfo.Cells[storename,row]:='';
      end;
    end;
    if (Col = storagename )and(Comstorage.Visible = False) then
    begin
      CellRect := Reginfo.CellRect(storagename,row);
      CellRect.Left := CellRect.Left+Reginfo.Left;
      CellRect.Top := CellRect.Top+Reginfo.Top;