jb.pas

集成酒店桑拿食管管理的完整程序

unit jb;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Mask, Db, DBTables, ComCtrls;

type
  Tjbform = class(TForm)
    Label2: TLabel;
    newbc: TMaskEdit;
    Label3: TLabel;
    oldbc: TMaskEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    froom: TEdit;
    Label6: TLabel;
    zroom: TEdit;
    Label7: TLabel;
    lroom: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    fman: TEdit;
    fwoman: TEdit;
    Button1: TButton;
    Button2: TButton;
    q1: TQuery;
    Label10: TLabel;
    oldczy: TMaskEdit;
    Label11: TLabel;
    zdroom: TEdit;
    Label12: TLabel;
    Label13: TLabel;
    oldpass: TEdit;
    newczy: TEdit;
    Label14: TLabel;
    newpass: TEdit;
    Bevel2: TBevel;
    GroupBox3: TGroupBox;
    Label18: TLabel;
    regmannum: TEdit;
    Label19: TLabel;
    regrmnum: TEdit;
    Label20: TLabel;
    regwomannum: TEdit;
    Label26: TLabel;
    jbtime: TMaskEdit;
    oldname: TEdit;
    newname: TEdit;
    s3: TStoredProc;
    Label1: TLabel;
    regzdrm: TEdit;
    Bevel3: TBevel;
    Label4: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    oldxj: TEdit;
    oldcard: TEdit;
    oldgz: TEdit;
    oldmd: TEdit;
    Label21: TLabel;
    otherxj: TEdit;
    GroupBox4: TGroupBox;
    Label22: TLabel;
    newxj: TEdit;
    Label23: TLabel;
    newcard: TEdit;
    Label24: TLabel;
    Label25: TLabel;
    newgz: TEdit;
    newmd: TEdit;
    Animate1: TAnimate;
    s1: TStoredProc;
    s2: TStoredProc;
    Label27: TLabel;
    oldzp: TEdit;
    Label28: TLabel;
    newzp: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure jbtimeExit(Sender: TObject);
    procedure newbcKeyPress(Sender: TObject; var Key: Char);
    procedure newbcChange(Sender: TObject);
    procedure newbcExit(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure oldbcChange(Sender: TObject);
    procedure oldczyExit(Sender: TObject);
    procedure oldpassExit(Sender: TObject);
    procedure newczyExit(Sender: TObject);
    procedure newpassExit(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure oldczyEnter(Sender: TObject);
    procedure newczyEnter(Sender: TObject);
    procedure otherxjExit(Sender: TObject);
    procedure newxjExit(Sender: TObject);
    procedure newcardExit(Sender: TObject);
    procedure newgzExit(Sender: TObject);
    procedure newmdExit(Sender: TObject);
    procedure newzpExit(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  jbform: Tjbform;

implementation
uses dataproc;

{$R *.DFM}

procedure formini;
begin
with jbform do
  begin
  jbtime.text:=datetimetostr(now);
  oldczy.text:=curper.code;
  oldname.text:=curper.name;
  oldbc.text:=curper.curbc;
  if trim(curper.curbc)='1' then
     newbc.text:='2'
  else
     newbc.text:='1';
  newczy.Text:='';
  newname.text:='';
  end;
end;

procedure info ;
begin
with jbform do
  begin
  s1.Prepare;
  s1.ExecProc ;
  s2.ParamByName ('@ilsdate').asstring:=datetostr(date());
  s2.Prepare;
  s2.ExecProc ;
  s3.Prepare;
  s3.ExecProc ;
  regrmnum.text:=inttostr(s3.parambyname('@ormnum').asinteger);
  regzdrm.text:=inttostr(s3.parambyname('@ozdrmnum').asinteger);
  regmannum.text:=inttostr(s3.parambyname('@omannum').asinteger);
  regwomannum.text:=inttostr(s3.parambyname('@owomannum').asinteger);
  froom.text:=inttostr(s3.parambyname('@okroom').asinteger);
  zroom.text:=inttostr(s3.parambyname('@odroom').asinteger);
  lroom.text:=inttostr(s3.parambyname('@orroom').asinteger);
  zdroom.text:=inttostr(s3.parambyname('@owroom').asinteger);
  fman.text:=inttostr(s3.parambyname('@oman').asinteger);
  fwoman.text:=inttostr(s3.parambyname('@owoman').asinteger);
  q1.Active :=false;
  q1.sql.clear;
  q1.sql.add('select * from lslsbcinfo');
  q1.Prepare;
  q1.open;
  oldxj.Text :=floattostr(q1.fieldbyname('xj').asfloat);
  oldzp.text :=floattostr(q1.fieldbyname('zp').asfloat);
  oldcard.text:=floattostr(q1.fieldbyname('card').asfloat);
  oldgz.text:=floattostr(q1.fieldbyname('gz').asfloat);
  oldmd.text:=floattostr(q1.fieldbyname('md').asfloat);
  q1.active:=false;
  otherxj.text:='0';
  newxj.text:=oldxj.Text;
  newzp.Text:=oldzp.Text;
  newcard.text:=oldcard.text;
  newgz.text:=oldgz.text;
  newmd.text:=oldmd.text;
  end;
end;

procedure Tjbform.FormCreate(Sender: TObject);
begin
  shortdateformat:='yyyy-mm-dd';
  formini;
  info;
end;

procedure Tjbform.Button2Click(Sender: TObject);
begin
  jbform.Close;
end;

procedure Tjbform.jbtimeExit(Sender: TObject);
var
  rq:tdatetime;
begin
  try
     rq:=strtodatetime(jbtime.text);
  except
     showmessage('时间不对');
     jbtime.SetFocus ;
  end;
end;

procedure Tjbform.newbcKeyPress(Sender: TObject; var Key: Char);
begin
  if ((key<>'1') and (key<>'2')) then
     key:=char(0);
end;

procedure Tjbform.newbcChange(Sender: TObject);
begin
  if trim(newbc.text)='1' then
     oldbc.text:='2';
  if trim(newbc.text)='2' then
     oldbc.text:='1';
end;

procedure Tjbform.newbcExit(Sender: TObject);
begin
  if (trim(newbc.text)<>'1') and (trim(newbc.text)<>'2') then
     newbc.setfocus;
end;

procedure Tjbform.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=13 then
     selectnext(activecontrol,true,true);
  if key=27 then
     jbform.close;
end;

procedure Tjbform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  q1.free;
  s1.free;
  s2.free;
  s3.free;
end;


procedure Tjbform.oldbcChange(Sender: TObject);
begin
  if trim(oldbc.text)='1' then
     newbc.text:='2';
  if trim(oldbc.text)='2' then
     newbc.text:='1';
end;

procedure Tjbform.oldczyExit(Sender: TObject);
var
  aa:array[0..1] of string;
begin
  if length(trim(oldczy.text))>0 then
     begin
     aa[0]:='';
     getvalue(aa,'select code,name from stuff where isreg=1 and code="'+trim(oldczy.text)+'"');
     if length(trim(aa[0]))=0 then
        begin
        showmessage('操作员错误');
        oldczy.setfocus;
        exit;
        end
     else
        begin
        oldname.text:=trim(aa[1]);
        oldpass.setfocus;
        end;
     end
   else
     oldczy.setfocus;
end;

procedure Tjbform.oldpassExit(Sender: TObject);
var
  aa:array[0..1] of string;
begin
  aa[0]:='';
  getvalue(aa,'select code from stuff where (code="'+trim(oldczy.text)+'" and pass="'+trim(oldpass.text)+'")');
  if length(trim(aa[0]))=0 then
     oldpass.setfocus;
end;

procedure Tjbform.newczyExit(Sender: TObject);
var
  aa:array[0..1] of string;
begin
  if length(trim(newczy.text))>0 then
     begin
     aa[0]:='';
     getvalue(aa,'select code,name from stuff where isreg=1 and code="'+trim(newczy.text)+'"');
     if length(trim(aa[0]))=0 then
        begin
        showmessage('操作员错误');
        newczy.setfocus;
        exit;
        end
     else
        begin
        newname.text:=trim(aa[1]);
        newpass.setfocus;
        end;
     end
   else
     newczy.setfocus;
end;

procedure Tjbform.newpassExit(Sender: TObject);
var
  aa:array[0..1] of string;
begin
  aa[0]:='';
  getvalue(aa,'select code from stuff where (code="'+trim(newczy.text)+'" and pass="'+trim(newpass.text)+'")');
  if length(trim(aa[0]))=0 then
     newpass.setfocus;
end;

procedure Tjbform.Button1Click(Sender: TObject);
var
  yjmoney:double;
begin
  if trim(oldbc.Text)=trim(newbc.text) then
     begin
     showmessage('班次相同');
     oldbc.SetFocus ;
     exit
     end;
  if length(trim(oldczy.text))=0 then
     begin
     oldczy.SetFocus ;
     exit;
     end;
  if length(trim(newczy.text))=0 then
     begin
     newczy.SetFocus ;
     exit;
     end;
  if trim(oldczy.text)=trim(newczy.text) then
     begin
     showmessage('操作员不能相同');
     newczy.SetFocus ;
     exit;
     end;
  q1.Active :=false;
  q1.sql.clear;
  q1.sql.add('insert into changebc values(:ptm,:pnewbc,:pnewregid,:poldbc,:poldregid,:prm,:pzdrm,:pman,:pwoman,:pxj,:pzp,:pcard,:pgz,:pmd)');
  q1.ParamByName ('ptm').asdatetime:=strtodatetime(trim(jbtime.Text));
  q1.ParamByName ('pnewbc').asstring:=trim(newbc.text);
  q1.ParamByName ('pnewregid').asstring:=trim(newczy.text);
  q1.ParamByName ('poldbc').asstring:=trim(oldbc.text);
  q1.ParamByName ('poldregid').asstring:=trim(oldczy.text);
  q1.ParamByName ('prm').asinteger:=strtoint(trim(regrmnum.text));
  q1.ParamByName ('pzdrm').asinteger:=strtoint(trim(regzdrm.text));
  q1.ParamByName ('pman').asinteger:=strtoint(trim(regmannum.text));
  q1.ParamByName ('pwoman').asinteger:=strtoint(trim(regwomannum.text));
  q1.ParamByName ('pxj').asfloat:=strtofloat(trim(oldxj.text))+strtofloat(trim(otherxj.text));
  q1.ParamByName ('pzp').asfloat:=strtofloat(trim(oldzp.text));
  q1.parambyname ('pcard').asfloat:=strtofloat(trim(oldcard.text));
  q1.parambyname ('pgz').asfloat:=strtofloat(trim(oldgz.text));
  q1.parambyname ('pmd').asfloat:=strtofloat(trim(oldmd.text));
  q1.Prepare;
  q1.ExecSQL ;
  q1.Active :=false;
  q1.sql.clear;
  q1.sql.add('select sum(deposit) as yy from deposit');
  q1.Prepare;
  q1.open;
  yjmoney:=q1.fieldbyname('yy').asfloat;
  q1.Active :=false;
  q1.sql.clear;
  q1.sql.add('update curbcinfo set room=0,man=0,woman=0,zdroom=0,xj=:plsxj,zp=:plszp,card=:plscard,gz=:plsgz,md=:plsmd,yj=:pyj');
  q1.ParamByName ('plsxj').asfloat:=strtofloat(trim(newxj.text));
  q1.ParamByName ('plszp').asfloat:=strtofloat(trim(newzp.text));
  q1.parambyname ('plscard').asfloat:=strtofloat(trim(newcard.text));
  q1.parambyname ('plsgz').asfloat:=strtofloat(trim(newgz.text));
  q1.parambyname ('plsmd').asfloat:=strtofloat(trim(newmd.text));
  q1.ParamByName ('pyj').asfloat:=yjmoney;
  q1.Prepare;
  q1.ExecSQL;
  q1.Active :=false;
  showmessage('交班成功');
end;

procedure Tjbform.oldczyEnter(Sender: TObject);
begin
   oldpass.text:='';
end;

procedure Tjbform.newczyEnter(Sender: TObject);
begin
   newpass.text:='';
end;


procedure Tjbform.otherxjExit(Sender: TObject);
var
  aa:double;
begin
   try
     aa:=strtofloat(trim(otherxj.text));
     newxj.text:=floattostr(strtofloat(trim(oldxj.text))+aa);
   except
     showmessage('数字错误');
     otherxj.SetFocus
   end;
end;

procedure Tjbform.newxjExit(Sender: TObject);
var
  aa:double;
begin
  try
     aa:=strtofloat(trim(newxj.text));
  except
     showmessage('数字错误');
     newxj.setfocus;
  end;
end;

procedure Tjbform.newcardExit(Sender: TObject);
var
  aa:double;
begin
  try
     aa:=strtofloat(trim(newcard.text));
  except
     showmessage('数字错误');
     newcard.setfocus;
  end;
end;

procedure Tjbform.newgzExit(Sender: TObject);
var
  aa:double;
begin
  try
     aa:=strtofloat(trim(newgz.text));
  except
     showmessage('数字错误');
     newgz.setfocus;
  end;
end;

procedure Tjbform.newmdExit(Sender: TObject);
var
  aa:double;
begin
  try
     aa:=strtofloat(trim(newmd.text));
  except
     showmessage('数字错误');
     newmd.setfocus;
  end;
end;

procedure Tjbform.newzpExit(Sender: TObject);
var
  aa:double;
begin
  try
    aa:=strtofloat(trim(newzp.text));
  except
    showmessage('数字错误');
    newzp.SetFocus ;
  end;
end;

end.