hf.pas

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

unit hf;

interface

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

type
  Thfform = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    oldrmno: TMaskEdit;
    Q1: TQuery;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    Bevel1: TBevel;
    Label2: TLabel;
    newrmno: TMaskEdit;
    s1: TStoredProc;
    GroupBox1: TGroupBox;
    newwomanno: TStringGrid;
    newmanno: TStringGrid;
    GroupBox2: TGroupBox;
    blmanno: TStringGrid;
    GroupBox3: TGroupBox;
    oldmanno: TStringGrid;
    oldwomanno: TStringGrid;
    add: TBitBtn;
    addall: TBitBtn;
    del: TBitBtn;
    delall: TBitBtn;
    blwomanno: TStringGrid;
    Label3: TLabel;
    oldsps: TLabel;
    Label4: TLabel;
    newsps: TSpinEdit;
    jg: TLabel;
    Label5: TLabel;
    czy: TEdit;
    jfj: TLabel;
    Button3: TButton;
    Label6: TLabel;
    SpinEdit1: TSpinEdit;
    Label7: TLabel;
    rmmoney: TSpinEdit;
    Label8: TLabel;
    oldprice: TEdit;
    Label9: TLabel;
    turntime: TEdit;
    Label10: TLabel;
    djfs: TEdit;
    Query1: TQuery;
    hfr: TLabel;
    Query2: TQuery;
    procedure FormCreate(Sender: TObject);
    procedure oldrmnoExit(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure newmannoExit(Sender: TObject);
    procedure newwomannoExit(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CheckBox1Click(Sender: TObject);
    procedure addClick(Sender: TObject);
    procedure blmannoDblClick(Sender: TObject);
    procedure oldmannoDblClick(Sender: TObject);
    procedure blwomannoDblClick(Sender: TObject);
    procedure oldwomannoDblClick(Sender: TObject);
    procedure blmannoEnter(Sender: TObject);
    procedure blwomannoEnter(Sender: TObject);
    procedure oldmannoEnter(Sender: TObject);
    procedure oldwomannoEnter(Sender: TObject);
    procedure delClick(Sender: TObject);
    procedure addallClick(Sender: TObject);
    procedure delallClick(Sender: TObject);
    procedure newrmnoDblClick(Sender: TObject);
    procedure oldrmnoDblClick(Sender: TObject);
    procedure oldrmnoKeyPress(Sender: TObject; var Key: Char);
    procedure oldrmnoEnter(Sender: TObject);
    procedure newrmnoEnter(Sender: TObject);
    procedure GroupBox1DblClick(Sender: TObject);
    procedure newrmnoExit(Sender: TObject);
    procedure newmannoDblClick(Sender: TObject);
    procedure newrmnoKeyPress(Sender: TObject; var Key: Char);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  hfform: Thfform;

implementation
uses dataproc, xgft, newdj,hfdyunit, bkzlhf;

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

procedure formini;
var
 i:integer;
begin
with hfform do
   begin
   i:=1;
   while i<= oldmanno.RowCount  do
     begin
     if length(trim(oldmanno.Cells [0,i]))>0 then
        oldmanno.Cells [0,i]:='';
     i:=i+1;
     end;
   i:=1;
   while i<= oldwomanno.RowCount  do
     begin
     if length(trim(oldwomanno.Cells [0,i]))>0 then
        oldwomanno.Cells [0,i]:='';
     i:=i+1;
     end;
   i:=1;
   while i<= blmanno.RowCount  do
     begin
     if length(trim(blmanno.Cells [0,i]))>0 then
        blmanno.Cells [0,i]:='';
     i:=i+1;
     end;
   i:=1;
   while i<= blwomanno.RowCount  do
     begin
     if length(trim(blwomanno.Cells [0,i]))>0 then
        blwomanno.Cells [0,i]:='';
     i:=i+1;
     end;
   i:=1;
   while i<= newmanno.RowCount  do
     begin
     if length(trim(newmanno.Cells [0,i]))>0 then
        newmanno.Cells [0,i]:='';
     i:=i+1;
     end;
   i:=1;
   while i<= newwomanno.RowCount  do
     begin
     if length(trim(newwomanno.Cells [0,i]))>0 then
        newwomanno.Cells [0,i]:='';
     i:=i+1;
     end;
   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 gridaddtable(grid1:tstringgrid;sex:string;pflag:boolean);
var
 i:integer;
begin
with hfform do
  begin
  i:=1;
  while i<=grid1.RowCount do
     begin
     if length(trim(grid1.cells[0,i]))>0 then
        begin
        q1.Active :=false;
        q1.sql.Clear ;
        q1.sql.add('insert into changeroompara values(:phdno,:paccno,:psex,:pfl,:pRegid)');
        q1.ParamByName ('phdno').asstring:=trim(grid1.cells[0,i]);
        q1.ParamByName ('pRegid').asstring:=trim(grid1.cells[1,i]);
        q1.ParamByName ('paccno').asstring:=acc;
        q1.Parambyname ('psex').asstring:=trim(sex);
        q1.ParamByName ('pfl').asboolean:=pflag;
        q1.Prepare;
        q1.ExecSQL;
        end;
     i:=i+1;
     end;
 end;
end;


procedure Thfform.FormCreate(Sender: TObject);
begin
   oldrmno.text:='';
   newrmno.text:=''; jfj.Caption:='';
   formini;
   oldmanno.Cells [0,0]:='男散';
   oldwomanno.Cells [0,0]:='女散';
   blmanno.Cells [0,0]:='男散';
   blwomanno.Cells [0,0]:='女散';
   newmanno.Cells [0,0]:='男散';
   newwomanno.Cells [0,0]:='女散';
   hfr.Caption:='';
end;

procedure Thfform.oldrmnoExit(Sender: TObject);
var
   aa:array [0..2] of string;
   i,j:integer;
begin
   if length(trim(oldrmno.text))>0 then
   begin
     formini;
     q1.Active :=false;
     q1.sql.clear;
     q1.sql.add('select accno,num,roomprice,truntime,(select name from mode where code=jzfs) as jzfs from nowin where (handno=:phandno and isbj=:pisbj)');
     q1.ParamByName ('phandno').asstring:=trim(oldrmno.text);
     q1.ParamByName ('pisbj').asboolean:=true;
     q1.Prepare;
     q1.open;
     acc:=q1.fieldbyname('accno').asstring;
     oldsps.Caption:=q1.fieldbyname('num').asstring;
     oldprice.Text:=q1.fieldbyname('roomprice').asstring;
     turntime.Text:=q1.fieldbyname('truntime').asstring;
     djfs.text:=q1.fieldbyname('jzfs').asstring;
//     pleft:=q1.fieldbyname('isleft').asboolean;
     q1.Active :=false;
     q1.sql.clear;
     q1.sql.add('select handno,sex,Regid from nowin where accno=:pacc  and isbj=0 ');
     q1.ParamByName('pacc').asstring:=acc;
     q1.Prepare;
     q1.ExecSQL;
     getvalue(aa,'select room.Name,roomtype.Price,room.BedNum from room,roomtype where room.RoomType=RoomType.RoomType and roomno='''+trim(oldrmno.text)+'''');
     jfj.Caption:=aa[1];
     q1.active:=true;
     q1.first;
     i:=1;
     j:=1;
     while not q1.eof do
     begin
        if (trim(q1.fieldbyname('sex').asstring)='1') then
        begin
            blmanno.cells[0,i]:=trim(q1.fieldbyname('handno').asstring);
            blmanno.cells[1,i]:=trim(q1.fieldbyname('Regid').asstring);
            i:=i+1;
        end;
        if (trim(q1.fieldbyname('sex').asstring)='0')  then
        begin
            blwomanno.cells[0,j]:=trim(q1.fieldbyname('handno').asstring);
            blwomanno.cells[1,i]:=trim(q1.fieldbyname('Regid').asstring);
            j:=j+1;
        end  ;
        q1.next;
     end;
  end;
end;



procedure Thfform.Button2Click(Sender: TObject);
begin
  hfform.close;
end;

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

procedure Thfform.N2Click(Sender: TObject);
begin
   oldwomanno.Cells [0,oldwomanno.Row]:='';
end;

procedure Thfform.N1Click(Sender: TObject);
begin
   oldmanno.Cells [0,oldmanno.Row]:='';
end;

procedure Thfform.newmannoExit(Sender: TObject);
var
  i,y,x:integer;
  exno,errmsg,usemsg,msg:string;
  bb:array [0..1] of string;
begin
  i:=1;
  y:=newmanno.RowCount;
  errmsg:='';
  usemsg:='';
  msg:='';
  while i <=newmanno.RowCount  do
     begin
     if y>i then y:=i;
     if length(trim(newmanno.cells[0,i]))>0 then
        begin
        newmanno.cells[1,i]:=' ';
        bb[0]:='';
        getvalue(bb,'select status from mansan where roomno='''+trim(newmanno.cells[0,i])+'''');
        if length(trim(bb[0]))=0 then
           errmsg:=errmsg+' '+newmanno.cells[0,i]
        else
           begin
           if trim(bb[0])='1' then
              usemsg:=usemsg+' '+newmanno.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);
     newmanno.setfocus;
     newmanno.row:=y;
     exit;
     end;
  i:=1;
  y:=newmanno.rowcount;
  while i<=newmanno.rowcount do
     begin
     exno:=trim(newmanno.cells[0,i]);
     if length(exno)>0 then
        begin
        x:=i+1;
        while x<=newmanno.rowcount do
           begin
           if y>i then y:=i;
           if length(trim(newmanno.cells[0,x]))>0 then
              if  trim(newmanno.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+' 重号');
     newmanno.setfocus;
     newmanno.row:=y;
     exit;
     end;
end;

procedure Thfform.newwomannoExit(Sender: TObject);
var
  i,y,x:integer;
  exno,errmsg,usemsg,msg:string;
  bb:array [0..1] of string;
begin
  i:=1;
  y:=newwomanno.RowCount;
  errmsg:='';
  usemsg:='';
  msg:='';
  while i <=newwomanno.RowCount  do
     begin
     if y>i then y:=i;
     if length(trim(newwomanno.cells[0,i]))>0 then
        begin
        newwomanno.cells[1,i]:=' ';
        bb[0]:='';
        getvalue(bb,'select status from womansan where roomno='''+trim(newwomanno.cells[0,i])+'''');
        if length(trim(bb[0]))=0 then
           errmsg:=errmsg+' '+newwomanno.cells[0,i]
        else
           begin
           if trim(bb[0])='1' then
              usemsg:=usemsg+' '+newwomanno.cells[0,i];
           end;
        end;
     i:=i+1;
     end;
  if length(trim(errmsg))>0  then
     msg:='女散座'+errmsg+' 错误';