sankyd.pas

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

unit sankyd;

interface

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

type
  Tsankydform = class(TForm)
    Label1: TLabel;
    name: TEdit;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    man: TRadioButton;
    woman: TRadioButton;
    Label3: TLabel;
    zj: TComboBox;
    Label4: TLabel;
    id: TMaskEdit;
    Label5: TLabel;
    workunit: TEdit;
    Label6: TLabel;
    yj: TSpinEdit;
    Label7: TLabel;
    GroupBox2: TGroupBox;
    phone: TRadioButton;
    xj: TRadioButton;
    Bevel1: TBevel;
    Label8: TLabel;
    cometime: TMaskEdit;
    Label9: TLabel;
    yzday: TSpinEdit;
    ydgrid: TStringGrid;
    Label10: TLabel;
    rmnum: TSpinEdit;
    pnum: TSpinEdit;
    Label11: TLabel;
    Label12: TLabel;
    czy: TEdit;
    Button1: TButton;
    Button2: TButton;
    q1: TQuery;
    s1: TStoredProc;
    Bevel2: TBevel;
    BitBtn1: TBitBtn;
    rmgrid: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ydgridKeyPress(Sender: TObject; var Key: Char);
    procedure ydgridSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure cometimeExit(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure idExit(Sender: TObject);
    procedure phoneClick(Sender: TObject);
    procedure xjClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  sankydform: Tsankydform;

implementation
uses dataproc;
{$R *.DFM}
var
  rmtp:array [0..30] of string;

procedure formini;
begin
with sankydform do
  begin
  cleargrid(rmgrid,0);
  name.text:='';
  man.Checked :=true;
  workunit.text:='';
  id.text:='';
  xj.Checked :=true;
  yj.Value :=500;
  cometime.text:=datetimetostr(now);
  yzday.Value :=3;
  rmnum.Value :=0;
  pnum.Value :=0;
  czy.Text :=curper.code+' '+curper.name;
  end
end;

procedure datatoctl(ss:string);
var
  i:integer;
  ddd:tdate;
begin
with sankydform do
  begin
  i:=1;
  q1.Active :=false;
  q1.sql.clear;
  q1.sql.add('select roomtype,name,bednum from roomtype');
  q1.Prepare;
  q1.open;
  q1.Active :=true;
  ydgrid.RowCount :=q1.RecordCount+1 ;
  while not q1.EOF do
     begin
     rmtp[i]:=q1.fieldbyname('roomtype').asstring;
     ddd:=strtodate(copy(trim(ss),1,10));
     ydgrid.cells[0,i]:=q1.fieldbyname('name').asstring;
     ydgrid.Cells [1,i]:=inttostr(q1.fieldbyname('bednum').asinteger);
     s1.ParamByName('@iroomtype').asstring:=trim(rmtp[i]);
     s1.ParamByName ('@idatetime').asdatetime:=strtodatetime(trim(ss));
     s1.ParamByName ('@idate').asdatetime:=strtodatetime(copy(trim(ss),1,10));
     S1.Prepare;
     S1.ExecProc ;
     ydgrid.cells[2,i]:=inttostr(S1.ParamByname('@oroomnum').asinteger);
     ydgrid.cells[3,i]:='';
     q1.Next ;
     i:=i+1;
     end;
  q1.Active :=false;
  end;
end;

procedure Tsankydform.FormCreate(Sender: TObject);
begin
  shortdateformat:='yyyy-mm-dd';
  formini;
  BitBtn1.Caption:='自'+#13+'动'+#13+'确'+#13+'定'+#13+'房'+#13+'间';
  rmgrid.cells[0,0]:='房间';
  rmgrid.cells[1,0]:='价格';
  ydgrid.cells [0,0]:=' 房间类型';
  ydgrid.Cells [1,0]:=' 房间床数';
  ydgrid.Cells [2,0]:=' 可用数量';
  ydgrid.Cells [3,0]:=' 预订数量';
  comadd(sankydform.zj,1,'select name from zj');
  datatoctl(trim(cometime.text));
end;

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

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

procedure Tsankydform.ydgridSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
var
  i,rmsl,psl:integer;
begin
  if length(trim(ydgrid.cells[3,arow]))>0 then
     begin
     if strtoint(trim(ydgrid.cells[3,arow]))>strtoint(trim(ydgrid.cells[2,arow])) then
        begin
        showmessage('只有 '+trim(ydgrid.cells[2,arow])+' 间房间可用');
        ydgrid.cells[3,arow]:='';
        end;
     end;
   i:=1;
   rmsl:=0;
   psl:=0;
   while i<ydgrid.RowCount do
     begin
     if length(trim(ydgrid.cells[3,i]))>0 then
        begin
        rmsl:=rmsl+strtoint(trim(ydgrid.cells[3,i]));
        psl:=psl+strtoint(trim(ydgrid.cells[3,i]))*strtoint(trim(ydgrid.cells[1,i]));
        end;
     i:=i+1;
     end;
   rmnum.Value :=rmsl;
   pnum.Value :=psl;
end;

procedure Tsankydform.cometimeExit(Sender: TObject);
var
  rq:Tdatetime;
begin
  try
    rq:=strtodatetime(trim(cometime.text));
  except
    showmessage('时间错误');
    cometime.SetFocus ;
    exit;
  end;
  datatoctl(cometime.text);
end;

procedure Tsankydform.Button2Click(Sender: TObject);
begin
  sankydform.Close ;
end;

procedure Tsankydform.Button1Click(Sender: TObject);
var
  beforeno:string[6];
  aa:array [0..1] of string;
  i,k:integer;
begin
   if length(trim(name.text))=0 then
      begin
      showmessage('姓名不能为空');
      name.SetFocus ;
      exit;
      end;
   if rmnum.Value =0 then
      begin
      showmessage('没有预订房间');
      ydgrid.SetFocus ;
      exit;
      end;
      for i:=1 to rmgrid.RowCount-1 do
        if trim(rmgrid.Cells[0,i])<>'' then k:=k+1;
      if k<>rmnum.Value then
      begin
      showmessage('房间数量不对');
      ydgrid.SetFocus ;
      exit;
      end;
      for i:=1 to rmgrid.RowCount-1 do
        if trim(rmgrid.Cells[0,i])<>'' then
        begin
           q1.Active :=false;
           q1.sql.clear;
           q1.sql.add('select roomno,price from room where (roomno=:prmno) and (status=:ps)');
           q1.ParamByName ('prmno').asstring:=trim(rmgrid.Cells[0,i]);
           q1.ParamByName ('ps').asstring:='0';
           q1.Prepare;
           q1.open;
           if q1.IsEmpty then
           begin
             showmessage('房间不对');
             q1.Active :=false;
             q1.sql.clear;
             ydgrid.SetFocus ;
             exit;
           end;
           rmgrid.Cells[1,i]:=q1.fieldbyname('price').asstring;
        end;
     q1.Active :=false;
     q1.sql.clear;
//   s2.Prepare;
      beforeno:=getnewcode('Beforeid');

//   s2.ExecProc ;
//   beforeno:=s2.Parambyname('@obeforeid').asstring;
   aa[0]:='';
   getvalue(aa,'select code from zj where name='''+trim(zj.items[zj.itemindex])+'''');
   q1.Active :=false;
   q1.sql.clear;
   q1.sql.add('insert into beforein values(:pbeforeid,:pname,:psex,:pzjid,:pid,:psy,:pcountry,:pworkunit,:isgroup,:pgroupname,');
   q1.sql.add(':pothername,:pcometime,:pydtime,:pyzday,:pyj,:proomnum,:ppnum,:pisphone,:pismoney,:pregid)');
   q1.ParamByName ('pbeforeid').asstring:=trim(beforeno);
   q1.ParamByName ('pname').asstring:=trim(name.text);
   if man.Checked =true then
      q1.ParamByName ('psex').asstring:='1'
   else
      q1.ParamByName ('psex').asstring:='0';
   if length(trim(id.text))=0 then
      begin
      q1.ParamByName ('pzjid').asstring:='';
      q1.ParamByName ('pid').asstring:='';
      end
   else
      begin
      q1.ParamByName ('pzjid').asstring:=trim(aa[0]);
      q1.ParamByName ('pid').asstring:=trim(id.text);
      end;
   q1.ParamByName ('psy').asstring:='';
   q1.ParamByName ('pcountry').asstring:='';
   q1.ParamByName ('pworkunit').asstring:=trim(workunit.text);
   q1.ParamByName ('isgroup').asboolean:=false;
   q1.ParamByName ('pgroupname').asstring:='';
   q1.ParamByName ('pothername').asstring:='';
   q1.ParamByName ('pcometime').asdatetime:=strtodatetime(trim(cometime.text));
   q1.ParamByName ('pydtime').asdatetime:=now;
   q1.ParamByName ('pyzday').asinteger:=yzday.Value ;
   q1.ParamByName ('pyj').asinteger:=yj.Value ;
   q1.ParamByName ('proomnum').asinteger:=rmnum.Value ;
   q1.ParamByName ('ppnum').asinteger:=pnum.Value ;
   q1.ParamByName ('pisphone').asboolean:=phone.Checked ;
   q1.ParamByName ('pismoney').asboolean:=xj.Checked ;
   q1.ParamByName ('pregid').asstring:=curper.code;
   q1.Prepare;
   q1.ExecSQL ;
   q1.Active :=false;
   i:=1;
   while i<ydgrid.RowCount do
     begin
     if length(trim(ydgrid.cells[3,i]))>0 then
        if strtoint(trim(ydgrid.cells[3,i]))>0 then
           begin
           q1.Active :=false;
           q1.sql.clear;
           q1.sql.add('insert into beforeinmx values(:pbeforeid,:proomtype,:proomnum,:pcometime)');
           q1.ParamByName ('pbeforeid').asstring:=trim(beforeno);
           q1.parambyname ('proomtype').asstring:=trim(rmtp[i]);
           q1.ParamByName ('proomnum').asinteger:=strtoint(trim(ydgrid.cells[3,i]));
           q1.parambyname ('pcometime').asdatetime:=strtodatetime(trim(cometime.text));
           q1.Prepare;
           q1.execsql;
           end;
     i:=i+1;
     end;
   q1.active:=false;
   i:=1;
   while trim(rmgrid.Cells[0,i])<>'' do
   begin
     q1.SQL.Clear;
     q1.SQL.Add('update room set status=''5'' where roomno='''+trim(rmgrid.Cells[0,i])+'''');
     q1.sql.add('insert into ydroommx values(:pbeforeid,:proomno,:pfj,:pcometime)');
     q1.ParamByName ('pbeforeid').asstring:=trim(beforeno);
     q1.parambyname ('proomno').asstring:=trim(rmgrid.Cells[0,i]);
     q1.parambyname ('pfj').asstring:=trim(rmgrid.Cells[1,i]);
     q1.parambyname ('pcometime').asdatetime:=strtodatetime(trim(cometime.text));
     q1.ExecSQL;
     i:=i+1;
   end;
   q1.active:=false;
   showmessage('散客预订成功');
   formini;
   datatoctl(trim(cometime.text));
end;

procedure Tsankydform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  q1.free;
  s1.free;
   action:=cafree;
end;

procedure Tsankydform.idExit(Sender: TObject);
var
   lsxb:integer;
begin
  { if (trim(zj.items[zj.ItemIndex])='身份证') and (length(trim(id.text))>0) then
      begin
      if length(trim(id.text))=15 then
         begin
         lsxb:=strtoint(copy(trim(id.text),length(trim(id.text)),1)) mod 2;
         if lsxb=1 then
            man.Checked :=true
         else
            woman.Checked :=true;
         end
      else
         begin
         showmessage('身份证号码错误');
         id.SetFocus ;
         exit;
         end;
      end;  }
end;

procedure Tsankydform.phoneClick(Sender: TObject);
begin
  if phone.Checked =true then
     begin
     yj.Value :=0;
     yj.Enabled :=false;
     end;
end;

procedure Tsankydform.xjClick(Sender: TObject);
begin
  if xj.Checked =true then
     begin
     yj.Enabled :=true;
     yj.Value :=500;
     end;
end;

procedure addroomno(rmno:string);
var
  i:integer;
begin
with sankydform do
  begin
  i:=1;
  while  i<rmgrid.RowCount do
     begin
     if length(trim(rmgrid.cells[0,i]))=0 then
        begin
        rmgrid.Cells [0,i]:=rmno;
        rmgrid.Cells [1,i]:=inttostr(roommoney(rmno,1,0));
        if phone.Checked then
          yj.Value:=(yj.Value+strtoint(rmgrid.Cells [1,i])+100)*yzday.Value;
        exit;
        end;
     i:=i+1;
     end
  end
end;

procedure Tsankydform.BitBtn1Click(Sender: TObject);
var
  xysl,i,sl,y:integer;
begin
  if rmnum.Value =0 then
     cleargrid(rmgrid,0)
  else
  begin
     cleargrid(rmgrid,0);
     i:=1;
     while i<ydgrid.rowcount do
     begin
       if length(trim(ydgrid.cells[3,i]))>0 then
        if strtoint(trim(ydgrid.cells[3,i]))>0 then
        begin
           q1.Active :=false;
           q1.sql.clear;
           q1.sql.add('select roomno from room where (roomtype=:prmtp) and (status=:ps)');
           q1.ParamByName ('prmtp').asstring:=rmtp[i];
           q1.ParamByName ('ps').asstring:='0';
           q1.Prepare;
           q1.open;
           xysl:=q1.RecordCount ;
           y:=0;
           sl:=strtoint(trim(ydgrid.cells[3,i]));
           if xysl<sl then
              begin
              showmessage(trim(ydgrid.cells[0,i])+'只有'+trim(inttostr(xysl))+'间');
              exit;
              end;
           while y<sl do
              begin
              addroomno(q1.fieldbyname('roomno').asstring);
              y:=y+1;
              q1.Next;
              end;
           q1.Active :=false;
        end;
        i:=i+1;
     end;
  end;
end;

end.