qtdj.pas

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

unit qtdj;

interface

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

type
  Tdj = class(TForm)
    grid1: TStringGrid;
    mangrid: TStringGrid;
    womangrid: TStringGrid;
    rmnogrid: TStringGrid;
    mansygrid: TStringGrid;
    womansygrid: TStringGrid;
    Label8: TLabel;
    yj: TSpinEdit;
    Label9: TLabel;
    guest: TSpinEdit;
    Label10: TLabel;
    Label11: TLabel;
    szno: TMaskEdit;
    pdj: TMaskEdit;
    Label12: TLabel;
    Label13: TLabel;
    reg: TMaskEdit;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    MaskEdit1: TMaskEdit;
    Button1: TButton;
    Button2: TButton;
    q1: TQuery;
    djnoproc: TStoredProc;
    accproc: TStoredProc;
    Timer1: TTimer;
    card: TCheckBox;
    Label1: TLabel;
    cardh: TMaskEdit;
    gz: TCheckBox;
    Label2: TLabel;
    gzmc: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure grid1DrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure N1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure rmnogridExit(Sender: TObject);
    procedure mangridDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure womangridDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure N2Click(Sender: TObject);
    procedure mansygridExit(Sender: TObject);
    procedure womansygridExit(Sender: TObject);
    procedure MaskEdit1Exit(Sender: TObject);
    procedure sznoExit(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cardClick(Sender: TObject);
    procedure gzClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  dj: Tdj;

implementation
uses dataproc;
{$R *.DFM}
VAR
     szacc:string[6];
     lsdjno,rmno:string;

procedure init;
var
    lsrow,lscol,i:integer;
     tt:trect;
begin
  with dj do
  begin
    maskedit1.Text :=datetimetostr(now);
    yj.value:=300;
    szno.text:='';
    guest.value:=0;
    pdj.text:='';
    cardh.Text :='';
    card.Checked :=false;
    gz.Checked :=false;
    grid1.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
    for i:=1 to rmnogrid.rowcount-1 do
      if rmnogrid.cells[0,i]<>'' then
      begin
         lsrow:=strtoint(copy(rmnogrid.cells[0,i],1,2));
         lscol:=strtoint(copy(rmnogrid.cells[0,i],3,2));;
         rmnogrid.cells[0,i]:='';
         rmnogrid.cells[1,i]:='';
         dj.grid1drawcell(nil,lsrow,lscol,tt,[gdFocused]);
      end ;
    grid1.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];
    womangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
   for i:=1 to womansygrid.rowcount-1 do
    if womansygrid.cells[0,i]<>'' then
      begin
         lscol:=strtoint(womansygrid.cells[0,i]);;
         womansygrid.cells[0,i]:='';
         dj.womangriddrawcell(nil,0,lscol,tt, [gdFocused]);
      end  ;
   womangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];
   mangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
   for i:=1 to mansygrid.rowcount-1 do
    if mansygrid.cells[0,i]<>'' then
      begin
         lscol:=strtoint(mansygrid.cells[0,i]);;
         mansygrid.cells[0,i]:='';
         dj.mangriddrawcell(nil,0,lscol,tt, [gdFocused]);
      end ;
    mangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];
    mansygrid.cells[0,1]:='';
    womansygrid.cells[0,1]:='';
    rmnogrid.cells[0,1]:='';
  end
end ;

procedure Tdj.FormCreate(Sender: TObject);
var
  i,y:integer;
  ss : array [0..1] of string;
