ps_stkbill.pas

DELPHI5加SQL SERVER2000完成的进销存系统,具体哪些内容记不清了,六七年前写的,希望还能有点贡献

unit PS_stkbill;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Mask, DBCtrls, StdCtrls, Buttons, Menus,db, Grids, DBGrids, variants;

type
  TF_stkbill = class(TForm)
    DBGrid2: TDBGrid;
    GroupBox1: TGroupBox;
    L_targetid1: TLabel;
    L_personid1: TLabel;
    L_totaltax1: TLabel;
    L_memo1: TLabel;
    L_totalmoney: TLabel;
    L_name1: TLabel;
    L_shortname: TLabel;
    L_billno: TLabel;
    L_deliveryaddr: TLabel;
    L_title1: TLabel;
    M_memo1: TDBMemo;
    E_shortname1: TDBEdit;
    CB_personid1: TDBLookupComboBox;
    E_name1: TDBEdit;
    E_totalmoney1: TDBEdit;
    E_totaltax1: TDBEdit;
    CB_deliveryaddr: TComboBox;
    L_title2: TLabel;
    CB_targetid1: TDBLookupComboBox;
    CB_billno: TComboBox;
    L_warehouseid: TLabel;
    CB_warehouseid: TDBLookupComboBox;
    L_warehouseName: TLabel;
    E_warehouseName: TDBEdit;
    L_paidmoney: TLabel;
    L_cash: TLabel;
    E_paidmoney: TDBEdit;
    E_cash: TDBEdit;
    procedure FormCreate(Sender: TObject);
    procedure CB_billnoChange(Sender: TObject);
    procedure CB_deliveryaddrChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    function send:boolean;
    procedure CB_targetid1CloseUp(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure GroupBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DBGrid2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure mainappend;
    procedure subAppend;
    procedure MainDelete;
    procedure SubDelete;
    procedure cancel;
    procedure CB_warehouseidCloseUp(Sender: TObject);
    procedure CB_personid1CloseUp(Sender: TObject);
    procedure Beforeinsert;
    procedure Afterinsert;
    procedure HaveRecord;
    procedure NoRecord;
    procedure substatus;
  private
    function billno: string;
    procedure setstkbillmain_values;
    procedure setstkbillsub_values;
    procedure setstrbillno;
    function MainPost:boolean;
    function subPost:boolean;
    function MainInsert:boolean;
    function SubInsert:boolean;
    procedure setSerialNo(billno:string);
    procedure Costs_status;
    procedure setCB_items;
    { Private declarations }
  public
    flag:integer;
    { Public declarations }
  end;

var
  F_stkbill: TF_stkbill;
  serialno:integer;
  strbillno:string;
  cb_billno_currentItem:integer;
implementation

uses PS_db, PS_main, PS_stkPlus;

{$R *.DFM}
//自定义函数部分
function TF_stkbill.billno: string;
var
  tempdate:string;
  tempnum:integer;
begin
  tempdate:=formatdatetime('yyyymmdd',date);
  tempnum:=0;
  with comdatabase.stkbillmain do
    if Locate('billno',tempdate,[loPartialKey]) then
      while not eof do begin
        if strtoint(copy(fieldvalues['billno'],9,4))>tempnum then
          tempnum:=strtoint(copy(fieldvalues['billno'],9,4));
        next;
        end;
  result:=tempdate+format('%4d',[tempnum+1]);
end;

procedure TF_stkbill.setstrbillno;
begin
  strbillno:=billno;
end;

procedure TF_stkbill.setSerialNo(billno:string);
begin
  serialno:=0;
  with comdatabase.stkbillsub do
    if locate('flag;billno',vararrayof([fieldvalues['flag'],fieldvalues['billno']]),[loPartialKey]) then begin
      disablecontrols;
      first;
      while not eof do begin
        if fieldvalues['serialno']>serialno then
          serialno:=fieldvalues['serialno'];
        next;
        end;
      enablecontrols;
      end;
  serialno:=serialno+1;
end;

procedure TF_stkbill.setstkbillmain_values;
begin
  with comdatabase.stkbillmain do begin
    if flag=1 then
      fieldvalues['flag']:=1
    else
      fieldvalues['flag']:=2;
    fieldvalues['billno']:=strbillno;
    fieldvalues['totalmoney']:=0;
    fieldvalues['totaltax']:=0;
    end;
end;

procedure TF_stkbill.setstkbillsub_values;
begin
  with comdatabase do begin
    stkbillsub.FieldValues['flag']:=stkbillmain.fieldvalues['flag'];
    stkbillsub.fieldvalues['billno']:=stkbillmain.fieldvalues['billno'];
    stkbillsub.fieldvalues['serialno']:=serialno;
    stkbillsub.fieldvalues['amount']:=0;
    end;
end;

procedure TF_stkbill.Afterinsert;
begin
  with tf_stkbill(f_main.activemdichild) do begin
    E_paidmoney.ReadOnly:=true;
    with cb_billno do
      Text:=Items.Strings[Items.IndexOf(comdatabase.stkbillmain.fieldvalues['billno'])];
    end;
end;

procedure TF_stkbill.Beforeinsert;
begin
  with tf_stkbill(f_main.activemdichild) do begin
    cb_billno.SetFocus;
    E_paidmoney.ReadOnly:=false;
    end;
end;

function TF_stkbill.MainPost: boolean;
begin
  result:=true;
  with comdatabase.stkbillmain do
    try
      applyupdates;
    except
      case application.MessageBox('单据记录输入有误，是否补充','错误',mb_yesno) of
        idno:begin
          comdatabase.stkbillsub.CancelUpdates;
          cancelupdates;
          cb_billno.items.Delete(cb_billno_currentitem);
          end;
        idyes:begin
          cb_billno.text:=cb_billno.items.strings[cb_billno_currentitem];
          end;
        end;
      result:=false;
    end;
end;

function TF_stkbill.subPost: boolean;
begin
  result:=true;
  with comdatabase.stkbillsub do
    try
      applyupdates;
      close;
      open;
    except
      if application.MessageBox('单中内容记录输入有误！'+#13+'是否补充？','错误',mb_yesno)<>idyes then
        cancelupdates
      else
        result:=false;
    end;
end;

function TF_stkbill.send:boolean;
begin
  result:=false;
  if mainpost then begin
    if subpost then
      result:=true;
    end;
end;

function TF_stkbill.MainInsert:boolean;
begin
  result:=true;
  with comdatabase.stkbillmain do
    try
      if (state=dsedit)or(state=dsinsert)then
        post;
      setstrbillno;
      append;
      setstkbillmain_values;
      f_stkbill.beforeinsert;
    except
      if application.MessageBox('单据记录输入有误，是否补充？','错误',mb_yesno)<>idyes then begin
        cancelupdates;
        comdatabase.stkbillsub.cancelupdates;
        end;
        result:=false;
    end;
end;

function TF_stkbill.SubInsert:boolean;
begin
  result:=true;
  with comdatabase.stkbillsub do
    try
      if isempty then
        dbgrid2.readonly:=false;
      if (state=dsedit) or (state=dsinsert) then
        post;
      setserialno(comdatabase.stkbillmain.fieldvalues['billno']);
      append;
      setstkbillsub_values;
    except
      if application.MessageBox('单中内容记录输入有误！'+#13+'是否补充？','错误',mb_yesno)<>idyes then
        cancel
      else
        result:=false;
    end;
end;

procedure TF_stkbill.mainappend;
begin
  with tf_stkbill(f_main.activemdichild) do begin
    cb_deliveryaddr.Enabled:=false;
    if maininsert then begin
      with cb_billno do begin
      text:=items.Strings[items.add(comdatabase.stkbillmain.fieldvalues['billno'])];
      cb_billno_currentItem:=items.IndexOf(text);
      end;
      subinsert;
      end;
    end;
end;

procedure TF_stkbill.subAppend;
begin
  subinsert;
end;

procedure TF_stkbill.cancel;
begin
  with comdatabase do begin
    if stkbillmain.state=dsinsert then
      tf_stkbill(f_main.activemdichild).cb_billno.items.Delete(cb_billno_currentItem);
    stkbillsub.cancelupdates;
    stkbillmain.cancelupdates;
    end;
end;

procedure TF_stkbill.MainDelete;
begin
  with comdatabase do begin
    with stkbillsub do begin
      disablecontrols;
      while not isempty do
        delete;
      applyupdates;//去掉这条和下面的同样语句，会出错,因为Send时，是先applyupdates主表，
      enablecontrols;  //再applyupdates从表，必出现外键错误
      end;
    with stkbillmain do begin
      disablecontrols;
      delete;
      applyupdates;
      with tf_stkbill(f_main.activemdichild) do begin
        cb_billno.Items.Delete(cb_billno.ItemIndex);
        if not isempty then begin
          cb_billno.Text:=cb_billno.Items.Strings[0];
          cb_billno.OnChange(self);
          end;
        end;
      enablecontrols;
      end;
    end;
end;

procedure TF_stkbill.SubDelete;
begin
  comdatabase.stkbillsub.delete;
end;

procedure TF_stkbill.NoRecord;
begin
  with tf_stkbill(f_main.activemdichild) do begin
    cb_billno.enabled:=false;
    cb_targetid1.Enabled:=false;
    cb_deliveryaddr.text:='';
    cb_deliveryaddr.enabled:=false;
    cb_personid1.enabled:=false;
    cb_warehouseid.Enabled:=false;
    e_cash.Enabled:=false;
    m_memo1.enabled:=false;
    dbgrid2.readonly:=true;
    end;
end;

procedure TF_stkbill.HaveRecord;
begin
  with tf_stkbill(f_main.activemdichild) do begin
    cb_billno.enabled:=true;
    cb_targetid1.Enabled:=true;
    cb_deliveryaddr.text:='';
    cb_deliveryaddr.enabled:=true;
    cb_personid1.enabled:=true;
    cb_warehouseid.Enabled:=true;
    e_cash.Enabled:=true;
    m_memo1.enabled:=true;
    dbgrid2.readonly:=false;
    end;
end;

procedure TF_stkbill.Costs_status;
begin
  with dbgrid2.Columns.Items[10] do
  if flag=2 then
    Visible:=true
  else
    Visible:=false;
end;

procedure TF_stkbill.setCB_items;
begin
  with comdatabase do
    if stkbillmain.locate('flag;billno',vararrayof([flag,cb_billno.text]),[loPartialKey]) then begin
      with stkbillsub do begin
        cb_deliveryaddr.Items.Clear;
        if isempty then
          dbgrid2.ReadOnly:=true
        else begin
          dbgrid2.readonly:=false;
          disablecontrols;
          first;
          while not eof do begin
            cb_deliveryaddr.items.add(inttostr(fieldvalues['serialno']));
            Next;
            end;
          first;
          enablecontrols;
          end;
        end;
      if comcustomer.Locate('id',stkbillmain.fieldvalues['targetid'],[lopartialkey]) then
        cb_deliveryaddr.text:=comcustomer.fieldvalues['address'];
      comperson.Locate('id',stkbillmain.fieldvalues['personid'],[lopartialkey]);
      end
    else
      cb_billno.Items.Delete(cb_billno.ItemIndex);
end;

procedure tf_stkbill.substatus;
begin
  with tf_stkbill(f_main.ActiveMDIChild).CB_deliveryaddr do
    text:=items.Strings[items.indexof(inttostr(comdatabase.stkbillsub.fieldvalues['serialno']))];
end;
//程序正体部分
//窗体程序
procedure TF_stkbill.FormCreate(Sender: TObject);
begin
  with comdatabase do begin
    stkbillmain.open;
    stkbillmain.CachedUpdates:=true;
    stkbillsub.open;
    stkbillsub.cachedupdates:=true;
    comwareamount.open;
    comwarehouse.open;
    comcustomer.open;
    comproduct.open;
    comperson.open;
    end;
  flag:=f_main.flag;
  with comdatabase do begin
    with comcustomer do begin
      disablecontrols;
      case flag of
        1:filter:='flag=2';
        2:filter:='flag=1';
        0:filter:='';
        end;
      filtered:=true;
      enablecontrols;
      end;
    with stkbillmain do begin
      disablecontrols;
      case flag of
        1:begin filter:='flag=1';L_title1.caption:='进货单信息：';L_targetid1.caption:='厂商编号:';L_personid1.caption:='采购编号：';end;
        2:begin filter:='flag=2';L_title1.caption:='销货单信息：';L_targetid1.caption:='客户编号:';L_personid1.caption:='业务编号：';end;
        0:filter:='';
        end;
      filtered:=true;
      if isempty then begin
        cb_billno.Text:='无任何表单信息';
        end
      else begin
        first;
        while not eof do begin
          cb_billno.Items.Add(fieldvalues['billno']);
          next;
          end;
        end;
      enablecontrols;
      end;
    end;
  if not comdatabase.stkbillmain.IsEmpty then begin
    cb_billno.Text:=CB_billno.items.strings[0];
    setCb_items;
    end;
  costs_status;
end;

procedure TF_stkbill.FormActivate(Sender: TObject);
begin
  with comdatabase do begin
    stkbillmain.open;
    stkbillmain.CachedUpdates:=true;
    stkbillsub.open;
    stkbillsub.cachedupdates:=true;
    comwareamount.open;
    comwarehouse.open;
    comcustomer.open;
    comproduct.open;
    comperson.open;
    end;
  case flag of
    1:f_main.ActiveMDIChild.caption:='进货单资料查询';
    2:f_main.ActiveMDIChild.caption:='销货单资料查询';
    end;
  f_main.currentTable:=comdatabase.stkbillmain;
  f_main.TableName:=Rstkbillmain;
  f_main.buttonstate;
end;

procedure TF_stkbill.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  canclose:=send;
end;

procedure TF_stkbill.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  with comdatabase do begin
    stkbillmain.close;
    stkbillsub.close;
    comproduct.close;
    comwareamount.close;
    comwarehouse.close;
    comcustomer.close;
    comcustomer.filtered:=false;
    comperson.close;
    end;
  f_main.currentTable:=nil;
  action:=cafree;
end;
//各下拉列单控制
procedure TF_stkbill.CB_billnoChange(Sender: TObject);
begin
if send then begin
  if not cb_deliveryaddr.Enabled then
    cb_deliveryaddr.Enabled:=true;
  setCb_items;
  end
else begin
  cb_billno.text:=cb_billno.items.strings[cb_billno_currentitem];
  end;
end;

procedure TF_stkbill.CB_deliveryaddrChange(Sender: TObject);
begin
  with comdatabase do begin
    stkbillsub.Locate('serialno',cb_deliveryaddr.text,[lopartialkey]);
    end;
end;

procedure TF_stkbill.CB_targetid1CloseUp(Sender: TObject);
begin
  with comdatabase do begin
    stkbillmain.edit;
    stkbillmain.fieldvalues['targetid']:=comcustomer.fieldvalues['id'];
    stkbillmain.fieldvalues['deliveryaddr']:=comcustomer.fieldvalues['address'];
    cb_deliveryaddr.text:=comcustomer.fieldvalues['address'];
    end;
end;

procedure TF_stkbill.CB_warehouseidCloseUp(Sender: TObject);
begin
  with comdatabase do begin
    stkbillmain.edit;
    stkbillmain.fieldvalues['warehouseid']:=comwarehouse.fieldvalues['id'];
    end;
end;

procedure TF_stkbill.CB_personid1CloseUp(Sender: TObject);
begin
  with comdatabase do begin
    stkbillmain.edit;
    stkbillmain.fieldvalues['personid']:=comperson.fieldvalues['id'];
    end;
end;
//以下三个程序实现主从表操作的切换
procedure TF_stkbill.GroupBox1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  with comdatabase do begin
    f_main.currentTable:=stkbillmain;
    f_main.TableName:=Rstkbillmain;
    f_main.buttonstate;
    end;
end;

procedure TF_stkbill.DBGrid2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with comdatabase do begin
    f_main.currentTable:=stkbillsub;
    f_main.TableName:=Rstkbillsub;
    f_main.buttonstate;
    end;
end;
//补充调试部分
//结束
end.