checklose.pas

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

unit checklose;

interface

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

type
  Tf_checklose = class(Tf_frame)
    Label1: TLabel;
    Reginfo: TStringGrid;
    Panel2: TPanel;
    Label3: TLabel;
    Servicemanaa: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    Date: TDateTimePicker;
    List: TListBox;
    Grid: TDBGrid;
    Panel1: TPanel;
    Label2: TLabel;
    Label9: TLabel;
    Save: TBitBtn;
    Cancel: TBitBtn;
    Quit: TBitBtn;
    RegSource: TDataSource;
    principal: TEdit;
    Storagename: TEdit;
    Operator: TEdit;
    Stocktotal: TEdit;
    Memo: TEdit;
    procedure principalEnter(Sender: TObject); virtual;
    procedure principalKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);virtual;
    procedure ListExit(Sender: TObject); virtual;
    procedure ListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState); virtual;
    procedure ListDblClick(Sender: TObject); virtual;
    procedure FormCreate(Sender: TObject);virtual;
    procedure FormShow(Sender: TObject); virtual;
    procedure GridExit(Sender: TObject); virtual;
    procedure GridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);virtual;
    procedure GridDblClick(Sender: TObject); virtual;
    procedure DateKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ReginfoKeyPress(Sender: TObject; var Key: Char);  virtual;
    procedure ReginfoSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean); virtual;
    procedure ReginfoSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);  virtual;
    procedure ReginfoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState); virtual;
    procedure SaveClick(Sender: TObject); virtual;
    procedure CancelClick(Sender: TObject);virtual;
    procedure QuitClick(Sender: TObject); virtual;
  private
    { Private declarations }
  public
    storename,num,paymoney: Integer;
    row: Integer ; //记录当前单元格横坐标
    col: integer ;//记录当前单元格纵坐标
    Procedure SetListPos(Control: TControl);virtual; //设置列表出现的位置
    Function SelectTableinfo(TableName: String;FieldName: String;Value: Variant):Boolean;virtual;//有数据返回,返回指为True
    Function CalculateMoney: Real;virtual;//统计金额
    Function CurrentIsNull: Boolean;virtual;//判断表格当前行是否为空
    Procedure ClearCurRow;virtual;//清空当前行
    Procedure ClearEndRow;virtual;//清空最后一行
    Function EditIsNull: Boolean;virtual;//判断编辑框文本是否为空
    Function EndRowIsNull: Boolean;virtual;//判断表格最后一行是否为空
    Function GridIsNull: Boolean;virtual;//判断表格信息是否为空
    Procedure ClearEdit;virtual;//清空编辑框中的文本
    Procedure IniGrid;virtual;//初试化表格
    { Public declarations }
  end;

var
  f_checklose: Tf_checklose;

  Reg: Boolean= False; //在表格中输入登记信息时,防止再次触发列表的OnSetEditText事件
implementation
  uses data, main;
{$R *.dfm}
//当编辑框获得焦点时,TDBGrid组件不可见
procedure Tf_checklose.principalEnter(Sender: TObject);
begin
  inherited;
  Grid.Visible := False;
