fy.~pas

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

unit fy;

interface

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

type
  TFrmfy = class(TForm)
    Pz: TPanel;
    Label25: TLabel;
    Label26: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label41: TLabel;
    help: TLabel;
    GroupBox4: TGroupBox;
    DBGrid1: TDBGrid;
    rq: TDateTimePicker;
    tbxr: TEdit;
    tzy: TEdit;
    tbh: TEdit;
    Label1: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    tbz: TEdit;
    tje: TEdit;
    Label8: TLabel;
    Label6: TLabel;
    fb: TDBLookupComboBox;
    SpeedButton1: TSpeedButton;
    Pd: TPanel;
    bnew: TBitBtn;
    bsave: TBitBtn;
    bcancel: TBitBtn;
    bprint: TBitBtn;
    breturn: TBitBtn;
    DBGrid4: TDBGrid;
    fylb: TEdit;
    Bquery: TBitBtn;
    pq: TPanel;
    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;
    GroupBox1: TGroupBox;
    DBGrid5: TDBGrid;
    fz: TDBLookupComboBox;
    tddh: TEdit;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    procedure tjeKeyPress(Sender: TObject; var Key: Char);
    procedure tbhKeyPress(Sender: TObject; var Key: Char);
    procedure rqKeyPress(Sender: TObject; var Key: Char);
    procedure tbxrKeyPress(Sender: TObject; var Key: Char);
    procedure tzyKeyPress(Sender: TObject; var Key: Char);
    procedure fylbKeyPress(Sender: TObject; var Key: Char);
    procedure tbzKeyPress(Sender: TObject; var Key: Char);
    procedure tbxrChange(Sender: TObject);
    procedure bnewClick(Sender: TObject);
    procedure bcancelClick(Sender: TObject);
    procedure bprintClick(Sender: TObject);
    procedure breturnClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure DBGrid4DblClick(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 tddhKeyPress(Sender: TObject; var Key: Char);
    procedure SpeedButton1Click(Sender: TObject);
    procedure fbKeyPress(Sender: TObject; var Key: Char);
    procedure fylbChange(Sender: TObject);
    procedure BqueryClick(Sender: TObject);
    procedure DBGrid5DblClick(Sender: TObject);
    procedure DBGrid5DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid5TitleClick(Column: TColumn);
    procedure fzKeyPress(Sender: TObject; var Key: Char);
    procedure SpeedButton3Click(Sender: TObject);
  private
    { Private declarations }
      rzczy,rzsj,rzjsj,rzcsj:string;
      errzt: integer;
      errcode:boolean;
  commandstring,commandstringq: string;
  function check():boolean;
  function khchange():boolean;
  function save():boolean;
  function errdelete():boolean;
  public
    { Public declarations }
  end;

var
  Frmfy: TFrmfy;

implementation

uses unit28, Unit1, Unit16, fylb, xtfz;

{$R *.dfm}

procedure TFrmfy.tjeKeyPress(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 tddh.SetFocus;
end;

procedure TFrmfy.tbhKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then rq.SetFocus;
end;

procedure TFrmfy.rqKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then fb.SetFocus;
end;

procedure TFrmfy.tbxrKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tzy.SetFocus;
end;

procedure TFrmfy.tzyKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then fylb.SetFocus;
end;

procedure TFrmfy.fylbKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tje.SetFocus;
end;

procedure TFrmfy.tbzKeyPress(Sender: TObject; var Key: Char);
begin
if not bsave.Enabled then exit;
if key=#13 then bsave.SetFocus;
end;

function TFrmfy.check:boolean;
begin
  result:=true;
  if trim(tddh.Text)='' then
    begin
    showmessage('请选择一个订单号，如果没有出现在列表中，请您添加进来!');
    result:=false;
    tddh.SetFocus;
    exit;
    end;
  if trim(fylb.Text)='' then
   begin
    showmessage('请您选择费用类别!');
    result:=false;
    fylb.SetFocus;
    exit;
    end;
  if trim(tje.Text)='' then
   begin
    showmessage('金额不能为空!');
    result:=false;
    tje.SetFocus;
    exit;
    end;
    end;

function tFrmfy.khchange:boolean;
    var
    relation,cx:string;
    begin
    relation:=' = ''';
    cx:='';
    commandstring:='select top 10 * from dbo.scfyb';
    if trim(tbxr.Text)<>'' then
    begin
    if trim(fz.Text)<>'' then
    begin
    commandstring:=commandstring+' where (fz'+relation+cx+trim(fz.Text)+cx+''')';
    if trim(fb.Text)<>'' then commandstring:=commandstring+' and (fb'+relation+cx+trim(fb.Text)+cx+''')';
    commandstring:=commandstring+' and (bxr'+relation+cx+trim(tbxr.Text)+cx+''')'+' order by fyh desc';;
    DataModule1.ClientDataSet26.Close;
    DataModule1.ClientDataSet26.CommandText:=commandstring;
    DataModule1.ClientDataSet26.Open;
    end
    else
    begin
    commandstring:=commandstring+' where (bxr'+relation+cx+trim(tbxr.Text)+cx+''')'+' order by fyh desc';;
    DataModule1.ClientDataSet26.Close;
    DataModule1.ClientDataSet26.CommandText:=commandstring;
    DataModule1.ClientDataSet26.Open;
    end;
    end;
    end;


