ps_ordbill.pas

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

unit PS_ordbill;

interface

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

type
  TF_ordbill = 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;
    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 FormDeactivate(Sender: TObject);
    procedure Turn;
    procedure CB_personid1CloseUp(Sender: TObject);
    procedure NoRecord;
    procedure HaveRecord;
    procedure status;
    procedure substatus;
  private
    function billno: string;
    procedure setordbillmain_values;
    procedure setordbillsub_values;
    procedure setstrbillno;
    function MainPost:boolean;
    function subPost:boolean;
    function MainInsert:boolean;
    function SubInsert:boolean;
    procedure setSerialNo(billno:string);
    procedure turnPlus(warehouseid,cash:string);
    procedure SetCb_items;
    { Private declarations }
  public
    flag:integer;
    { Public declarations }
  end;

var
  F_ordbill: TF_ordbill;
  serialno:integer;
  strbillno:string;
  cb_billno_currentItem:integer;
implementation

uses PS_db, PS_main, PS_stkPlus;

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

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

procedure TF_ordbill.setSerialNo(billno:string);
begin
  serialno:=0;
  with comdatabase.ordbillsub 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_ordbill.setordbillmain_values;
begin
  with comdatabase.ordbillmain do begin
    fieldvalues['flag']:=tf_ordbill(f_main.activemdichild).flag;
    fieldvalues['billno']:=strbillno;
    fieldvalues['totalmoney']:=0;
    fieldvalues['totaltax']:=0;
    end;
end;

procedure TF_ordbill.setordbillsub_values;
begin
  with comdatabase do begin
    ordbillsub.FieldValues['flag']:=ordbillmain.fieldvalues['flag'];
    ordbillsub.fieldvalues['billno']:=ordbillmain.fieldvalues['billno'];
    ordbillsub.fieldvalues['serialno']:=serialno;
    ordbillsub.fieldvalues['amount']:=0;
    ordbillsub.fieldvalues['translated']:=0;
    end;
end;

function TF_ordbill.MainPost: boolean;
begin
  result:=true;
  with comdatabase.ordbillmain do
    try
      applyupdates;
    except
      case application.MessageBox('单据记录输入有误，是否补充','错误',mb_yesno) of
        idno:begin
          comdatabase.ordbillsub.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_ordbill.subPost: boolean;
begin
  result:=true;
  with comdatabase.ordbillsub do
    try
      applyupdates;
      close;
      open;
    except
      if application.MessageBox('单中内容记录输入有误！'+#13+'是否补充？','错误',mb_yesno)<>idyes then
        cancelupdates
      else
        result:=false;
    end;
end;

function TF_ordbill.send:boolean;
begin
  result:=false;
  if mainpost then
    if subpost then
      result:=true;
  with comdatabase do begin
    stkbillmain.applyupdates;
    stkbillsub.ApplyUpdates;
    end;
//  if tf_ordbill(f_main.activemdichild).cb_targetid1.Enabled=true then
//    tf_ordbill(f_main.activemdichild).cb_targetid1.SetFocus;
end;

function TF_ordbill.MainInsert:boolean;
begin
  result:=true;
  with comdatabase.ordbillmain do
    try
      if (state=dsedit)or(state=dsinsert)then
        post;
      setstrbillno;
      append;
      setordbillmain_values;
    except
      if application.MessageBox('单据记录输入有误，是否补充？','错误',mb_yesno)<>idyes then begin
        comdatabase.ordbillsub.cancelupdates;
        cancelupdates;
        end;
        result:=false;
    end;
//    tf_ordbill(f_main.activemdichild).cb_targetid1.SetFocus;
end;

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

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

procedure TF_ordbill.subAppend;
begin
  subinsert;
end;

procedure TF_ordbill.cancel;
begin
  with comdatabase do begin
    if ordbillmain.state=dsinsert then
      tf_ordbill(f_main.activemdichild).cb_billno.items.Delete(cb_billno_currentItem);
    ordbillsub.cancelupdates;
    ordbillmain.cancelupdates;
    stkbillsub.cancelUpdates;
    stkbillmain.cancelupdates;
    end;
end;

procedure TF_ordbill.MainDelete;
begin
  with comdatabase do begin
    with ordbillsub do begin
      disablecontrols;
      while not isempty do
        delete;
      applyupdates;
      enablecontrols;
      end;
    with ordbillmain do begin
      disablecontrols;
      delete;
      applyupdates;
      with tf_ordbill(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_ordbill.SubDelete;
begin
  comdatabase.ordbillsub.delete;
end;

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

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

procedure TF_ordbill.turnPlus(warehouseid,cash:string);
begin
  with comdatabase do begin
    with ordbillmain do begin