⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 roomhsan.pas

📁 集成酒店桑拿食管管理的完整程序
💻 PAS
字号:
unit roomhsan;

interface

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

type
  Trmhsan = class(TForm)
    Label1: TLabel;
    mansan: TStringGrid;
    womansan: TStringGrid;
    Label2: TLabel;
    rmno: TMaskEdit;
    cal: TCheckBox;
    zd: TCheckBox;
    Button1: TButton;
    Button2: TButton;
    Bevel1: TBevel;
    s1: TStoredProc;
    q1: TQuery;
    Bevel2: TBevel;
    sps: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    czy: TEdit;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure calClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure rmnoExit(Sender: TObject);
    procedure mansanExit(Sender: TObject);
    procedure womansanExit(Sender: TObject);
    procedure mansanKeyPress(Sender: TObject; var Key: Char);
    procedure womansanKeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure rmnoDblClick(Sender: TObject);
    procedure Label1DblClick(Sender: TObject);
    procedure rmnoKeyPress(Sender: TObject; var Key: Char);
    procedure mansanDblClick(Sender: TObject);
    procedure womansanDblClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  rmhsan: Trmhsan;

implementation
uses dataproc, xgft, newdj,fjhszdyunit;

{$R *.DFM}
var
  acc:string;

procedure formini;
var
  i:integer;
begin
with rmhsan do
   begin
   sps.Caption:='';
   rmno.text:='';
   cal.Checked :=false;
   zd.Checked :=false;
   i:=1;
   while i<=mansan.RowCount do
      begin
      if length(trim(mansan.Cells[0,i]))>0 then
         mansan.Cells[0,i]:='';
      i:=i+1;
      end;
   i:=1;
   while i<=womansan.RowCount do
      begin
      if length(trim(womansan.Cells[0,i]))>0 then
         womansan.Cells[0,i]:='';
      i:=i+1;
      end;
   mansan.Row:=1;
   womansan.row:=1;
   end
end;

function  checkgrid(tg:tstringgrid):boolean;
var
  i:integer;
begin
  i:=1;
  checkgrid:=false;
  while i<tg.rowcount do
  begin
    if length(trim(tg.cells[0,i]))>0 then
       begin
       checkgrid:=true;
       break;
       end;
    i:=i+1;
  end;
end;


procedure Trmhsan.FormCreate(Sender: TObject);
begin
   mansan.Cells [0,0]:='男散';
   womansan.cells[0,0]:='女散';
   formini;
end;

procedure Trmhsan.calClick(Sender: TObject);
begin
  if cal.Checked=true then
     zd.Enabled :=true
  else
     begin
     zd.Checked :=false;
     zd.Enabled :=false;
     end
end;

procedure Trmhsan.Button2Click(Sender: TObject);
begin
   rmhsan.close;
end;

procedure Trmhsan.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=112 then
  begin
    if xt=0 then help(12);
  end;
  if key=13 then
     selectnext(activecontrol,true,true);
  if key=27 then
     rmhsan.close;
end;

procedure Trmhsan.rmnoExit(Sender: TObject);
var
  aa:array [0..2] of string;