procedure TFrmfy.tbxrChange(Sender: TObject);
begin
khchange;
end;

function TFrmfy.save:boolean;
 begin
 try
 tbh.Text:=trim(tbh.Text);
 tbxr.Text:=trim(tbxr.text);
 tzy.Text:=trim(tzy.Text);
 tje.Text:=trim(tje.Text);
 tbz.Text:=trim(tbz.Text);
 errcode:=true;
 errzt:=1;
if not DataModule1.ClientDataSet26.Locate('fyh',tbh.Text,[]) then
   begin
 DataModule1.clientdataset26.Edit;
 DataModule1.ClientDataSet26.First;
 DataModule1.ClientDataSet26.Insert;
 DataModule1.ClientDataSet26.FieldByName('fyh').AsString:=tbh.Text;
 DataModule1.ClientDataSet26.FieldByName('ddh').AsString:=tddh.Text;
 DataModule1.ClientDataSet26.FieldByName('rq').AsDateTime:=rq.Date;
 DataModule1.ClientDataSet26.FieldByName('fb').AsString:=fb.Text;
 DataModule1.ClientDataSet26.FieldByName('fz').AsString:=fz.Text;
 DataModule1.ClientDataSet12.FieldByName('bxr').AsString:=tbxr.Text;
 DataModule1.ClientDataSet26.FieldByName('zy').AsString:=tzy.Text;
 DataModule1.ClientDataSet26.FieldByName('fylb').AsString:=fylb.Text;
 DataModule1.ClientDataSet26.FieldByName('je').AsString:=tje.Text;
 DataModule1.ClientDataSet26.FieldByName('bz').AsString:=tbz.Text;
 DataModule1.ClientDataSet26.FieldByName('czy').AsString:=trim(form1.StatusBar1.Panels[4].text);
 DataModule1.ClientDataSet26.ApplyUpdates(-1);
 end;
 errcode:=false;
 errzt:=0;
 except
  errcode:=true;
  errzt:=1;
  showmessage('数据库没有打开!');
  end;
end;

procedure TFrmfy.bnewClick(Sender: TObject);
begin
try
help.Caption:='';
bnew.Enabled:=false;
bsave.Enabled:=true;
bcancel.Enabled:=true;
bprint.Enabled:=false;
pz.Enabled:=true;
rq.SetFocus;
fz.KeyValue:='';
tbxr.Text:='';
tzy.Text:='';
tje.Text:='';
tbz.Text:='';
if not DataModule1.ClientDataSet11.Active then DataModule1.clientdataset11.Active:=true;
form1.dorandombh;
DataModule1.clientdataset11.Refresh;
tbh.Text:=floattostr(DataModule1.clientdataset11.FieldByName('fyh').AsFloat)+form1.randombh+form1.tbh.Text;
help.Caption:='  请您输入数据!';
pz.Enabled:=true;
except
showmessage('数据库没有打开!')
end;
end;

