📄 unitxpth.pas
字号:
unit UnitXPTH;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, StdCtrls, Buttons, ComCtrls, ExtCtrls, Mask,
DBCtrls;
type
TFrmXPTH = class(TForm)
DBGrid1: TDBGrid;
Edit1: TEdit;
Edit2: TEdit;
Panel1: TPanel;
DBGrid2: TDBGrid;
Panel2: TPanel;
GroupBox1: TGroupBox;
Edit3: TEdit;
DateTimePicker1: TDateTimePicker;
BitBtn1: TBitBtn;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Edit5: TEdit;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
BitBtn2: TBitBtn;
Label1: TLabel;
Label2: TLabel;
DateTimePicker2: TDateTimePicker;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Edit4: TEdit;
procedure CLS;
procedure DIS;
procedure ENA;
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmXPTH: TFrmXPTH;
implementation
uses UnitDM;
{$R *.dfm}
procedure TFrmXPTH.CLS;
begin
Edit1.Clear;
Edit2.Clear;
Edit4.Clear;
Edit5.Clear;
end;
procedure TFrmXPTH.DIS;
begin
Edit1.Enabled := false;
Edit1.Color := clLtGray;
Edit2.Enabled := false;
Edit2.Color := clLtGray;
Edit4.Enabled := false;
Edit4.Color := clLtGray;
Edit5.Enabled := false;
Edit5.Color := clLtGray;
end;
procedure TFrmXPTH.ENA;
begin
Edit1.Enabled := true;
Edit1.Color := clwindow;
Edit2.Enabled := true;
Edit2.Color := clwindow;
Edit4.Enabled := true;
Edit4.Color := clwindow;
Edit5.Enabled := true;
Edit5.Color := clwindow;
end;
procedure TFrmXPTH.RadioButton1Click(Sender: TObject);
begin
RadioButton2.Checked := false;
Edit3.Enabled := true;
DateTimePicker1.Enabled := false;
DateTimePicker2.Enabled := false;
end;
procedure TFrmXPTH.RadioButton2Click(Sender: TObject);
begin
RadioButton1.Checked := false;
DateTimePicker1.Enabled := true;
DateTimePicker2.Enabled := true;
Edit3.Enabled := false;
end;
procedure TFrmXPTH.BitBtn1Click(Sender: TObject);
var
str1, str2: string;
begin
str1 := 'select sell_id, sell_prod_id, sell_prod_name, sell_prod_price,'
+ ' sell_number, sell_time, sell_money from sell where sell_prod_id LIKE :id';
str2 := 'select sell_id, sell_prod_id, sell_prod_name, sell_prod_price,'
+ ' sell_number, sell_time, sell_money from sell where sell_time BETWEEN :time1 AND :time2';
if (RadioButton1.Checked) then
begin
with DM.ADOQTEMP3 do
begin
close;
SQL.Clear;
SQL.Add(str1);
parameters.ParamByName('id').Value := trim(Edit3.Text);
if (not prepared) then
prepared := true;
try
//try
open;
//finally
//close;
//open;
//end;
except
ExecSQL;
end;
end;
end
else
begin
if (RadioButton2.Checked) then
begin
with DM.ADOQTEMP3 do
begin
close;
SQL.clear;
SQL.add(str2);
//parameters.ParamByName('time').Value := Datetimepicker1.DateTime;
parameters.ParamByName('time1').Value := Datetimepicker1.DateTime;
parameters.ParamByName('time2').Value := Datetimepicker2.DateTime;
if (not prepared) then
prepared := true;
try
open;
except
ExecSQL;
end;
end;
end;
end;
end;
procedure TFrmXPTH.BitBtn2Click(Sender: TObject);
begin
self.Close;
end;
procedure TFrmXPTH.Button1Click(Sender: TObject);
var
str1, str2, str3, ids: string;
stocks: integer;
begin
str1 := 'select * from prod where prod_id LIKE :id';
str2 := 'insert into back (back_prod_id, operator_id, back_prod_name, back_prod_price, back_prod_number, back_memo) '
+ ' values (:id, :op_id, :name, :price, :number, :memo)';
str3 := 'update prod set prod_stock = :stock, prod_sale = :sale where prod_id LIKE :id';
if (Button1.Caption = '提交') then
begin
stocks := strtoint(Edit4.Text);
ids := trim(Edit1.Text);
with DM.ADOQTEMP1 do
begin
close;
SQL.Clear;
SQL.Add(str1);
parameters.ParamByName('id').Value := trim(Edit1.Text);
if (not prepared) then
prepared := true;
try
open;
except
ExecSQL;
end;
end;
//插入一条退货记录
with DM.ADOQTEMP2 do
begin
close;
SQL.Clear;
SQL.Add(str2);
parameters.ParamByName('id').Value := trim(Edit1.Text);
parameters.ParamByName('op_id').Value := 0;
parameters.ParamByName('name').Value := DM.ADOQTEMP1.fieldbyname('prod_name').AsString;
parameters.ParamByName('price').Value := strtofloat(Edit2.Text);
parameters.ParamByName('number').Value := strtoint(Edit4.Text);
parameters.ParamByName('memo').Value := trim(Edit5.Text);
if (not prepared) then
prepared := true;
try
ExecSQL;
except
Button1.Caption := '添加';
showmessage('操作失败,请再试!');
close;
button2.Enabled := true;
button3.Enabled := true;
CLS;
exit;
end;
end;
DIS;
CLS;
DM.ADOQTEMP4.Close;
DM.ADOQTEMP4.Open;
//修改库存数量
with DM.ADOQTEMP2 do
begin
close;
SQL.Clear;
SQL.Add(str3);
parameters.ParamByName('stock').Value := DM.ADOQTEMP1.fieldbyname('prod_stock').Value + stocks;
parameters.ParamByName('sale').Value := DM.ADOQTEMP1.fieldbyname('prod_sale').Value - stocks;
parameters.ParamByName('id').Value := ids;//这一步一定要设ids这个变量,否则如果用trim(Edit1.text)就会不正常
if (not prepared) then
prepared := true;
try
execSQL;
except
button1.caption := '添加';
showmessage('发生错误,请把刚才的退货记录删除掉!');
close;
button2.Enabled := true;
button3.Enabled := true;
exit;
end;
button1.Caption := '添加';
end;
end
else
begin
ENA;
Button1.Caption := '提交';
CLS;
Edit1.SetFocus;
button2.Enabled := false;
button3.Enabled := false;
end;
end;
procedure TFrmXPTH.Button2Click(Sender: TObject);
var
str1, str2, str3: string;
numbers: integer;
begin
str1 := 'delete from back where back_id = :id';
str2 := 'select * from prod where prod_id LIKE :id';
str3 := 'update prod set prod_stock = :stock, prod_sale = :sale where prod_id LIKE :id';
with DM.ADOQTEMP1 do
begin
close;
SQL.Clear;
SQL.Add(str1);
parameters.ParamByName('id').Value := DM.ADOQTEMP4.fieldbyname('back_id').AsString;
if (not prepared) then
prepared := true;
try
ExecSQL;
except
showmessage('操作失败,请再试!');
close;
exit;
end;
end;
DM.ADOQTEMP4.Close;
DM.ADOQTEMP4.Open;
with DM.ADOQTEMP2 do
begin
close;
SQL.Clear;
SQL.Add(str2);
parameters.ParamByName('id').Value := DM.ADOQTEMP4.fieldbyname('back_prod_id').AsString;
if (not prepared) then
prepared := true;
try
open;
except
ExecSQL;
end;
numbers := DM.ADOQTEMP4.fieldbyname('back_prod_number').AsInteger;
end;
with DM.ADOQTEMP1 do
begin
close;
SQL.Clear;
SQL.Add(str3);
parameters.ParamByName('stock').Value := DM.ADOQTEMP2.fieldbyname('prod_stock').AsInteger - numbers;
parameters.ParamByName('sale').Value := DM.ADOQTEMP2.fieldbyname('prod_sale').AsInteger + numbers;
parameters.ParamByName('id').Value := DM.ADOQTEMP4.fieldbyname('back_prod_id').Value;
if (not prepared) then
prepared := true;
try
ExecSQL;
except
showmessage('发生错误,请把刚才的退货记录再添加回去!');
close;
exit;
end;
end;
end;
procedure TFrmXPTH.Button3Click(Sender: TObject);
var
str1, str2, str3, ids: string;
numbers, num: integer;
begin
if (Button3.Caption = '提交') then
begin
num := strtoint(Edit4.Text);
ids := trim(Edit1.Text);
str1 := 'update back set back_prod_price = :price, back_prod_number = :number, back_memo = :memo where back_id = :id ';
str2 := 'select * from prod where prod_id LIKE :id';
str3 := 'update prod set prod_stock = :stock, prod_sale = :sale where prod_id LIKE :id ';
numbers := DM.ADOQTEMP4.fieldbyname('back_prod_number').AsInteger;
with DM.ADOQTEMP1 do
begin
close;
SQL.Clear;
SQL.Add(str1);
parameters.ParamByName('price').Value := strtofloat(Edit2.Text);
parameters.ParamByName('number').Value := strtoint(Edit4.Text);
parameters.ParamByName('memo').Value := trim(Edit5.Text);
parameters.ParamByName('id').Value := DM.ADOQTEMP4.fieldbyname('back_id').Value;
if (not prepared) then
prepared := true;
try
ExecSQL;
except
showmessage('操作失败,请再试!');
Button3.Caption := '修改';
exit;
end;
end;
DIS;
CLS;
DM.ADOQTEMP4.Close;
DM.ADOQTEMP4.Open;
with DM.ADOQTEMP2 do
begin
close;
SQL.Clear;
SQL.Add(str2);
parameters.ParamByName('id').Value := DM.ADOQTEMP4.fieldbyname('back_prod_id').AsString;
if (not prepared) then
prepared := true;
try
open;
except
ExecSQL;
end;
end;
with DM.ADOQTEMP1 do
begin
close;
SQL.Clear;
SQL.Add(str3);
parameters.ParamByName('stock').Value := DM.ADOQTEMP2.fieldbyname('prod_stock').Value - numbers + num;
parameters.ParamByName('sale').Value := DM.ADOQTEMP2.fieldbyname('prod_sale').Value + numbers - num;
parameters.ParamByName('id').Value := ids;
if (not prepared) then
prepared := true;
try
ExecSQL;
except
showmessage('发生错误,请把刚才修改过的退货记录改回原样!');
button3.Caption := '修改';
exit;
end;
end;
end
else
begin
ENA;
Edit1.ReadOnly := true;
button3.Caption := '提交';
CLS;
button1.Enabled := false;
button2.Enabled := false;
with DM.ADOQTEMP4 do
begin
Edit1.Text := fieldbyname('back_prod_id').AsString;
Edit1.readonly := true;
Edit2.Text := fieldbyname('back_prod_price').AsString;
Edit4.Text := fieldbyname('back_prod_number').AsString;
Edit5.Text := fieldbyname('back_memo').AsString;
end;
end;
end;
procedure TFrmXPTH.Button4Click(Sender: TObject);
begin
if (button1.Caption = '提交') then
button1.Caption := '添加';
if (button3.Caption = '提交') then
button3.Caption := '修改';
CLS;
DIS;
button1.Enabled := true;
button2.Enabled := true;
button3.Enabled := true;
end;
procedure TFrmXPTH.FormShow(Sender: TObject);
begin
DIS;
DM.ADOQTEMP4.Close;
DM.ADOQTEMP4.Open;
Edit3.Enabled := false;
DateTimePicker1.Enabled := false;
DateTimePicker2.Enabled := false;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -