rmstatus.pas

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

unit rmstatus;

interface

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

type
  Trmstatusform = class(TForm)
    mangrid: TStringGrid;
    womangrid: TStringGrid;
    Timer1: TTimer;
    grid1: TStringGrid;
    grid2: TStringGrid;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Label6: TLabel;
    Label7: TLabel;
    Label14: TLabel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    Bevel6: TBevel;
    Bevel7: TBevel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure grid1DrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure mangridDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure womangridDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure grid2DrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  rmstatusform: Trmstatusform;

implementation
uses dataproc;
{$R *.DFM}
VAR
     szacc:string[6];
     lsdjno,rmno:string;
     lsroom:array [0..4,0..9] of string[3];
     llssroom:array [0..4,0..6] of string [3];

procedure seeroom;
var
  x,y,lsrow,lscol:integer;
  lsls:string[4];
begin
  x:=1;
  lscol:=0;
  while lscol<=9 do
    begin
    if (x=4) or (x=5) or (x=8) then
       begin
       x:=x+1;
       Continue;
       end
    else
       y:=3;
       lsrow:=0;
       while lsrow<=4 do
          begin
          lsls:=inttostr(y)+copy(('0'+trim(inttostr(x))),length('0'+trim(inttostr(x)))-1,2);
          lsroom[lsrow,lscol]:=lsls;
          y:=y+1;
          lsrow:=lsrow+1;
          end;
       x:=x+1;
       lscol:=lscol+1;
    end;
    lsrow:=0;
    while lsrow<=4 do
      begin
      llssroom[lsrow,0]:=inttostr(lsrow+3)+'08';
      lsrow:=lsrow+1;
      end;
    lsrow:=0;
    while lsrow<=4 do
      begin
      llssroom[lsrow,1]:=inttostr(lsrow+3)+'05';
      lsrow:=lsrow+1;
      end;
    llssroom[0,1]:='';  
    llssroom[0,2]:='316';
    llssroom[1,2]:='416';
    llssroom[2,2]:='716';
    llssroom[0,3]:='315';
    llssroom[1,3]:='415';
    llssroom[2,3]:='715';
    llssroom[3,3]:='801';
    llssroom[4,3]:='802';
    llssroom[0,4]:='803';
    llssroom[1,4]:='809';
    llssroom[2,4]:='810';
    llssroom[3,4]:='812';
    llssroom[0,5]:='808';
    llssroom[1,5]:='811';
    llssroom[0,6]:='805';
    llssroom[1,6]:='305';
end;


procedure Trmstatusform.FormCreate(Sender: TObject);
var
  i,y:integer;
  ss : array [0..1] of string;
begin
  seeroom;
  mangrid.Cells [0,0]:='男散';
  womangrid.Cells [0,0]:='女散';
  getvalue(ss,'select  floor,floorroom from syssetup');
end;

procedure Trmstatusform.grid1DrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
var  ss :array  [0..1] of string;
     lsfj :string;
     lsls:string;
     bb:Tbrush;
     tt:trect;
begin
   grid1.canvas.font.color:=clred;
   grid1.canvas.font.style:=[fsbold];
   grid1.canvas.font.size:=8;
   grid1.canvas.pen.mode:=pmCopy;
   lsfj:=lsroom[row,col];
   ss[0]:='';
   getvalue(ss,'select status from room where roomno="'+lsfj+'"');
    if length(trim(ss[0]))>0 then
      begin
       if ss[0]='0' then
          begin
           grid1.canvas.font.color:=$0000ff00;  //GReen
           lsls:=lsfj+' OK';
          end;
       if ss[0]='1' then
          begin
           grid1.canvas.font.color:=$000000ff;  //GRed
           lsls:=lsfj+' OR';
          end;
       if ss[0]='2' then
          begin
           grid1.canvas.font.color:=$0000ffff;  //GReen
           lsls:=lsfj+' OD';
          end ;
       if ss[0]='3' then
          begin
           grid1.canvas.font.color:=$00ffff00;  //GReen
           lsls:=lsfj+' OOO';
          end;
       if ss[0]='4' then
          begin
           grid1.Canvas.Font.Color:=$02aa00aa;
           lsls:=lsfj+' OW';
          end;
       grid1.canvas.textrect(grid1.cellrect(col,row),grid1.cellrect(col,row).Left,grid1.cellrect(col,row).Top,lsls);
    end;