end;
//处理编辑框的OnKeyDown事件,
procedure Tf_checklose.principalKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
  procedure SelectTable(TableName: String;FieldIndex,Tag: 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 tag = 0 then
      SetListPos(Principal) //自定义过程,用于设置列表出现的位置
    else
      SetListPos(Storagename);
    List.SetFocus;
    List.ItemIndex := 0;
  end;
begin
  inherited;
  //在编辑框中按PageDown键将显示列表框
  if (Key = VK_Next)and(Sender is TEdit)  then
  begin
    case TEdit(Sender).Tag of
      0: begin
           SelectTable('tb_employeeinfo',1,0);
           List.Tag := 0;
         end;
      1: begin
           SelectTable('tb_storageinfo',0,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_employeeinfo','workername',Principal.Text)= False then
             begin
               Application.MessageBox('该负责人不存在,请重新输入.','提示',64);
               Principal.SelectAll;
               Exit;
             end;
           end;
        1: begin
             if SelectTableInfo('tb_storageinfo','storagename',Storagename.Text)= False then
             begin
               Application.MessageBox('该仓库名称不存在,请重新输入.','提示',64);
               Storagename.SelectAll;
               Exit;
             end;
           end;
      end;
    end;
    FindNext(True);
  end;
end;
//列表框失去焦点时不可见
procedure Tf_checklose.ListExit(Sender: TObject);
begin
  inherited;
  List.Visible := False;
end;

procedure Tf_checklose.ListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
  begin
    case List.Tag of
      0: begin
           Principal.Text := List.Items[List.ItemIndex];
           Principal.OnKeyDown(Principal,Key,shift);
           Principal.SetFocus;
         end;
      1: begin
           Storagename.Text := List.Items[List.ItemIndex];
           Storagename.SetFocus;
         end;
    end;
    List.Visible := False;
  end;
end;

procedure Tf_checklose.ListDblClick(Sender: TObject);
var
  Key: Word;
begin
  inherited;
  Key:= vk_ReTurn;
  List.OnKeyDown(nil,Key,[ssLeft]);
end;
//自定义过程用于设置列表框位置
procedure Tf_checklose.SetListPos(Control: TControl);
begin
  List.Top := Control.Top+Control.Parent.Top;
  List.Left := Control.Left+Control.Width;
  List.Visible := True;
  List.SetFocus;
end;
//自定义函数,根据表名\字段名\字段值查询信息
function Tf_checklose.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_checklose.FormCreate(Sender: TObject);
begin
  inherited;
  row := 1;
  col := 0;
  storename := 0;
  num := 1;
  paymoney := 2;
end;

procedure Tf_checklose.FormShow(Sender: TObject);
begin
  inherited;
  with Reginfo do
  begin
    Cells[storename,0]:='物资名称';
    Cells[num,0]:='数量';
    Cells[paymoney,0]:= '赔偿金额';
  end;
  Cancel.Click;
end;

procedure Tf_checklose.GridExit(Sender: TObject);
begin
  inherited;
  Grid.Visible := False;
end;

procedure Tf_checklose.GridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
    Grid.OnDblClick(Sender);
end;

procedure Tf_checklose.GridDblClick(Sender: TObject);
begin
  inherited;
  with t_data.Query1 do
  begin
    Reginfo.Cells[storename,row]:= Trim(FieldByName('storename').AsString);
  end;
  Reginfo.SetFocus;
  Reginfo.Col := Reginfo.Col+1;
end;

procedure Tf_checklose.DateKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = Vk_Return then
    Reginfo.SetFocus;
end;
//防止输入非法字符,只允许输入数值
procedure Tf_checklose.ReginfoKeyPress(Sender: TObject; var Key: Char);
begin
  inherited;
  if (col = num)or(col = paymoney) then
  begin
    if not (Key in ['0'..'9','.',#8]) then
      Key := #0
  end;
end;

procedure Tf_checklose.ReginfoSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  inherited;
  //记录当前单元格坐标
  row := ARow;
  col := ACol;
end;
//处理表格编辑时的事件,实现联想录入,自动计算金额
procedure Tf_checklose.ReginfoSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
var
  CellRect: TRect;
begin
  inherited;
  if Reg = false then
  begin
    Grid.Visible := False;
    if (Acol = storename) then
    begin
      With t_data.Query1 do
      begin
        CLose;
        SQL.Clear;
        SQL.Add('select * from tb_storeinfo where storename Like :Storename or nameshort like :nameshort');
        Parameters.ParamByName('storename').Value := Trim(Reginfo.Cells[storename,ARow])+'%' ;
        Parameters.ParamByName('nameshort').Value := Trim(Reginfo.Cells[storename,ARow])+'%' ;
        Open;
      end;
      if t_data.Query1.RecordCount>0 then
      begin
        Regsource.DataSet := t_data.Query1;
        if not Grid.Visible then
        begin
          CellRect := Reginfo.CellRect(ACol,ARow);
          CellRect.Left := CellRect.Left+Reginfo.Left;
          CellRect.Right := CellRect.Right+ Reginfo.Left;
          CellRect.Top := Reginfo.Top+ CellRect.Top;
          Grid.Left := CellRect.Right+1;
          Grid.Top := CellRect.Top;
          Grid.Visible := True;
        end;
      end
      else
      begin
        RegSource.DataSet := Nil;