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

📄 providercheck.pas

📁 物流管理系统是一个典型的数据库应用程序
💻 PAS
字号:

unit providercheck;

interface

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

type
  Tf_providercheck = class(Tf_frame)
    Label1: TLabel;
    Grid: TDBGrid;
    Panel2: TPanel;
    Cancel: TBitBtn;
    Quit: TBitBtn;
    Panel3: TPanel;
    Label5: TLabel;
    Provider: TComboBox;
    Query: TBitBtn;
    Label6: TLabel;
    Date: TDateTimePicker;
    Panel1: TPanel;
    Label7: TLabel;
    Label8: TLabel;
    Label3: TLabel;
    Check: TBitBtn;
    Label2: TLabel;
    Source1: TDataSource;
    List: TListBox;
    Checkman: TEdit;
    Paymoney: TEdit;
    Factmoney: TEdit;
    Memo: TEdit;
    procedure CheckmanKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListExit(Sender: TObject);
    procedure ListDblClick(Sender: TObject);
    procedure ListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CancelClick(Sender: TObject);
    procedure DateKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PaymoneyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FactmoneyKeyPress(Sender: TObject; var Key: Char);
    procedure QueryClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ProviderKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure QuitClick(Sender: TObject);
    procedure CheckClick(Sender: TObject);
    procedure GridCellClick(Column: TColumn);
  private
    { Private declarations }
  public
    Procedure SetListPos(Control: TControl); //设置列表出现的位置
    Function SelectTableinfo(TableName: String;FieldName: String;Value: Variant):Boolean;//有数据返回,返回指为True
    Procedure ClearEdit;//清空编辑框中的文本
    Procedure AddProvider;//向组合框中添加供应商
    Function InfoIsNull: Boolean;  //判断信息是否为空
    { Public declarations }
  end;

var
  f_providercheck: Tf_providercheck;

implementation
  uses data;
{$R *.dfm}
//在结款人编辑框中按PageDown键将以列表形式显示结款人信息,按回车键将检查结款人是否合法
procedure Tf_providercheck.CheckmanKeyDown(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;
    SetListPos(Checkman); //设置列表框出现的位置
    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);
         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',Checkman.Text)= False then
             begin
               Application.MessageBox('该负责人不存在,请重新输入.','提示',64);
               Checkman.SelectAll;
               Exit;
             end;
           end;
      end;
    end;
    FindNext(True);
  end;
end;
//自定义函数,根据表名\字段名\字段值查询数据,如果有数据返回,函数返回值为True,否则为False
function Tf_providercheck.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_providercheck.SetListPos(Control: TControl);
begin
  List.Top := Control.Top;
  List.Left := Control.Left+Control.Width;
  List.Visible := True;
  List.SetFocus
end;
//列表框失去焦点时不可见
procedure Tf_providercheck.ListExit(Sender: TObject);
begin
  inherited;
  List.Visible := False;
end;
//双击列表框,调用列表框的OnKeyDown事件
procedure Tf_providercheck.ListDblClick(Sender: TObject);
var
  Key: Word;
begin
  inherited;
  Key:= vk_ReTurn;
  List.OnKeyDown(nil,Key,[ssLeft]);
end;
//处理列表框的OnKeyDown事件,将列表框当前信息显示在编辑框中
procedure Tf_providercheck.ListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
  begin
    Checkman.Text := List.Items[List.ItemIndex];
    Checkman.OnKeyDown(Checkman,Key,shift);
    Checkman.SetFocus;
    List.Visible := False;
  end;
end;
//自定义过程,用于清空编辑框中的文本
procedure Tf_providercheck.ClearEdit;
var
  i: Integer;
begin
  For i := 0 to Panel1.ControlCount-1 do
    if Panel1.Controls[i]is TEdit then
      TEdit(Panel1.Controls[i]).Clear;
  Memo.Text := '无';
  Checkman.Clear;
end;
//处理取消按钮的单击事件
procedure Tf_providercheck.CancelClick(Sender: TObject);
begin
  inherited;
  ClearEdit; //青空编辑框文本
  AddProvider; //向组合框中添加供应商
  Source1.DataSet := Nil;
  Date.DateTime := Now;//重新设置时间
end;
//自定义过程,用于向组合框中添加供应商
procedure Tf_providercheck.AddProvider;
begin
  Provider.Clear;
  With t_data.Query1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select providername from tb_providerinfo');
    Open;
  end;
  if t_data.Query1.RecordCount>0 then
  begin
    while not t_data.Query1.Eof do //利用循环方式向组合框中添加数据
    begin
      Provider.Items.Add(Trim(t_data.Query1.Fields[0].Value));
      t_data.Query1.Next;
    end;
  end;
end;

procedure Tf_providercheck.DateKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
    Provider.SetFocus;
end;

procedure Tf_providercheck.PaymoneyKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
    FindNext(True);
