xschd1.pas

思微POS连锁超市管理系统 (商业代码),几年前的东西了

unit xschd1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, Db, ADODB, dxLayout, wwSpeedButton, wwDBNavigator, wwclearpanel,
  StdCtrls, Buttons, EHGrids, DBGridEh, dxExEdtr, dxEdLib, dxDBELib,
  dxExGrEd, dxExELib, dxCntner, dxEditor, ExtCtrls, DBCtrls;

type
  Txschd = class(TForm)
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    Panel1: TPanel;
    Panel2: TPanel;
    Label7: TLabel;
    Ed7: TdxDBEdit;
    ADOTable3: TADOTable;
    ADOTable3code: TStringField;
    ADOTable3name: TStringField;
    ADOTable4: TADOTable;
    StringField1: TStringField;
    StringField2: TStringField;
    dxDBGridLayoutList1: TdxDBGridLayoutList;
    dxDBGridLayoutList1Item1: TdxDBGridLayout;
    DataSource3: TDataSource;
    DataSource4: TDataSource;
    ADOTable3dq: TStringField;
    ADOTable3lxr: TStringField;
    ADOTable3lxdh: TStringField;
    ADOTable3cz: TStringField;
    ADOTable3lxdz: TStringField;
    ADOTable4bm: TStringField;
    ADOTable4xb: TStringField;
    ADOTable4csrq: TDateTimeField;
    ADOTable4dh: TStringField;
    ADOTable4zz: TStringField;
    dxDBGridLayoutList1Item2: TdxDBGridLayout;
    DBGridEh1: TDBGridEh;
    Query1: TADOQuery;
    ADOTable2: TADOTable;
    ADOTable2spcode: TStringField;
    ADOTable2spname: TStringField;
    ADOTable2jldw: TStringField;
    ADOTable2js: TBCDField;
    ADOTable2ss: TBCDField;
    ADOTable2sl: TBCDField;
    ADOTable2dj: TBCDField;
    ADOTable2sui: TBCDField;
    ADOTable2je: TBCDField;
    ADOTable2id: TAutoIncField;
    ADOTable2code: TStringField;
    ADOTable2bzgg: TBCDField;
    ADOTable1: TADOTable;
    ADOTable1code: TStringField;
    ADOTable1kdrq: TDateTimeField;
    ADOTable1kdr: TStringField;
    ADOTable1zje: TBCDField;
    ADOTable1ywy: TStringField;
    ADOTable1bz: TStringField;
    ADOTable1zt: TStringField;
    PopupMenu1: TPopupMenu;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    wwDBNavigator1: TwwDBNavigator;
    b1: TwwNavButton;
    b2: TwwNavButton;
    b3: TwwNavButton;
    b4: TwwNavButton;
    b5: TwwNavButton;
    b6: TwwNavButton;
    b7: TwwNavButton;
    b8: TwwNavButton;
    Bit1: TMenuItem;
    Bit4: TMenuItem;
    Panel4: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Bit2: TBitBtn;
    Bit3: TBitBtn;
    Bit5: TBitBtn;
    Bit6: TBitBtn;
    Bit7: TBitBtn;
    Bit8: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn3: TBitBtn;
    Label8: TLabel;
    ADOTable5: TADOTable;
    DataSource5: TDataSource;
    ADOTable5code: TStringField;
    ADOTable5name: TStringField;
    ADOTable5dz: TStringField;
    ADOTable5dh: TStringField;
    ADOTable5cz: TStringField;
    ADOTable5lxr: TStringField;
    dxDBGridLayoutList1Item3: TdxDBGridLayout;
    ADOTable1fplx: TStringField;
    ADOTable1ck: TStringField;
    ADOTable1yfje: TBCDField;
    ADOTable2ddcode: TStringField;
    ADOTable6: TADOTable;
    DataSource6: TDataSource;
    ADOTable6fpname: TStringField;
    dxDBGridLayoutList1Item4: TdxDBGridLayout;
    ADOTable1ckname: TStringField;
    Ed1: TdxDBButtonEdit;
    Ed2: TdxDBDateEdit;
    Ed3: TdxDBExtLookupEdit;
    Ed5: TdxDBExtLookupEdit;
    Ed6: TdxDBExtLookupEdit;
    Ed4: TdxDBExtLookupEdit;
    N3: TMenuItem;
    Shape3: TShape;
    DBText1: TDBText;
    N4: TMenuItem;
    ADOTable1KH: TStringField;
    ADOTable1khname: TStringField;
    ADOTable1ywyname: TStringField;
    ADOTable2kcsl: TBCDField;
    ADOTable1shrq: TDateTimeField;
    ADOTable1shr: TStringField;
    ADOTable2jhj: TBCDField;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DBGridEh1GetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: string);
    procedure ADOTable2BeforePost(DataSet: TDataSet);
    procedure ADOTable2spcodeSetText(Sender: TField; const Text: string);
    procedure DBGridEh1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: string);
    procedure Ed1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ADOTable2jsSetText(Sender: TField; const Text: string);
    procedure ADOTable2ssSetText(Sender: TField; const Text: string);
    procedure ADOTable2slSetText(Sender: TField; const Text: string);
    procedure ADOTable2djSetText(Sender: TField; const Text: string);
    procedure ADOTable2suiSetText(Sender: TField; const Text: string);
    procedure BitBtn3Click(Sender: TObject);
    procedure Bit2Click(Sender: TObject);
    procedure Bit3Click(Sender: TObject);
    procedure Ed6KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Bit8Click(Sender: TObject);
    procedure NewCode(Sender: integer);
    procedure Bit5Click(Sender: TObject);
    procedure b1UpdateState(Navigator: TwwDBNavigator;
      Button: TwwNavButton; Cause: TwwUpdateCause);
    procedure Bit6Click(Sender: TObject);
    procedure Bit7Click(Sender: TObject);
    procedure Bit1Click(Sender: TObject);
    procedure Bit4Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Ed1ButtonClick(Sender: TObject; AbsoluteIndex: Integer);
    procedure N13Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure Panel1Resize(Sender: TObject);
    procedure Panel2Resize(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure DBGridEh1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ADOTable1AfterScroll(DataSet: TDataSet);
    procedure Ed4KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  xschd: Txschd;
  Etxt, Ytxt, Ycode: string;
  ECol: integer;


implementation

uses MainForm1, xschdxzsp1, xschxzdd1, xgxschdh1, xschdcx1, dyxschd1,
  xschshrz1, xschxzdj1;

{$R *.DFM}

procedure Txschd.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := cafree;
end;

procedure Txschd.DBGridEh1GetEditText(Sender: TObject; ACol, ARow: Integer;
  var Value: string);
begin
  ECol := ACol;
  Ytxt := Value;
end;

procedure Txschd.ADOTable2BeforePost(DataSet: TDataSet);
begin
  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from spda where code=:code');
  Query1.Parameters[0].Value := ADOtable2.fieldbyname('spcode').asstring;
  Query1.Open;
  if Query1.RecordCount = 0 then
  begin
//    showmessage('输入的商品编码不正确');
    ADOTable2.cancel;
  end;
end;

procedure Txschd.Ed6KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = 13 then DBGridEh1.SetFocus;
end;

procedure Txschd.ADOTable2spcodeSetText(Sender: TField; const Text: string);
begin
  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select code,barcode,mainghs,name,jldw,pfj,bzgg,kcsl as kcsl,jhj from spda_v where (code=:code or barcode=:barcode) and ckcode=:ckcode');
  Query1.Parameters[0].Value := Etxt;
  Query1.Parameters[1].Value := Etxt;
  Query1.Parameters[2].Value := ADOTable1ck.Value;
  Query1.Open;
  if Query1.RecordCount > 0 then
  begin
    ADOTable2.FieldByName('spname').Value := Query1.fieldbyname('name').asstring;
    ADOTable2.FieldByName('jldw').Value := Query1.fieldbyname('jldw').asstring;
    ADOTable2.FieldByName('dj').Value := Query1.fieldbyname('pfj').Value;
    ADOTable2.FieldByName('bzgg').Value := Query1.fieldbyname('bzgg').Value;
    ADOTable2.FieldByName('js').Value := 0;
    ADOTable2.FieldByName('ss').Value := 0;
    ADOTable2.FieldByName('sl').Value := 0;
    ADOTable2.FieldByName('sui').Value := 0;
    ADOTable2.FieldByName('je').Value := 0;
    ADOTable2.FieldByName('jhj').Value := Query1.fieldbyname('jhj').asfloat;
    ADOTable2.FieldByName('kcsl').Value := Query1.fieldbyname('kcsl').asfloat;
    ADOTable2.FieldByName('spcode').Value := Query1.fieldbyname('code').asstring;
    Query1.Close;
    Query1.SQL.Clear;
    Query1.SQL.Add('select top 1  CONVERT (char(10),kdrq,20) ,code,dj from xsdj_v where spcode=:code3 and kh=:kh order by kdrq desc');
    Query1.Parameters[0].Value := Etxt;
    Query1.Parameters[1].Value := ADOTable1kh.Value;
    Query1.Open;
    ADOTable2.FieldByName('dj').Value := Query1.fieldbyname('dj').Value;
  end
  else
  begin
    ADOTable2.Cancel;
//    Application.CreateForm(Txschxzsp, xschxzsp);
//    xschxzsp.ShowModal;
  end;
  Etxt := '';
end;

procedure Txschd.DBGridEh1SetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: string);
begin
  Etxt := Value;
