groupyd.pas

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

unit groupyd;

interface

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

type
  Tgroupydform = class(TForm)
    Label1: TLabel;
    groupname: TMaskEdit;
    Label2: TLabel;
    country: TEdit;
    Label3: TLabel;
    workunit: TMaskEdit;
    Label4: TLabel;
    master: TEdit;
    Label5: TLabel;
    djtime: TMaskEdit;
    Label6: TLabel;
    daynum: TSpinEdit;
    Label7: TLabel;
    yj: TSpinEdit;
    Button1: TButton;
    Button2: TButton;
    Label8: TLabel;
    rmnum: TSpinEdit;
    Label9: TLabel;
    pnum: TSpinEdit;
    rmgrid: TStringGrid;
    q1: TQuery;
    q2: TQuery;
    labed10: TLabel;
    sy: TEdit;
    Label10: TLabel;
    zj: TComboBox;
    Label11: TLabel;
    id: TEdit;
    GroupBox1: TGroupBox;
    phone: TRadioButton;
    xj: TRadioButton;
    GroupBox2: TGroupBox;
    man: TRadioButton;
    woman: TRadioButton;
    S2: TStoredProc;
    Label13: TLabel;
    ttjc: TEdit;
    Label14: TLabel;
    Label12: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    BitBtn1: TBitBtn;
    rmgrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure rmgridKeyPress(Sender: TObject; var Key: Char);
    procedure rmgridSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure Button1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure djtimeExit(Sender: TObject);
    procedure idExit(Sender: TObject);
    procedure phoneClick(Sender: TObject);
    procedure xjClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  groupydform: Tgroupydform;

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

procedure formini;
begin
with groupydform do
   begin
   groupname.text:='';
   sy.Text :='';
   country.text:='中国';
   workunit.text:='';
   ttjc.Text :='';
   master.text:='';
   man.Checked :=true;
   id.text:='';
   xj.Checked :=true;
   djtime.Text :=datetimetostr(now);
   daynum.Value :=3;
   yj.Value :=1000;
   rmnum.Value :=0;
   pnum.Value :=0;
   cleargrid(groupydform.rmgrid,3);
   end;
end;

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


procedure datatoctl(ss:string);
var
  i:integer;
begin
with groupydform 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;
  rmgrid.RowCount :=q1.RecordCount+1 ;
  while not q1.EOF do
     begin
     rmtp[i]:=q1.fieldbyname('roomtype').asstring;
     rmgrid.cells[0,i]:=q1.fieldbyname('name').asstring;
     rmgrid.Cells [1,i]:=inttostr(q1.fieldbyname('bednum').asinteger);
     s2.ParamByName('@iroomtype').asstring:=trim(rmtp[i]);
     s2.ParamByName ('@idatetime').asdatetime:=strtodatetime(trim(ss));
     s2.ParamByName ('@idate').asdatetime:=strtodatetime(copy(trim(ss),1,10));
     S2.Prepare;
     S2.ExecProc ;
     rmgrid.cells[2,i]:=inttostr(S2.ParamByname('@oroomnum').asinteger);
     rmgrid.cells[3,i]:='';
     q1.Next ;
     i:=i+1;
     end;
  q1.Active :=false;
  end;
end;

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

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

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

procedure Tgroupydform.Button1Click(Sender: TObject);
var
   beforeno,zjno:string;
   aa:array [0..1] of string;
   i:integer;
