ddch.~pas

来自「应对服装行业的生产成本控制系统」· ~PAS 代码 · 共 809 行 · 第 1/2 页

unit ddch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, Grids, DBGrids, ExtCtrls, DBCtrls,
  DB, ADODB, DBClient;

type
  TFrmddch = class(TForm)
    Pz: TPanel;
    Label25: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label41: TLabel;
    help: TLabel;
    GroupBox4: TGroupBox;
    tsl: TEdit;
    tbz: TEdit;
    txh: TEdit;
    tczl: TEdit;
    DataSource1: TDataSource;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    twcl: TEdit;
    DBGrid1: TDBGrid;
    Pd: TPanel;
    rq: TDateTimePicker;
    pq: TPanel;
    ClientDataSet1: TClientDataSet;
    ClientDataSet1skbh: TFloatField;
    ClientDataSet1xh: TIntegerField;
    ClientDataSet1zy: TStringField;
    ClientDataSet1hbmc: TStringField;
    ClientDataSet1je: TFloatField;
    ClientDataSet1hl: TFloatField;
    ClientDataSet1zhrmb: TFloatField;
    ClientDataSet1bz: TStringField;
    ClientDataSet1hbmc1: TStringField;
    ClientDataSet1hl1: TStringField;
    csq: TCheckBox;
    cddh: TCheckBox;
    qddh: TEdit;
    cjglx: TCheckBox;
    csz: TCheckBox;
    sz: TDateTimePicker;
    qjglx: TEdit;
    ckhmc: TCheckBox;
    qkhmc: TEdit;
    ccpmc: TCheckBox;
    qcpmc: TEdit;
    csl: TCheckBox;
    ccpfl: TCheckBox;
    qsl: TEdit;
    qcpfl: TEdit;
    ccpdw: TCheckBox;
    cdj: TCheckBox;
    qcpdw: TEdit;
    qdj: TEdit;
    sq: TDateTimePicker;
    cwgzt: TCheckBox;
    cje: TCheckBox;
    qwgzt: TEdit;
    qje: TEdit;
    Cjq: TCheckBox;
    Cjz: TCheckBox;
    jz: TDateTimePicker;
    jq: TDateTimePicker;
    bnew: TBitBtn;
    bsave: TBitBtn;
    bcancel: TBitBtn;
    bprint: TBitBtn;
    breturn: TBitBtn;
    Bquery: TBitBtn;
    GroupBox1: TGroupBox;
    DBGrid5: TDBGrid;
    wgzt: TCheckBox;
    procedure tslKeyPress(Sender: TObject; var Key: Char);
    procedure bcancelClick(Sender: TObject);
    procedure bprintClick(Sender: TObject);
    procedure breturnClick(Sender: TObject);
    procedure DBGrid1TitleClick(Column: TColumn);
    procedure bsaveClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure rqKeyPress(Sender: TObject; var Key: Char);
    procedure BqueryClick(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure bnewClick(Sender: TObject);
    procedure DBGrid5DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid5TitleClick(Column: TColumn);
    procedure txhKeyPress(Sender: TObject; var Key: Char);
    procedure tczlKeyPress(Sender: TObject; var Key: Char);
    procedure twclKeyPress(Sender: TObject; var Key: Char);
    procedure tbzKeyPress(Sender: TObject; var Key: Char);
    procedure tslChange(Sender: TObject);
  private
    { Private declarations }
      rzczy,rzsj,rzjsj,rzcsj:string;
      errzt: integer;
      errcode:boolean;
  commandstring,commandstringq: string;
  function check():boolean;
  function save():boolean;
  function errdelete():boolean;
  function checkcs():boolean;
  public
    { Public declarations }
  end;

var
  Frmddch: TFrmddch;

implementation

uses unit28, Unit1, Unit16, xtfz;

{$R *.dfm}

procedure TFrmddch.tslKeyPress(Sender: TObject; var Key: Char);
begin
if not (key in['0'..'9',#8,#13,'.','-']) then
begin
key:=#0;
help.caption:='   请输入数字!';
end;
if key=#13 then tczl.SetFocus;
end;

function TFrmddch.check:boolean;
begin
  result:=true;
  if trim(txh.Text)='' then
    begin
    showmessage('请您输入序号!');
    result:=false;
    txh.SetFocus;
    exit;
    end;
  if trim(tsl.Text)='' then
    begin
    showmessage('请您输入出货数量!');
    result:=false;
    tsl.SetFocus;
    exit;
    end;
  if trim(tczl.Text)='' then
   begin
    showmessage('出货总数量不能为空!');
    result:=false;
    tczl.SetFocus;
    exit;
    end;
  if trim(twcl.Text)='' then
   begin
    showmessage('未出货数量不能为空!');
    result:=false;
    twcl.SetFocus;
    exit;
    end;
    end;

function TFrmddch.save:boolean;
var
sqlstr,relation,cx,dx:string;
 begin
 relation:=' = ''' ;
 cx:='';
 dx:=' ''';
 txh.Text:=trim(txh.Text);
 tsl.Text:=trim(tsl.Text);
 tczl.Text:=trim(tczl.Text);
 twcl.Text:=trim(twcl.Text);
 tbz.Text:=trim(tbz.Text);
 errcode:=true;
 errzt:=1;
 try
if not DataModule1.ClientDataSet19.Locate('xh',txh.Text,[]) then
   begin
 DataModule1.clientdataset19.Edit;
 DataModule1.ClientDataSet19.First;
 DataModule1.clientdataset19.Insert;
 DataModule1.clientdataset19.FieldByName('ddh').AsString:=DataModule1.clientdataset17.FieldByName('ddh').AsString;
 DataModule1.clientdataset19.FieldByName('xh').AsString:=txh.Text;
 DataModule1.clientdataset19.FieldByName('rq').AsDateTime:=rq.DateTime;
 DataModule1.clientdataset19.FieldByName('sl').AsString:=tsl.Text;
 DataModule1.clientdataset19.FieldByName('czl').AsString:=tczl.Text;
 DataModule1.clientdataset19.FieldByName('wcl').AsString:=twcl.Text;
if wgzt.Checked then DataModule1.clientdataset19.FieldByName('wgzt').AsString:='1';
 DataModule1.clientdataset19.FieldByName('bz').AsString:=tbz.Text;
 DataModule1.clientdataset19.FieldByName('czy').AsString:=trim(form1.StatusBar1.Panels[4].text);
 DataModule1.clientdataset19.ApplyUpdates(-1);
 end;
 if wgzt.Checked then
begin
sqlstr:='select * from dbo.ddb';
sqlstr:=sqlstr+' where (ddh' +relation+cx+DataModule1.ClientDataSet19.fieldbyname('ddh').AsString+cx+''')';
DataModule1.ClientDataSet28.Close;
DataModule1.ClientDataSet28.CommandText:=commandstringq;
DataModule1.ClientDataSet28.Open;
sqlstr:='update dbo.ddb set wgzt'+relation+'1'+dx;
sqlstr:=sqlstr+' where (ddh' +relation+cx+DataModule1.ClientDataSet19.fieldbyname('ddh').AsString+cx+''')';
DataModule1.ClientDataSet28.CommandText:=sqlstr;
DataModule1.ClientDataSet28.Execute;
DataModule1.ClientDataSet28.Active:=false;
end;
 errcode:=false;
 errzt:=0;
 except
  errcode:=true;
  errzt:=1;
  showmessage('数据库没有打开!');
  end;
end;

procedure TFrmddch.bcancelClick(Sender: TObject);
var
i,i1:integer;
begin
bsave.Enabled:=false;
bcancel.Enabled:=false;
bprint.Enabled:=false;
bquery.Enabled:=true;
bnew.Enabled:=false;
txh.Text:='';
tsl.Text:='';
tczl.Text:='';
twcl.Text:='';
tbz.Text:='';
dbgrid1.Enabled:=true;
help.Caption:='  继续录入请您重新选择!';
end;

procedure TFrmddch.bprintClick(Sender: TObject);
begin
help.Caption:='   暂不提供打印功能!';
end;

procedure TFrmddch.breturnClick(Sender: TObject);
begin
try
rzcsj:=datetimetostr(now);
form16.WriteTorz(rzczy,rzsj,rzjsj,rzcsj);
DataModule1.ClientDataSet17.IndexFieldNames:='';
if clientdataset1.Active then ClientDataSet1.Active:=false;
if DataModule1.clientdataset17.Active then  DataModule1.ClientDataSet17.Active:=false;
if DataModule1.clientdataset19.Active then  DataModule1.ClientDataSet19.Active:=false;
except
showmessage('数据库没有打开!');
end;
close;
end;

procedure TFrmddch.DBGrid1TitleClick(Column: TColumn);
var i : integer;
begin
for i:= 1 to DBGrid1.Columns.Count do
begin
//恢复所有标题字体为默认
DBGrid1.Columns[i-1].Title.Font.Color := clBlue;
DBGrid1.Columns[i-1].Title.Font.Style := [];
end;
if DataModule1.ClientDataSet17.IndexFieldNames<>(Column.FieldName) then //判断原排序方式
begin
DataModule1.ClientDataSet17.IndexFieldNames:= Column.FieldName;
Column.Title.Font.Color := clRed; //改变标题行字体为红色，表示当前的排序方式为升序
Column.Title.Font.Style := [fsBold];
end;
end;

procedure TFrmddch.bsaveClick(Sender: TObject);
var
datestr:string;
begin
if not bsave.Enabled then exit;
bsave.Enabled:=false;
bcancel.Enabled:=false;
errcode:=true;
errzt:=1;
if not check then
begin
bsave.Enabled:=true;
bcancel.Enabled:=true;
 exit;
 end;
datestr:=frmxtfz.checkfzrq(formatdatetime('yyyy-mm-dd',rq.date));
if datestr<>'' then
begin
help.Caption:='  封账日期为'+datestr+',您不能添加封账日期前的数据';
exit;
end;
if  DataModule1.ClientDataSet19.Locate('xh',txh.Text,[]) then
begin
help.Caption:='  该序号已经存在,请您修改序号后保存!';
exit;
end;
try
save;
if errcode or (errzt<>0) then save;
if errcode or (errzt<>0) then save;
if errcode or (errzt<>0) then save;
if errcode or (errzt<>0) then
begin
showmessage('   数据库在保存主记录时失败,请您稍后重新保存!');
errdelete;
bsave.Enabled:=true;
bcancel.Enabled:=true;
exit;
end;
help.Caption:='   记录订单出货操作成功!' ;
txh.Text:='';
tsl.Text:='';
tczl.Text:='';
twcl.Text:='';
tbz.Text:='';
bprint.Enabled:=true;
bnew.Enabled:=true;
bnew.SetFocus;
pz.Enabled:=false;
except
bsave.Enabled:=true;
bcancel.Enabled:=true;
showmessage('     记录订单出货时出现了系统无法识别的错误,请您主动辨别该错误!');
end;
end;

function tFrmddch.errdelete:boolean;
var
relation,cx:string;
begin
 relation:=' = ''';
 cx:='';
    try
  commandstring:='delete from dbo.ddchb';
  commandstring:=commandstring+' where (dbo.ddchb.ddh'+relation+cx+DataModule1.ClientDataSet17.fieldbyname('ddh').AsString+cx+''')';
  commandstring:=commandstring+' and (dbo.ddchb.xh'+relation+cx+txh.Text+cx+''')';
  DataModule1.ClientDataSet19.CommandText:=commandstring;
  DataModule1.ClientDataSet19.Execute;
  except
  showmessage('数据库没有打开')
  end;
  end;

procedure TFrmddch.FormActivate(Sender: TObject);
var
commandstring,relation,cx,str:string;
begin
rzjsj:=datetimetostr(now);
rzczy:=form1.StatusBar1.Panels[4].Text;
rzsj:='订单出货录入';
rq.DateTime:=date;
sq.DateTime:=date-30;
sz.DateTime:=date;
jq.DateTime:=date;
jz.DateTime:=date+30;
help.Caption:='';
bquery.Enabled:=true;
bnew.Enabled:=false;
bsave.Enabled:=false;
bcancel.Enabled:=false;
bprint.Enabled:=false;
dbgrid1.Enabled:=true;
pz.Enabled:=true;
help.Caption:='  请您点击< 查询>按钮开始查询订单记录!';
end;

procedure TFrmddch.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
DataModule1.ClientDataSet17.IndexFieldNames:='';
DataModule1.ClientDataSet19.IndexFieldNames:='';
if clientdataset1.Active then ClientDataSet1.Active:=false;
if DataModule1.clientdataset17.Active then  DataModule1.ClientDataSet17.Active:=false;
if DataModule1.clientdataset19.Active then  DataModule1.ClientDataSet19.Active:=false;
if rzcsj<>'' then exit;
rzcsj:=datetimetostr(now);
form16.WriteTorz(rzczy,rzsj,rzjsj,rzcsj);
except
clientdataset1.EnableControls;
showmessage('数据库没有打开!');
end;
close;
end;

procedure TFrmddch.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
 if DataModule1.ClientDataSet17.FieldByName('shbj').AsInteger=1 then
begin
dbgrid1.Canvas.Font.Color:=clred;
dbgrid1.Canvas.Brush.Color:=clyellow;
end
else
begin
dbgrid1.Canvas.Font.Color:=clblue;
dbgrid1.Canvas.Brush.Color:=clwhite;
end;
dbgrid1.DefaultDrawColumnCell(rect,datacol,column,state);
if   ((State = [gdSelected])   or   (State   =   [gdSelected,   gdFocused]))   then
   begin