begin
  reg.Text:=curper.code+' '+curper.name;
  shortdateformat:='yyyy-mm-dd';
  maskedit1.Text :=datetimetostr(now);
  rmnogrid.Cells [0,0]:='房间';
  rmnogrid.Cells [1,0]:='钟点';
  mansygrid.Cells [0,0]:='男散';
  womansygrid.Cells [0,0]:='女散';
  mangrid.Cells[0,0]:='男散';
  womangrid.Cells[0,0]:='女散';
  comadd(dj.gzmc,2,'select gzno,gzname from gzdbf');
  getvalue(ss,'select  floor,floorroom from syssetup');
  grid1.Colcount:=strtoint(ss[1])+1;
  grid1.Rowcount:=strtoint(ss[0])+1;
  grid1.DefaultColWidth:=(grid1.Width-24-grid1.Colcount)div(grid1.Colcount-1);
  grid1.Defaultrowheight:=(grid1.height-24-grid1.rowcount)div(grid1.rowcount-1) ;
  if grid1.DefaultColWidth<28 then
    grid1.DefaultColWidth:=28;
  if grid1.Defaultrowheight<28 then
     grid1.Defaultrowheight:=28;
  grid1.colwidths[0]:=20;
  grid1.rowheights[0]:=20;
  i:=1;
  while i<=strtoint(ss[0]) do
     begin
     grid1.cells[0,i]:=copy(('0'+trim(inttostr(i))),length('0'+trim(inttostr(i)))-1,2);
     i:=i+1;
     end   ;
  i:=1;
  while i<=strtoint(ss[1]) do
     begin
     grid1.cells[i,0]:=copy(('0'+trim(inttostr(i))),length('0'+trim(inttostr(i)))-1,2);
     i:=i+1;
     end
end;



procedure Tdj.grid1DrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
var  ss :array  [0..1] of string;
     lsroom :string;
     lsls:string;
     bb:Tbrush;
     tt:trect;
begin
    if (row=0) or (col=0) then
      exit;
    lsls:=copy(('0'+trim(inttostr(Row))),length('0'+trim(inttostr(row)))-1,2);
    lsroom:=lsls;
    lsls:=copy(('0'+trim(inttostr(col))),length('0'+trim(inttostr(col)))-1,2);
    lsroom:=lsroom+lsls;
    getvalue(ss,'select status from room where roomno="'+lsroom+'"');
    if ss[0]<>'' then
      begin
       bb:=grid1.canvas.brush;
       if ss[0]='0' then
           grid1.canvas.brush.color:=$0000ff00;  //GReen
       if ss[0]='1' then
           grid1.canvas.brush.color:=$000000ff;  // Red
       if ss[0]='2' then
           grid1.canvas.brush.color:=$0000ffff;  // Yellow
       if ss[0]='3' then
          grid1.canvas.brush.color:=$00ffff00;  //  blank
       tt:=grid1.cellrect(col,row);
       grid1.canvas.textrect(tt,tt.Left,tt.Top,lsroom);
       grid1.canvas.brush:=bb;
    end;
end;




procedure Tdj.N1Click(Sender: TObject);
var
  rmno,rowh,colh,lsss:string;
  lsii,i:integer;
  tt:tstringgrid;
begin
end;

procedure Tdj.PopupMenu1Popup(Sender: TObject);
var
  rmno,rowh,colh:string;
  aa:array [0..1]of string;
  tt:tstringgrid;
  lsss,lstab: string;
  lsii,lsmenu,i :integer;
begin
  tt:=tstringgrid(activecontrol);
  if activecontrol=grid1 then
  begin
     rmno:=copy(lsss+inttostr(grid1.row),length(inttostr(grid1.row)),lsii);
     tt:=rmnogrid;
     lstab:='room';
     lsmenu:=0;
  end;
  if activecontrol=mangrid then
  begin
       lsss:='00';
       lsii:=3;
       rowh:='';
       lstab:='mansan';
       tt:=mansygrid;
       lsmenu:=1;
  end;
  if activecontrol=womangrid then
  begin
     lsss:='00';
     lsii:=3;
     rowh:='';
     tt:=womansygrid;
     lstab:='womansan';
     lsmenu:=1;
  end;
  colh:=copy(lsss+inttostr(tstringgrid(activecontrol).col),length(inttostr(tstringgrid(activecontrol).col)),lsii);
  rmno:=rowh+colh;
  aa[0]:='';
  getvalue(aa,'select status from '+lstab+' where roomno="'+trim(rmno)+'"');
  popupmenu1.items[0].enabled:=false;
  popupmenu1.items[1].enabled:=false;
  if aa[0]='0' then
  begin
      for i:=1 to rmnogrid.rowcount-1 do
        if trim(tt.Cells [0,i])=trim(rmno) then
           break;
      if i>rmnogrid.rowcount-1 then
          popupmenu1.items[lsmenu].enabled:=true
  end
