📄 tld1.pas

📁 思微POS连锁超市管理系统 (商业代码),几年前的东西了
💻 PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit tld1;

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, Grids, DBGrids;

type
  Ttld = class(TForm)
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    Panel1: TPanel;
    Panel2: TPanel;
    Label7: TLabel;
    Ed7: TdxDBEdit;
    ADOTable3: TADOTable;
    ADOTable4: TADOTable;
    StringField1: TStringField;
    StringField2: TStringField;
    dxDBGridLayoutList1: TdxDBGridLayoutList;
    dxDBGridLayoutList1Item1: TdxDBGridLayout;
    DataSource3: TDataSource;
    DataSource4: TDataSource;
    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;
    ADOTable2jhj: TBCDField;
    ADOTable2je: TBCDField;
    ADOTable2id: TAutoIncField;
    ADOTable2code: TStringField;
    ADOTable2bzgg: TBCDField;
    ADOTable1: TADOTable;
    ADOTable1code: TStringField;
    ADOTable1kdrq: TDateTimeField;
    ADOTable1ywy: TStringField;
    ADOTable1bz: TStringField;
    ADOTable1zt: TStringField;
    ADOTable1ywyname: 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;
    Ed1: TdxDBButtonEdit;
    Ed2: TdxDBDateEdit;
    Ed3: TdxDBExtLookupEdit;
    Ed4: TdxDBExtLookupEdit;
    dxDBEdit1: TdxDBEdit;
    Bit2: TBitBtn;
    Bit3: TBitBtn;
    Bit5: TBitBtn;
    Bit6: TBitBtn;
    Bit7: TBitBtn;
    Bit8: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn3: TBitBtn;
    ADOTable3code: TStringField;
    ADOTable3name: TStringField;
    ADOTable3dz: TStringField;
    ADOTable3dh: TStringField;
    ADOTable3cz: TStringField;
    ADOTable3lxr: TStringField;
    ADOTable3bz: TStringField;
    ADOTable1dkr: TStringField;
    N3: TMenuItem;
    ADOTable1ck: TStringField;
    ADOTable1ckname: TStringField;
    ADOTable1shr: TStringField;
    ADOTable1shrq: TDateTimeField;
    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 ADOTable2jhjSetText(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 ADOTable1AfterScroll(DataSet: TDataSet);
    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 N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  tld: Ttld;
  Etxt, Ytxt, Ycode: string;
  ECol: integer;


implementation

uses MainForm1, tldxzsp1, tldcx1, dytld1, xgtldh1;

{$R *.DFM}

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

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

procedure Ttld.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 Ttld.Ed6KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = 13 then DBGridEh1.SetFocus;
end;

procedure Ttld.ADOTable2spcodeSetText(Sender: TField; const Text: string);
begin
  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from spda where code=:code or barcode=:barcode');
  Query1.Parameters[0].Value := Etxt;
  Query1.Parameters[1].Value := Etxt;
  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('jhj').Value := Query1.fieldbyname('jhj').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('je').Value := 0;
    ADOTable2.FieldByName('spcode').Value := Query1.fieldbyname('code').asstring;
  end
  else
  begin
    ADOTable2.Cancel;
{    Application.CreateForm(Ttldxzsp, tldxzsp);
    tldxzsp.Edit1.Text := Etxt;
    tldxzsp.ADOQuery1.Locate('code', tldxzsp.Edit1.text, [loPartialKey]);
    tldxzsp.ShowModal;  }
  end;
  Etxt := '';
end;

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

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

procedure Ttld.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('jhj').Value;
end;

procedure Ttld.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('jhj').Value;
end;

procedure Ttld.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('jhj').Value;
end;

procedure Ttld.ADOTable2jhjSetText(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('jhj').Value := Etxt;
end;

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

procedure Ttld.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 Ttld.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 Ttld.Bit8Click(Sender: TObject);
begin
  if ADOTable1.FieldByName('zt').asstring = '审核入账' then
  begin
12 下一页
⌨️ 快捷键说明

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