procedure TFrmfy.bcancelClick(Sender: TObject);
var
i,i1:integer;
begin
try
bsave.Enabled:=false;
bcancel.Enabled:=false;
bnew.Enabled:=true;
bprint.Enabled:=false;
bnew.SetFocus;
fz.KeyValue:='';
tbxr.Text:='';
tzy.Text:='';
tje.Text:='';
tbz.Text:='';
help.Caption:='  要记录请点击〈新增〉按钮!';
pz.Enabled:=false;
except
showmessage('数据库没有打开!')
end;
end;

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

procedure TFrmfy.breturnClick(Sender: TObject);
begin
try
rzcsj:=datetimetostr(now);
form16.WriteTorz(rzczy,rzsj,rzjsj,rzcsj);
DataModule1.ClientDataSet26.IndexFieldNames:='';
if DataModule1.ClientDataSet26.Active then  DataModule1.ClientDataSet12.Active:=false;
DataModule1.ClientDataSet17.IndexFieldNames:='';
if DataModule1.ClientDataSet17.Active then  DataModule1.ClientDataSet17.Active:=false;
if DataModule1.clientdataset1.Active then  DataModule1.ClientDataSet1.Active:=false;
if DataModule1.clientdataset2.Active then  DataModule1.ClientDataSet2.Active:=false;
if DataModule1.clientdataset16.Active then  DataModule1.ClientDataSet16.Active:=false;
except
showmessage('数据库没有打开!');
end;
close;
end;

procedure TFrmfy.SpeedButton2Click(Sender: TObject);
begin
fz.KeyValue:='';
end;

procedure TFrmfy.DBGrid4DblClick(Sender: TObject);
begin
if not DataModule1.ClientDataSet16.Active then exit;
if DataModule1.ClientDataSet16.RecordCount>0 then
begin
fylb.Text:=DataModule1.ClientDataSet16.FieldByName('fylb').AsString;
tje.SetFocus;
end;
end;

procedure TFrmfy.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.ClientDataSet26.IndexFieldNames<>(Column.FieldName) then //判断原排序方式
begin
DataModule1.ClientDataSet26.IndexFieldNames:= Column.FieldName;
Column.Title.Font.Color := clRed; //改变标题行字体为红色，表示当前的排序方式为升序
Column.Title.Font.Style := [fsBold];
end;
end;

procedure TFrmfy.bsaveClick(Sender: TObject);
var
datestr:string;
begin
datestr:=frmxtfz.checkfzrq(formatdatetime('yyyy-mm-dd',rq.date));
if datestr<>'' then
begin
help.Caption:='  封账日期为'+datestr+'您不能添加封账日期前的数据';
exit;
end;
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;
form1.fylb:=trim(fylb.Text);
frmfylb.checkfylb(form1.fylb);
if form1.fylb='' then
begin
bsave.Enabled:=true;
bcancel.Enabled:=true;
fylb.SetFocus;
help.Caption:='  该费用类别不存在,请您输入正确的费用类别!';
 exit;
 end;
form1.fylb:='';
try
form1.dorandombh;
DataModule1.clientdataset11.Refresh;
DataModule1.ClientDataSet11.First;
tbh.Text:=floattostr(DataModule1.clientdataset11.FieldByName('fyh').AsFloat)+form1.randombh+form1.tbh.Text;
DataModule1.ClientDataSet11.Edit;
DataModule1.ClientDataSet11.FieldByName('fyh').AsFloat:= DataModule1.ClientDataSet11.FieldByName('fyh').AsFloat+1;
DataModule1.ClientDataSet11.ApplyUpdates(-1);
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;
fz.KeyValue:='';
tbxr.Text:='';
tzy.Text:='';
tje.Text:='';
tbz.Text:='';
tddh.Text:='';
bnew.Enabled:=true;
bprint.Enabled:=true;
bnew.SetFocus;
pz.Enabled:=false;
help.Caption:='   记录管理费用操作成功!' ;
except
bsave.Enabled:=true;
bcancel.Enabled:=true;
showmessage('     记录费用时出现了系统无法识别的错误,请您主动辨别该错误!');
end;
end;

function tFrmfy.errdelete:boolean;
var