📄 providercheck.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 + -