begin
  if length(trim(rmno.text))>0 then
  begin
     getvalue(aa,'select accno,num,truntime from nowin where handno='''+trim(rmno.text)+'''');
     if trim(aa[2])='24' then
     begin
       showmessage(trim(rmno.text)+'房间是商务房不能转为散座');
       rmno.text:='';
       exit;
     end;
     acc:=aa[0];
     sps.Caption:=aa[1];
  end
end;

procedure Trmhsan.mansanExit(Sender: TObject);
var
  i,y,x:integer;
  exno,errmsg,usemsg,msg:string;
  bb:array [0..1] of string;
begin
  i:=1;
  y:=mansan.rowCount;
  errmsg:='';
  usemsg:='';
  msg:='';
  while i <=mansan.RowCount  do
     begin
     if y>i then y:=i;
     if length(trim(mansan.cells[0,i]))>0 then
        begin
        bb[0]:='';
        getvalue(bb,'select status from mansan where roomno='''+trim(mansan.cells[0,i])+'''');
        if length(trim(bb[0]))=0 then
           errmsg:=errmsg+' '+mansan.cells[0,i]
        else
           begin
           if trim(bb[0])='1' then
              usemsg:=usemsg+' '+mansan.cells[0,i];
           end;
        end;
     i:=i+1;
     end;
  if length(trim(errmsg))>0  then
     msg:='男散座'+errmsg+' 错误';
  if length(trim(usemsg))>0  then
     msg:=msg+chr(13)+'男散座'+usemsg+' 被用';
  if length(trim(msg))>0 then
     begin
     showmessage(msg);
     mansan.setfocus;
     mansan.row:=y;
     exit;
     end;
  i:=1;
  y:=mansan.rowcount;
  while i<=mansan.rowcount do
     begin
     exno:=trim(mansan.cells[0,i]);
     if length(exno)>0 then
        begin
        x:=i+1;
        while x<=mansan.rowcount do
           begin
           if y>i then y:=i;
           if length(trim(mansan.cells[0,x]))>0 then
              if  trim(mansan.cells[0,x])=exno then
                  begin
                  msg:=msg+' '+exno;
                  break;
                  end;
           x:=x+1;
           end;
        end;
     i:=i+1;
     end;
  if length(trim(msg))>0 then
     begin
     showmessage('男散座'+msg+' 重号');
     mansan.setfocus;
     mansan.row:=y;
     exit;
     end;
end;

procedure Trmhsan.womansanExit(Sender: TObject);
var
  i,y,x:integer;
  exno,errmsg,usemsg,msg:string;
  bb:array [0..1] of string;
begin
  i:=1;
  y:=womansan.rowCount;
  errmsg:='';
  usemsg:='';
  msg:='';
  while i <=womansan.RowCount  do
     begin
     if y>i then y:=i;
     if length(trim(womansan.cells[0,i]))>0 then
        begin
        bb[0]:='';
        getvalue(bb,'select status from womansan where roomno='''+trim(womansan.cells[0,i])+'''');
        if length(trim(bb[0]))=0 then
           errmsg:=errmsg+' '+womansan.cells[0,i]
        else
           begin
           if trim(bb[0])='1' then
              usemsg:=usemsg+' '+womansan.cells[0,i];
           end;
        end;
     i:=i+1;
     end;
  if length(trim(errmsg))>0  then
     msg:='女散座'+errmsg+' 错误';
  if length(trim(usemsg))>0  then
     msg:=msg+chr(13)+'女散座'+usemsg+' 被用';
  if length(trim(msg))>0 then
     begin
     showmessage(msg);
     womansan.setfocus;
     womansan.row:=y;
     exit;
     end;
  i:=1;
  y:=womansan.rowcount;
  while i<=womansan.rowcount do
     begin
     exno:=trim(womansan.cells[0,i]);
     if length(exno)>0 then
        begin
        x:=i+1;
        while x<=womansan.rowcount do
           begin
           if y>i then y:=i;
           if length(trim(womansan.cells[0,x]))>0 then
              if  trim(womansan.cells[0,x])=exno then
                  begin
                  msg:=msg+' '+exno;
                  break;
                  end;
           x:=x+1;
           end;
        end;
     i:=i+1;
     end;
  if length(trim(msg))>0 then
     begin
     showmessage('女散座'+msg+' 重号');
     womansan.setfocus;
     womansan.row:=y;
     exit;
     end;
end;


procedure Trmhsan.mansanKeyPress(Sender: TObject; var Key: Char);
begin
  if ((key<'0') or (key>'9')) then
     if key<>char(8) then
        key:=char(0);
end;

procedure Trmhsan.womansanKeyPress(Sender: TObject; var Key: Char);
begin
  if ((key<'0') or (key>'9')) then
     if key<>char(8) then
        key:=char(0);
end;

procedure Trmhsan.Button1Click(Sender: TObject);
var
   i:integer;
   ls:string;
begin
   if length(trim(rmno.text))=0 then
      begin
      showmessage('房间号不能为空');
      rmno.setfocus;
      exit;
      end;
   if (checkgrid(rmhsan.mansan)=false) and (checkgrid(rmhsan.womansan)=false) then
      begin
      showmessage('散浴号不能为空');
      mansan.SetFocus ;
      exit;
      end;
   i:=1;
   if checkgrid(rmhsan.mansan)=true then
      begin
      while i<=mansan.RowCount do
         begin
         ls:=trim(mansan.Cells [0,i]);
         if length(ls)>0 then
            begin
            q1.Active :=false;
            q1.sql.clear;
            q1.sql.add('insert into roomtosanpara values(:proomno,:psex)');
            q1.ParamByName ('proomno').asstring:=ls;
            q1.ParamByName ('psex').asstring:='1';
            q1.Prepare;
            q1.ExecSQL ;
            q1.Active :=false;
            end;
         i:=i+1;
         end
      end;
   i:=1;
   if checkgrid(rmhsan.womansan)=true then
      begin
      while i<=womansan.RowCount do
         begin
         ls:=trim(womansan.Cells [0,i]);
         if length(ls)>0 then
            begin
            q1.Active :=false;
            q1.sql.clear;
            q1.sql.add('insert into roomtosanpara values(:proomno,:psex)');
            q1.ParamByName ('proomno').asstring:=ls;
            q1.ParamByName ('psex').asstring:='0';
            q1.Prepare;
            q1.ExecSQL ;
            q1.Active :=false;
            end;
         i:=i+1;
         end
      end;
   s1.UnPrepare;
   s1.Prepare;
   s1.ParamByName ('@iroomno').asstring:=trim(rmno.text);
   s1.ParamByName ('@iscal').asboolean:=cal.Checked ;
   s1.ParamByName ('@iszd').asboolean:=zd.Checked ;
   s1.ParamByName ('@itime').asdatetime:=now;
   s1.Prepare;
   s1.ExecProc;
   s1.UnPrepare;
   addlogo(curper.code,datetimetostr(now),trim(rmno.text)+'房换散');
   showmessage('房间换散座成功');
   formini;
end;

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

procedure Trmhsan.rmnoDblClick(Sender: TObject);
begin
  Application.CreateForm(Txgftform, xgftform);
  xgftform.Caption:='';
  xgftform.Button2.Visible:=false;
  xgftform.Timer1.Free;
  xgftform.showmodal;
  rmno.text:=xgftform.xgrmno.Text;
  xgftform.Free;
  activecontrol:=Button1;

end;

procedure Trmhsan.Label1DblClick(Sender: TObject);
begin
  Application.CreateForm(Tdjform, djform);
  djform.Caption:='请选择散座号';
  djform.Height:=100;
  djform.Position:=poDefault;
  djform.Panel1.Visible:=false;
  djform.grid1.Visible:=false;
  djform.grid2.Visible:=false;
  djform.rmnogrid.Visible:=false;
//  djform.Button1.Enabled:=false;
  djform.xfrmno.Text:='0';
  djform.Timer1.Free;
  djform.showmodal;
{  if trim(copy(trim(djform.xfrmno.Text),7,6))='1' then
  begin
     i:=1;
     while trim(mansan.Cells[0,i])<>'' do i:=i+1;
     mansan.Cells[0,i]:=copy(trim(djform.xfrmno.Text),1,6);
  end;
  if trim(copy(trim(djform.xfrmno.Text),7,6))='0' then
  begin
     i:=1;
     while trim(womansan.Cells[0,i])<>'' do i:=i+1;
     mansan.Cells[0,i]:=copy(trim(djform.xfrmno.Text),1,6);
  end;

  if length(trim(djform.xfrmno.Text))>6 then
  begin
    Panel3.Visible:=true;
    if trim(copy(trim(djform.xfrmno.Text),7,6))='1' then
    begin
      man.Checked:=true;
      woman.Checked:=false;
    end
    else
    begin
      man.Checked:=false;
      woman.Checked:=true;
    end;
  end
  else Panel3.Visible:=false;}
  djform.Free;

end;

procedure Trmhsan.rmnoKeyPress(Sender: TObject; var Key: Char);
begin
   key:=#0;
end;

procedure Trmhsan.mansanDblClick(Sender: TObject);
var i:integer;
begin
   if trim(mansan.Cells[0,mansan.Row])<>'' then
   begin
     i:=mansan.Row;
     while trim(mansan.Cells[0,i])<>'' do
     begin
       mansan.Cells[0,i]:=mansan.Cells[0,i+1];
       i:=i+1;
     end;
   end;
end;


procedure Trmhsan.womansanDblClick(Sender: TObject);
var i:integer;
begin
   if trim(womansan.Cells[0,womansan.Row])<>'' then
   begin
     i:=womansan.Row;
     while trim(womansan.Cells[0,i])<>'' do
     begin
       womansan.Cells[0,i]:=womansan.Cells[0,i+1];
       i:=i+1;
     end;
   end;
end;

procedure Trmhsan.Button3Click(Sender: TObject);
begin
     application.CreateForm(TfjhszdyForm,fjhszdyForm);
     fjhszdyForm.hfsj.Caption:=formatdatetime('yyyy-mm-dd HH:mm:ss',now);
     fjhszdyForm.ysh.Caption:=rmno.Text;
    // fjhszdyForm.xsh.Caption:=rmhd.Text;
     {  fjhszdyForm.yfj.Caption:=jfj.Caption;
     fjhszdyForm.xfj.Caption:=copy(jg.Caption,7,4);}
     //fjhszdyForm.yyrs.Caption:=oldsps.Caption;
    // fjhszdyForm.xyrs.Caption:=inttostr(newsps.Value);
     fjhszdyForm.jsr.Caption:=czy.Text;
     fjhszdyForm.hide;
    // if dy.Checked then
     //  fjhszdyForm.QuickRep1.print
   //  else
     fjhszdyForm.QuickRep1.Preview;
     fjhszdyForm.Close;
     fjhszdyForm.free;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -