qtdj.pas

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

  j:=14;
  ss:='';
  for i:=1 to mansygrid.rowcount-1 do
     if  (length(trim(mansygrid.cells[0,i]))<>0) then
       begin
          aa[0]:='';
          getvalue(aa,'select status from mansan where roomno="'+trim(mansygrid.cells[0,i])+'"');
          if (aa[0]<>'0') or (aa[0]='') then
             begin
               if j>i then  j:=i   ;
               ss:=ss+mansygrid.cells[0,i]+'  ';
             end
       end;
  if ss<>'' then
     begin
       showmessage('男散号 '+ss+' 非法!');
       mansygrid.row:=j;
       mansygrid.setfocus;
       exit;
    end;
  ss:='';
  j:=14;
  for i:=1 to mansygrid.rowcount-1 do
  begin
      ss:=mansygrid.cells[0,i];
      for y:=i+1 to mansygrid.rowcount-1  do
          if (mansygrid.cells[0,y]=ss) and (length(trim(ss))>0)then
          begin
             if j>i then  j:=i   ;
             showmessage('男散号 '+ss+' 重号!');
             mansygrid.row:=j;
             mansygrid.setfocus;
             exit;
          end
  end;
end;

procedure Tdj.womansygridExit(Sender: TObject);
var
  aa:array [0..1] of string;
  i,j,y:integer;
  ss:string;
begin
  j:=14;
  ss:='';
  for i:=1 to womansygrid.rowcount-1 do
     if  (length(trim(womansygrid.cells[0,i]))<>0) then
       begin
          aa[0]:='';
          getvalue(aa,'select status from womansan where roomno="'+trim(womansygrid.cells[0,i])+'"');
          if (aa[0]<>'0') or (aa[0]='') then
             begin
               if j>i then  j:=i   ;
               ss:=ss+womansygrid.cells[0,i]+'  ';
             end
       end;
  if ss<>'' then
     begin
       showmessage('女散号 '+ss+' 非法!');
       womansygrid.row:=j;
       womansygrid.setfocus;
       exit;
    end;
  ss:='';
  j:=14;
  for i:=1 to womansygrid.rowcount-1 do
  begin
      ss:=womansygrid.cells[0,i];
      for y:=i+1 to womansygrid.rowcount-1  do
          if (womansygrid.cells[0,y]=ss) and (length(trim(ss))>0)then
          begin
             if j>i then  j:=i   ;
             showmessage('女散号 '+ss+' 重号!');
             womansygrid.row:=j;
             womansygrid.setfocus;
             exit;
          end
  end

end;


procedure Tdj.MaskEdit1Exit(Sender: TObject);
var
  rq:tdatetime;
begin
  try
     rq:=strtodatetime(maskedit1.text);
  except
     messagedlg('时间不对',mtInformation,[mbok],0);
     maskedit1.SetFocus ;
  end;
end;

procedure Tdj.sznoExit(Sender: TObject);
var
   aa:array[0..2] of string;
begin
   if szno.text<>'' then
     begin
     aa[0]:='';
   getvalue(aa,'select handno,accno from nowin where handno="'+szno.text+'"');
   if aa[0]='' then
        begin
          showmessage('此手号不存在');
          szno.SetFocus;
       end
   else
      szacc:=aa[1];
  end;
end;

Function checkgrid(tg:tstringgrid):boolean;
var
i: integer;
begin
   checkgrid:=false;
   for i:=1 to tg.rowcount-1 do
       if tg.cells[0,i]<>'' then
       begin
         checkgrid:=true;
         exit;
       end;
end;