end;
//防止输入非法数据,只允许输入数字
procedure Tf_providercheck.FactmoneyKeyPress(Sender: TObject;
  var Key: Char);
begin
  inherited;
  if not (Key in ['0'..'9',#8,'.'])then
    Key := #0
  else if (Key = '.')and(Pos('.',Trim(Factmoney.Text))<>0) then
    Key := #0;
end;
//处理查询按钮的单击事件,查询与供应商的账目关系
procedure Tf_providercheck.QueryClick(Sender: TObject);
begin
  inherited;
  if Trim(Provider.Text)<>'' then
  begin
    With t_data.Query2 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select * from tb_providerpayment where providername = :providername');
      Parameters.ParamByName('providername').Value := Trim(Provider.Text);
      Open;
    end;
    if t_data.Query2.RecordCount>0 then
    begin
      Source1.DataSet := t_data.Query2;
      Check.Enabled := True;
      Paymoney.Text := Trim(t_data.Query2.FieldByName('Paymoney').AsString);
    end
    else
    begin
      t_data.Query2.Close;
      Paymoney.Clear;
      Source1.DataSet := Nil;
      Check.Enabled := False;
    end;
  end;
end;

procedure Tf_providercheck.FormShow(Sender: TObject);
begin
  inherited;
  Cancel.Click;
end;

procedure Tf_providercheck.ProviderKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = vk_Return then
    Query.Click;
end;

procedure Tf_providercheck.QuitClick(Sender: TObject);
begin
  inherited;
  Close;
end;
//处理结款按钮的单击事件
procedure Tf_providercheck.CheckClick(Sender: TObject);
var
  Connect1: TADOConnection;
  Query,Query1: TADOQuery;
begin
  inherited;
  Connect1 := Nil;
  Query := Nil;
  Query1 := Nil;
  if InfoIsNull = True then //判断结款信息是否为空
  begin
    Application.MessageBox('信息不能为空.','提示',64);
    Exit;
  end;
  Try
    Try
      //动态创建TADOConnection组件,用于进行事务控制
      Connect1 := TADOConnection.Create(Nil);
      Connect1.ConnectionString := t_data.Connection1.ConnectionString;
      Connect1.LoginPrompt := False;
      Connect1.Connected := True;
      Query := TADOQuery.Create(Nil);
      Query1 := TADOQuery.Create(Nil);
      Query1.Connection := Connect1;
      Query.Connection := Connect1;
      Connect1.BeginTrans;
      With Query do
      begin
        CLose;
        SQL.Clear;
        //调用存储过程生成结款票号,保存结款信息
        SQL.Add('Exec Add_providercheck  :providername,:paymoney,:checkman,:date ,:memo,:checkid output');
        Parameters.ParamByName('providername').Value := Trim(provider.Text);
        Parameters.ParamByName('paymoney').Value := Trim(Factmoney.Text);
        Parameters.ParamByName('checkman').Value := Trim(Checkman.Text);
        Parameters.ParamByName('date').Value := Trunc(Date.DateTime);
        Parameters.ParamByName('memo').Value := Trim(Memo.Text);
        Parameters.ParamByName('checkid').Value := 'temporary';
        ExecSQL;
      end;
      With Query1 do
      begin
        Close;
        SQL.Clear;
        //更改与供应商的账目
        SQL.Add('update tb_providerpayment set paymoney = Paymoney- :money where providername = :provider');
        Parameters.ParamByName('money').Value := StrToFloat(FactMoney.Text);
        Parameters.ParamByName('provider').Value := Trim(Trim(t_data.Query2.FieldByName('Providername').AsString));
        ExecSQL;
      end;
      Connect1.CommitTrans; //提交事务
      Application.MessageBox(PChar('操作成功,票号为: '+ Trim(Query.Parameters.ParamByName('checkid').Value)),'提示',64);
      Cancel.Click;
    Except
      Connect1.RollbackTrans; //出现异常则回滚事务
      Application.MessageBox('系统出错.','提示',64);
    End;
  Finally
    Query.Free;
    Query1.Free;
    Connect1.Free;
  End;
end;

procedure Tf_providercheck.GridCellClick(Column: TColumn);
begin
  inherited;
  if t_data.Query2.Active then
  begin
    Paymoney.Text := Trim(t_data.Query2.FieldByName('Paymoney').AsString);
  end
  else
    Paymoney.Clear;
end;
//自定义函数判断结款信息是否为空,如果为空返回值为True,否则为False
function Tf_providercheck.InfoIsNull: Boolean;
var
  i: Integer;
begin
  Result := False;
  if Trim(Checkman.Text)='' then
  begin
    Result := True;
    Exit;
  end;
  For i := 0 to Panel1.ControlCount-1 do
    if Panel1.Controls[i]is TEdit then
      if Trim(TEdit(Panel1.Controls[i]).Text)='' then
      begin
        Result := True;
        Exit
      end;
end;

end.

⌨️ 快捷键说明

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