end;

procedure Tdj.rmnogridExit(Sender: TObject);
var
  aa:array [0..1] of string;
  i,j:integer;
  ss:string;
begin
  j:=14;
  ss:='';

  for i:=1 to rmnogrid.rowcount-1 do
     if  (length(trim(rmnogrid.cells[0,i]))<>0) then
       begin
          aa[0]:='';
          getvalue(aa,'select status from room where roomno="'+trim(rmnogrid.cells[0,i])+'"');
          if (aa[0]<>'0') or (aa[0]='') then
             begin
               if j>i then  j:=i   ;
               ss:=ss+rmnogrid.cells[0,i]+'  ';
             end
             // rmnogrid.cells[0,i]:='';
       end;
  if ss<>'' then
    begin
       showmessage('房间 '+ss+' 非法!');
       rmnogrid.row:=j;
       rmnogrid.setfocus;
    end;

  for i:=1 to rmnogrid.rowcount-1 do
     begin
     if length(trim(rmnogrid.cells[0,i]))=0 then
        rmnogrid.cells[1,i]:=''
     else
        if (rmnogrid.cells[1,i]<>'0') and (rmnogrid.cells[1,i]<>'1') then
           rmnogrid.cells[1,i]:='0';
     end;
end;

procedure Tdj.mangridDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
var  ss :array  [0..1] of string;
     lsroom :string;
     bb:Tbrush;
     tt:trect;
begin
   if col=0 then
    exit;
    lsroom:=copy('00'+trim(inttostr(col)),length(trim(inttostr(col))),3);
    ss[0]:='';
    getvalue(ss,'select status from mansan where roomno="'+lsroom+'"');
    if ss[0]<>'' then
      begin
       bb:=mangrid.canvas.brush;
       if ss[0]='0' then
           mangrid.canvas.brush.color:=$0000ff00;  //GReen
       if ss[0]='1' then
           mangrid.canvas.brush.color:=$000000ff;  // Red
       if ss[0]='2' then
           mangrid.canvas.brush.color:=$0000ffff;  // Yellow
       if ss[0]='3' then
          mangrid.canvas.brush.color:=$00ffff00;  //  blank
       tt:=mangrid.cellrect(col,row);
       mangrid.canvas.textrect(tt,tt.Left,tt.Top,lsroom);
       mangrid.canvas.brush:=bb;
    end;
end;

procedure Tdj.womangridDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
var  ss :array  [0..1] of string;
     lsroom :string;
     bb:Tbrush;
     tt:trect;
begin
    if col=0 then
    exit;
    lsroom:=copy('00'+trim(inttostr(col)),length(trim(inttostr(col))),3);
    ss[0]:='';
    getvalue(ss,'select status from womansan where roomno="'+lsroom+'"');
    if ss[0]<>'' then
      begin
       bb:=womangrid.canvas.brush;
       if ss[0]='0' then
           womangrid.canvas.brush.color:=$0000ff00;  //GReen
       if ss[0]='1' then
           womangrid.canvas.brush.color:=$000000ff;  // Red
       if ss[0]='2' then
           womangrid.canvas.brush.color:=$0000ffff;  // Yellow
       if ss[0]='3' then
          womangrid.canvas.brush.color:=$00ffff00;  //  blank
       tt:=womangrid.cellrect(col,row);
       womangrid.canvas.textrect(tt,tt.Left,tt.Top,lsroom);
       womangrid.canvas.brush:=bb;
    end;
end;
procedure Tdj.N2Click(Sender: TObject);
begin
  dj.n1click(NIl);
end;

procedure Tdj.mansygridExit(Sender: TObject);
var
  aa:array [0..1] of string;
  i,j,y:integer;
  ss:string;
begin