end;

procedure Txschd.Ed1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = 13 then
  begin
    key := 0;
    perform(WM_NEXTDLGCTL, 0, 0); {移动到下一个控件}
  end;
end;

procedure Txschd.ADOTable2jsSetText(Sender: TField; const Text: string);
begin
  if ADOTable2.FieldByName('spname').asstring = '' then exit;
  if Etxt = '' then Etxt := '0';
  if ADOTable2.FieldByName('bzgg').Value > 0 then
  begin
    ADOTable2.FieldByName('sl').Value := ADOTable2.FieldByName('bzgg').Value * Etxt + ADOTable2.FieldByName('ss').Value;
    ADOTable2.FieldByName('js').Value := Etxt;
  end
  else
  begin
    ADOTable2.FieldByName('sl').Value := Etxt + ADOTable2.FieldByName('ss').Value;
    ADOTable2.FieldByName('js').Value := Etxt;
  end;
  ADOTable2.FieldByName('je').Value := ADOTable2.FieldByName('sl').Value * ADOTable2.FieldByName('dj').Value + ADOTable2.FieldByName('sl').Value * ADOTable2.FieldByName('dj').Value * ADOTable2.FieldByName('sui').Value / 100;
end;

procedure Txschd.ADOTable2ssSetText(Sender: TField; const Text: string);
begin
  if ADOTable2.FieldByName('spname').asstring = '' then exit;
  if Etxt = '' then Etxt := '0';
  if ADOTable2.FieldByName('bzgg').Value > 0 then
  begin
    ADOTable2.FieldByName('sl').Value := ADOTable2.FieldByName('bzgg').Value * ADOTable2.FieldByName('js').Value + Etxt;
    ADOTable2.FieldByName('ss').Value := Etxt;
  end
  else
  begin
    ADOTable2.FieldByName('sl').Value := Etxt + ADOTable2.FieldByName('js').Value;
    ADOTable2.FieldByName('ss').Value := Etxt;
  end;
  ADOTable2.FieldByName('je').Value := ADOTable2.FieldByName('sl').Value * ADOTable2.FieldByName('dj').Value + ADOTable2.FieldByName('sl').Value * ADOTable2.FieldByName('dj').Value * ADOTable2.FieldByName('sui').Value / 100;
