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

📄 unitxpth.pas

📁 这是一个很好的超市管理系统
💻 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 + -