procedure addman(tg:tstringgrid;const ptab:string;bj:boolean;sex:string);
var  i:integer;
begin
  for i:=1 to tg.rowcount-1  DO
  begin
      if tg.cells[0,i]='' then
          continue;
      with dj do
      begin
      q1.Active :=false;
      q1.RequestLive :=false;
      q1.sql.Clear ;
      q1.sql.add('insert into nowin(roomno,handno,accno,changeroom,isbj,sex,istime,isgz,gzno,iscard,cardno,acctime,isleft,money,csmoney,begtime,regid,djcode,sdjcode,guest)');
      q1.sql.add(' values(:proomno,:phandno,:paccno,:pchangeroom,:pisbj,:psex,:pistime,:pisgz,:pgzno,:piscard,:pcardno,:pacctime,:pisleft,:pmoney,:pcsmoney,:pbegintime,:pregid,:pdjcode,:psdjcode,:pguest)');
      if (rmno='') or (tg=rmnogrid) then
         q1.ParamByName ('proomno').asstring:=tg.cells[0,i]
      else
         q1.ParamByName ('proomno').asstring:=rmno;
      q1.ParamByName ('phandno').asstring :=tg.cells[0,i];
      q1.ParamByName ('paccno').asstring :=szacc;
      q1.ParamByName ('pchangeroom').asboolean :=false;
      q1.ParamByName ('pisbj').asboolean :=bj;
      q1.ParamByName ('psex').asstring :=sex;
      if tg=rmnogrid then
         begin
         if rmnogrid.Cells [1,i]='1' then
            q1.ParamByName ('pistime').asboolean:=true
         else
            q1.ParamByName ('pistime').asboolean:=false;
         end
      else
         q1.ParamByName ('pistime').asboolean:=false;
      if gz.Checked =true then
         begin
         q1.ParamByName ('pisgz').asboolean:=true;
         q1.ParamByName ('pgzno').asstring:=copy(trim(gzmc.text),1,6);
         end
      else
         begin
         q1.ParamByName ('pisgz').asboolean:=false;
         q1.ParamByName ('pgzno').asstring:='';
         end;
      if card.Checked =true then
         begin
         q1.ParamByName ('piscard').asboolean:=true;
         q1.ParamByName ('pcardno').asstring:=trim(cardh.text);
         end
      else
         begin
         q1.ParamByName ('piscard').asboolean:=false;
         q1.ParamByName ('pcardno').asstring:='';
         end;
      q1.ParamByName ('pacctime').asdatetime:=strtodatetime(maskedit1.text);
      q1.paramByName ('pisleft').asboolean:=false;
      q1.ParamByName ('pmoney').asfloat:=0;
      q1.parambyname ('pcsmoney').asfloat:=0;
      q1.ParamByName ('pbegintime').asdatetime:=strtodatetime(maskedit1.text);
      q1.ParamByName ('pregid').asstring :=copy(reg.text,1,6);
      q1.ParamByName ('pdjcode').asstring :=lsdjno;
      q1.ParamByName ('psdjcode').asstring :=pdj.Text;
      q1.ParamByName ('pguest').asinteger:=guest.Value ;
      q1.Prepare;
      q1.ExecSQL;
      q1.Active :=false;
      q1.sql.Clear ;
      q1.sql.add('update '+ptab+' set status=:pstatus where roomno=:proomno ');
      q1.ParamByName('pstatus').asstring :='1';
      q1.ParamByName('proomno').asstring :=tg.cells[0,i];
      q1.Prepare;
      q1.ExecSQL;
      q1.Active :=false;
      q1.RequestLive :=true;
    end;
   end;
end;

procedure Tdj.Button1Click(Sender: TObject);
var  i:integer;
     depo:double;
     rmflag:boolean;
     manflag:boolean;
     womanflag:boolean;
     lsacc:string;
     aa: array [0..2] of string;