end;

procedure Txschd.ADOTable2slSetText(Sender: TField; const Text: string);
begin
  if ADOTable2.FieldByName('spname').asstring = '' then exit;
  if Etxt = '' then Etxt := '0';
  if ADOTable2.FieldByName('bzgg').Value <> 0 then
  begin
    ADOTable2.FieldByName('js').Value := Etxt div ADOTable2.FieldByName('bzgg').Value;
    ADOTable2.FieldByName('ss').Value := Etxt mod ADOTable2.FieldByName('bzgg').Value;
    ADOTable2.FieldByName('sl').Value := Etxt;
  end
  else
  begin
    ADOTable2.FieldByName('js').Value := Etxt;
    ADOTable2.FieldByName('ss').Value := Etxt;
    ADOTable2.FieldByName('sl').Value := Etxt;
  end;
  ADOTable2.FieldByName('je').Value := Etxt * ADOTable2.FieldByName('dj').Value + Etxt * ADOTable2.FieldByName('dj').Value * ADOTable2.FieldByName('sui').Value / 100;
end;

procedure Txschd.ADOTable2djSetText(Sender: TField; const Text: string);
begin
  if ADOTable2.FieldByName('spname').asstring = '' then exit;
  if Etxt = '' then Etxt := '0';
  ADOTable2.FieldByName('je').Value := ADOTable2.FieldByName('sl').Value * Etxt + ADOTable2.FieldByName('sl').Value * Etxt * ADOTable2.FieldByName('sui').Value / 100;
  ADOTable2.FieldByName('dj').Value := Etxt;