end;




procedure Trmstatusform.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
       if ss[0]='4' then
          mangrid.canvas.brush.color:=$02aa00aa;  //  blank
       tt:=mangrid.cellrect(col,row);
       mangrid.canvas.textrect(tt,tt.Left,tt.Top,lsroom);
       mangrid.canvas.brush:=bb;
    end;
end;

procedure Trmstatusform.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
       if ss[0]='4' then
          womangrid.canvas.brush.color:=$02aa00aa;  //  blank
       tt:=womangrid.cellrect(col,row);
       womangrid.canvas.textrect(tt,tt.Left,tt.Top,lsroom);
       womangrid.canvas.brush:=bb;
    end;
end;


procedure Trmstatusform.grid2DrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
var  ss :array  [0..1] of string;
     lsfj :string;
     lsls:string;
     bb:Tbrush;
     tt:trect;
begin
   grid2.canvas.font.color:=clred;
   grid2.canvas.font.style:=[fsbold];
   grid2.canvas.font.size:=8;
   grid2.canvas.pen.mode:=pmCopy;
   lsfj:=llssroom[row,col];
   getvalue(ss,'select status from room where roomno="'+lsfj+'"');
    if length(trim(ss[0]))>0 then
      begin
       bb:=grid2.canvas.brush;
       if ss[0]='0' then
          begin
           grid2.canvas.font.color:=$0000ff00;  //GReen
           lsls:=lsfj+' OK';
          end;
       if ss[0]='1' then
          begin
           grid2.canvas.font.color:=$000000ff;  //GReen
           lsls:=lsfj+' OR';
          end;
       if ss[0]='2' then
          begin
           grid2.canvas.font.color:=$0000ffff;  //GReen
           lsls:=lsfj+' OD';
          end ;
       if ss[0]='3' then
          begin
           grid2.canvas.font.color:=$00ffff00;  //GReen
           lsls:=lsfj+' OOO';
          end;
       if ss[0]='4' then
          begin
           grid2.Canvas.Font.Color:=$02aa00aa;
           lsls:=lsfj+' OW';
          end;
       grid2.canvas.textrect(grid2.cellrect(col,row),grid2.cellrect(col,row).Left,grid2.cellrect(col,row).Top,lsls);
       grid2.canvas.brush:=bb;
    end;
end;



Function checkgrid(tg:tstringgrid):boolean;
begin
end;

procedure Trmstatusform.Timer1Timer(Sender: TObject);
var i,j:integer;
     tt:trect;
begin
    grid1.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
    for i:=0 to grid1.colcount-1 do
       for j:=0 to grid1.rowcount-1  do
            rmstatusform.grid1drawcell(nil,i,j,tt,[gdFocused]);
    grid1.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];

    grid2.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
    for i:=0 to grid2.colcount-1 do
       for j:=0 to grid2.rowcount-1  do
            rmstatusform.grid2DrawCell(nil,i,j,tt,[gdFocused]);
    grid2.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];

    womangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
    for i:=1 to womangrid.colcount-1 do
         rmstatusform.womangriddrawcell(nil,i,0,tt, [gdFocused]);
    womangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];

   mangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect,goEditing];
   for i:=1 to mangrid.colcount-1 do
         rmstatusform.mangriddrawcell(nil,i,0,tt, [gdFocused]);
   mangrid.options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,goRangeSelect];

end;

procedure Trmstatusform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  timer1.free;
  grid1.Free;
  grid2.free;
  mangrid.free;
  womangrid.free;
end;

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




procedure Trmstatusform.Button1Click(Sender: TObject);
begin
  rmstatusform.Close;
end;

end.