begin
     depo:=0;
     rmflag:=checkgrid(rmnogrid);
     manflag:=checkgrid(mansygrid);
     womanflag:=checkgrid(womansygrid);
     if (not rmflag) and ( not manflag) and (not womanflag) then
     begin
        messagedlg('没有选择手号',mtInformation,[mbok],0);
        exit;
     end ;
     if  length(trim(pdj.text))=0 then
     begin
       showmessage('单号不能为空');
       pdj.SetFocus ;
       exit;
     end;
     if (card.Checked  =true) and (length(trim(cardh.text))=0) then
     begin
       showmessage('信誉卡号不能为空');
       cardh.SetFocus ;
       exit;
     end;
     if szno.text='' then
     begin
        accproc.Prepare;
        accproc.ExecProc;
        szacc:=accproc.ParamByName('@oAccno').asstring;
        accproc.Close;
     end ;

     djnoproc.prepare;
     djnoproc.execproc;
     lsdjno:=djnoproc.parambyname('@odjno').asstring;
     djnoproc.close;
   rmno:='';
   for i:=1 to rmnogrid.RowCount do
      if rmnogrid.cells[0,i]<>'' then
      begin
         rmno:=rmnogrid.cells[0,i];
         break;
      end;

   if rmflag then
       ADDman(rmnogrid,'room',true,'2');
   if manflag then
       ADDman(mansygrid,'mansan',false,'1');
   if womanflag then
       ADDman(womansygrid,'womansan',false,'0');

    q1.active:=false;
          q1.RequestLive :=false;
    q1.sql.clear;
    if szno.text<>''  then
    begin
       aa[0]:='';
       getvalue(aa,'select accno,deposit from account where accno="'+trim(szacc)+'"');
       if aa[0]<>'' then
          depo:=strtofloat(aa[1]);
       q1.sql.add('update account set deposit=:pdeposit where accno=:paccno');
       q1.ParamByName('pdeposit').asfloat:=depo+yj.value;
    end
    else
    begin
      q1.sql.add('insert into account values(:paccno,:pdeposit,0)');
      q1.ParamByName('pdeposit').asfloat:=yj.value;
    end ;
    q1.ParamByName('paccno').asstring:=szacc;
    q1.prepare;
    q1.ExecSQL ;


    //************database is deposit*****************//
    //************************************************//
    if yj.value>0 then
    begin
      q1.Active :=false;
      q1.sql.clear;
      q1.sql.add('insert into deposit values(:paccno,:pdeposit,:pdeposittime)');
      q1.ParamByName ('paccno').asstring:=szacc;
      q1.ParamByName ('pdeposit').asfloat:=yj.value;
      q1.ParamByName ('pdeposittime').asstring:=maskedit1.text;
      q1.Prepare;
      q1.ExecSQL;
      q1.Active :=false;
     end ;
    showmessage('登记成功');
    q1.RequestLive :=true;
    init;
    rmnogrid.setfocus;
    end;



procedure Tdj.Timer1Timer(Sender: TObject);
var i,j:integer;
     tt:trect;
begin
    grid1.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
    for i:=1 to grid1.rowcount-1 do
       for j:=1 to grid1.colcount-1  do
             dj.grid1drawcell(nil,i,j,tt,[gdFocused]);
    grid1.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];

    womangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
    for i:=1 to womangrid.colcount-1 do
         dj.womangriddrawcell(nil,0,i,tt, [gdFocused]);
    womangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];

   mangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
   for i:=1 to mangrid.colcount-1 do
         dj.mangriddrawcell(nil,0,i,tt, [gdFocused]);
   mangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];

end;

procedure Tdj.Button2Click(Sender: TObject);
begin
   dj.close;
end;

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

procedure Tdj.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   q1.Free;
   accproc.Free;
   djnoproc.free;
end;

procedure Tdj.cardClick(Sender: TObject);
begin
 if card.Checked =true then
    begin
    cardh.text:='';
    cardh.enabled:=true;
    cardh.SetFocus ;
    end
 else
    begin
    cardh.text:='';
    cardh.enabled:=false;
    end;
end;

procedure Tdj.gzClick(Sender: TObject);
begin
  if gz.Checked =true then
     begin
     gzmc.Enabled :=true;
     gzmc.SetFocus ;
     end
  else
     gzmc.Enabled :=false;
end;

end.