end;

procedure Txschd.ADOTable2suiSetText(Sender: TField; const Text: string);
begin
  if ADOTable2.FieldByName('spname').asstring = '' then exit;
  if Etxt = '' then Etxt := '0';
  ADOTable2.FieldByName('je').Value := ADOTable2.FieldByName('sl').Value * ADOTable2.FieldByName('dj').Value + ADOTable2.FieldByName('sl').Value * ADOTable2.FieldByName('dj').Value * Etxt / 100;
  ADOTable2.FieldByName('sui').Value := Etxt;
end;

procedure Txschd.BitBtn3Click(Sender: TObject);
begin
  close;
end;

procedure Txschd.Bit2Click(Sender: TObject);
begin
  if Bit6.Enabled = true then
  begin
    if Application.MessageBox('单据已修改,是否要保存?', '提示', MB_YESNO + MB_ICONQUESTION) = IDYES then
      ADOTable1.post else ADOTable1.Cancel;
  end;
  ADOTable1.Prior;
end;

procedure Txschd.Bit3Click(Sender: TObject);
begin
  if Bit6.Enabled = true then
  begin
    if Application.MessageBox('单据已修改,是否要保存?', '提示', MB_YESNO + MB_ICONQUESTION) = IDYES then
      ADOTable1.post else ADOTable1.Cancel;
  end;
  ADOTable1.Next;
end;

procedure Txschd.Bit8Click(Sender: TObject);
begin
  if ADOTable1.FieldByName('zt').asstring = '审核入账' then
  begin
    Application.MessageBox('单据已经入账,不能再做修改.', '提示', MB_OK + MB_ICONERROR);
    exit;
  end;
  if Application.MessageBox('删除后将不能恢复,是否删除此单据?', '提示', MB_YESNO + MB_ICONQUESTION) = IDNO then exit;
  Ed1.SetFocus;
  ADOTable1.Delete;
  try
    ADOTable1.Refresh;
    ADOTable2.Refresh;
  except
  end;
  if ADOtable1.RecordCount = 0 then Bit8.Enabled := false;
end;

procedure Txschd.NewCode(Sender: integer);
var code: string;
begin
  Query1.Close;
  Query1.sql.text := 'select count(*) from XSCH001 where kdrq=:cdrq';
  Query1.Parameters[0].Value := datetostr(MainForm.DateTimePicker1.Date);
  Query1.open;
  code := floattostr(Query1.Fields[0].asfloat + strtofloat(formatdatetime('yyyymmdd""001', MainForm.DateTimePicker1.Date)) + Sender);
  Query1.Close;
  Query1.sql.text := 'select count(*) from XSCH001 where code=:code';