begin
   if length(trim(groupname.text))=0 then
      begin
      showmessage('团体名称不能为空');
      groupname.SetFocus ;
      exit;
      end;
   if length(trim(workunit.text))=0 then
      begin
      showmessage('单位不能为空');
      workunit.SetFocus ;
      exit;
      end;
   if length(trim(ttjc.text))=0 then
      begin
      showmessage('团体简称不能为空');
      ttjc.SetFocus ;
      exit;
      end;
   if length(trim(ttjc.text))>2 then
      begin
      showmessage('团体简称不能太长');
      ttjc.SetFocus ;
      exit;
      end;
   if length(trim(master.text))=0 then
      begin
      showmessage('领队不能为空');
      master.setfocus;
      exit;
      end;
   if rmnum.Value =0 then
      begin
      showmessage('房间数量不能为 0 ');
      rmgrid.SetFocus ;
      exit;
      end;
   beforeno:=getnewcode('Beforeid');
   aa[0]:='';
   getvalue(aa,'select code from zj where name='''+trim(zj.items[zj.itemindex])+'''');
   zjno:=trim(aa[0]);
   q1.Active :=false;
   q1.sql.clear;
   q1.sql.add('insert into  Beforein values(:pbeforeid,:pname,:psex,:pzjid,:pid,:psy,:pcountry,:pworkunit,');
   q1.sql.add(':pisgroup,:pgroupname,:pothername,:pcometime,:pydtime,:pyzday,:pyj,:proomnum,:pnum,:pisphone,:pismoney,:pregid)');
   q1.ParamByName ('pbeforeid').asstring:=beforeno;
   q1.ParamByName ('pname').asstring:=trim(master.text);
   if man.Checked =true then
      q1.ParamByName ('psex').asstring:='1'
   else
      q1.ParamByName ('psex').asstring:='0';
   q1.ParamByName ('pzjid').asstring:=trim(zjno);
   q1.ParamByName('pid').asstring:=trim(id.text);
   q1.ParamByName ('psy').asstring:=copy(trim(sy.text),1,10);
   q1.ParamByName ('pcountry').asstring:=trim(country.text);
   q1.ParamByName ('pworkunit').asstring:=copy(trim(workunit.text),1,20);
   q1.ParamByName ('pisgroup').asboolean:=true;
   q1.ParamByName ('pgroupname').asstring:=copy(trim(groupname.text),1,20);
   q1.ParamByName ('pothername').asstring:=copy(trim(ttjc.text),1,4);
   q1.ParamByName ('pcometime').asdatetime:=strtodatetime(trim(djtime.text));
   q1.ParamByName ('pydtime').asdatetime:=now;
   q1.ParamByName ('pyzday').asinteger:=daynum.Value ;
   q1.ParamByName ('pyj').asinteger:=yj.Value ;
   q1.ParamByName ('proomnum').asinteger:=rmnum.value;
   q1.ParamByName ('pnum').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 ;
   i:=1;
   while i<rmgrid.RowCount do
      begin
      if length(trim(rmgrid.cells[3,i]))>0 then
         if strtoint(trim(rmgrid.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:=beforeno;
            q1.ParamByName ('proomtype').asstring:=trim(rmtp[i]);
            q1.ParamByName ('proomnum').asinteger:=strtoint(trim(rmgrid.cells[3,i]));
            q1.ParamByName ('pcometime').asdatetime:=strtodatetime(trim(djtime.text));
            q1.Prepare;
            q1.ExecSQL ;
            end;
      i:=i+1;
      end;
   i:=1;
   while trim(rmgrid1.Cells[0,i])<>'' do
   begin
     q1.SQL.Clear;
     q1.SQL.Add('update room set status=''5'' where roomno='''+trim(rmgrid1.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(rmgrid1.Cells[0,i]);
     q1.parambyname ('pfj').asstring:=trim(rmgrid1.Cells[1,i]);
     q1.parambyname ('pcometime').asdatetime:=strtodatetime(trim(djtime.text));
     q1.ExecSQL;
     i:=i+1;
   end;
   q1.active:=false;
   showmessage('预订成功');
   formini;
   datatoctl(djtime.text);
end;

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

procedure Tgroupydform.Button2Click(Sender: TObject);
begin
   groupydform.close;
end;

procedure Tgroupydform.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
 q1.free;
 q2.free;
 s2.free;
   action:=cafree;
end;

procedure Tgroupydform.djtimeExit(Sender: TObject);
var
  rq:Tdatetime;
begin
  try
    rq:=Strtodatetime(trim(djtime.text));
  except
    showmessage('时间错误');
    djtime.SetFocus ;
    exit;
  end;
  datatoctl(djtime.text);
end;

procedure Tgroupydform.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 Tgroupydform.phoneClick(Sender: TObject);
begin
  if phone.Checked =true then
     begin
     yj.Value :=0;
     yj.Enabled :=false;
     end;
end;

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

procedure Tgroupydform.BitBtn1Click(Sender: TObject);
var
  xysl,i,sl,y:integer;
begin
  if rmnum.Value =0 then
     cleargrid(rmgrid1,0)
  else
  begin
     cleargrid(rmgrid1,0);
     i:=1;
     while i<rmgrid.rowcount do
     begin
       if length(trim(rmgrid.cells[3,i]))>0 then
        if strtoint(trim(rmgrid.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(rmgrid.cells[3,i]));
           if xysl<sl then
              begin
              showmessage(trim(rmgrid.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.