⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 storescrap.pas

📁 物流管理系统是一个典型的数据库应用程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:

unit storescrap;

interface

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

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

var
  f_storescrap: Tf_storescrap;
  row: Integer = 1; //记录当前单元格横坐标
  col: integer = 0;//记录当前单元格纵坐标
  Reg: Boolean= False; //在表格中输入登记信息时,防止再次触发列表的OnSetEditText事件
const
  storename = 0;
  num = 1;
  scrapmoney = 2;
  memo = 3;
implementation
  uses  data,main;
{$R *.dfm}
//处理编辑框的OnKeyDown事件,用户按Page键,将以列表形式显示相关信息,供用户选择
//按回车键检查用户信息是否合法
procedure Tf_storescrap.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);
    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_employeeinfo',1,0);
           List.Tag := 0;
         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;
      end;
    end;
    FindNext(True); //使下一个控件获得焦点
  end;
end;
//自定义函数,根据表名\字段名\字段值查询数据,如果有数据返回,函数返回值为True,否则
//为False
function Tf_storescrap.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_storescrap.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_storescrap.ListExit(Sender: TObject);
begin
  inherited;
  List.Visible := False;
end;
//处理列表的OnKeyDown事件,按回车键将列表中当前文本显示在编辑框中
procedure Tf_storescrap.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;
    end;
    List.Visible := False;
  end;
end;
//双击列表,将模拟其OnKeyDown事件
procedure Tf_storescrap.ListDblClick(Sender: TObject);
var
  Key: Word;
begin
  inherited;
  Key:= vk_ReTurn;
  List.OnKeyDown(nil,Key,[ssLeft]);
end;

procedure Tf_storescrap.DateKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
    Reginfo.SetFocus;
end;
//联想录入表格失去焦点时不可见
procedure Tf_storescrap.GridExit(Sender: TObject);
begin
  inherited;
  Grid.Visible := False;
end;
//双击联想录入表格,将物资名称显示在录入表格中
procedure Tf_storescrap.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;
//在联想录入表格中按回车键将模拟OnDblClick事件
procedure Tf_storescrap.GridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
    Grid.OnDblClick(Sender);
end;
//在窗体显示时设置字段名称,调用取消按钮单击事件代码进行初始化
procedure Tf_storescrap.FormShow(Sender: TObject);
begin
  inherited;
  with Reginfo do
  begin
    Cells[storename,0]:='物资名称';
    Cells[num,0]:='数量';
    Cells[scrapmoney,0]:= '金额';
    Cells[memo,0]:= '备注';
  end;
  Cancel.Click; //调用取消按钮的单击事件代码
end;
//防止在录入表格的数量和金额字段输入非法数据,只允许输入数字
procedure Tf_storescrap.ReginfoKeyPress(Sender: TObject; var Key: Char);
begin
  inherited;
  if (col = num)or(col = scrapmoney) then
  begin
    if not (Key in ['0'..'9','.',#8]) then
      Key := #0
  end;
end;
//处理录入表格的OnSelectCell事件,记录当前单元格坐标
procedure Tf_storescrap.ReginfoSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  inherited;
  row := ARow;
  col := ACol;
end;
//处理录入表格的OnKeyDown事件,按Ctrl键将使下一行获得焦点,按Shift键将使联想录入表格
//获得焦点,按Insert键能够添加新行,按Delete键将删除当前行,按回车键能够检测录入信息是否合法,
//控制单元格焦点的移动
procedure Tf_storescrap.ReginfoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  x,y: Integer;
begin
  inherited;
  Reg := False;
  if Key = VK_CONTROL then //按Ctrl键,如果表格当前行没有处于最后一行,将使下一行获得焦点
  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 //按Shift键,如果联想录入表格可见,将使其获得焦点
  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 := storename;
  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  //如果行数>2,利用循环方式将下一行数据上移,并删除最后一行
      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; //删除最后一行

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -