xgft.pas

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

unit xgft;

interface

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

type
  Txgftform = class(TForm)
    grid1: TStringGrid;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Button2: TButton;
    grid2: TStringGrid;
    Timer1: TTimer;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    Bevel6: TBevel;
    Bevel7: TBevel;
    Q2: TQuery;
    n2: TMenuItem;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel10: TPanel;
    Bevel8: TBevel;
    xgrmno: TEdit;
    Bevel9: TBevel;
    Bevel10: TBevel;
    Bevel11: TBevel;
    Bevel12: TBevel;
    Bevel13: TBevel;
    Bevel14: TBevel;
    Bevel15: TBevel;
    Bevel16: TBevel;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel11: TPanel;
    Panel12: TPanel;
    Panel13: TPanel;
    Panel14: TPanel;
    Bevel17: TBevel;
    Bevel18: TBevel;
    Bevel19: TBevel;
    Bevel20: TBevel;
    Panel15: TPanel;
    Panel16: TPanel;
    Panel17: TPanel;
    Panel18: TPanel;
    Bevel21: TBevel;
    Bevel22: TBevel;
    Panel19: TPanel;
    Panel20: TPanel;
    Bevel23: TBevel;
    Bevel24: TBevel;
    Panel21: TPanel;
    Panel22: TPanel;
    Bevel25: TBevel;
    mangrid: TStringGrid;
    womangrid1: TStringGrid;
    mangrid1: TStringGrid;
    womangrid: TStringGrid;
    jylgrid: TStringGrid;
    jylGrid1: TStringGrid;
    ComboBox1: TComboBox;
    Button1: TButton;
    Bevel26: TBevel;
    Panel23: TPanel;
    Panel24: TPanel;
    procedure grid1DrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure N1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure N2Click(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 grid2DrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure rmnogridKeyPress(Sender: TObject; var Key: Char);
    procedure rmnogridSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure grid1DblClick(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 jylgridDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure mangridDblClick(Sender: TObject);
    procedure grid1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure grid2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure mangridMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure womangridMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure jylgridMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  xgftform: Txgftform;

implementation
uses dataproc;
{$R *.DFM}
var
     dehdno,desex,dewel:string;
     lsroom:array [0..5,0..13] of string;
     llssroom:array [0..5,0..9] of string;
     lsstatusarr:array [0..5,0..13] of string[1];
     llssstatusarr:array [0..5,0..9] of string [1];
     //llssroomnum:array [0..4,0..6] of integer;
     currow,zdrmnum,roomnum,mannum,womannum:integer;
     rmtypearr:array[1..2,0..13] of string;

procedure roomini;
var i:integer;
begin
with xgftform do
   begin

   q2.Active :=false;
   q2.sql.clear;
   q2.sql.add('select RoomNo,status from mansan order by roomno');
//   q1.ParamByName ('pgridno').asinteger:=1;
   q2.Prepare;
   q2.open;
   i:=1;
   while  not  q2.EOF do
      begin
        mangrid1.Cells[i,0]:=q2.fieldbyname('status').asstring;
        mangrid.Cells[i,0]:=q2.fieldbyname('RoomNo').asstring;
        i:=i+1;
        q2.Next;
      end;
   mangrid.ColCount:=i+1;
   mangrid1.ColCount:=i+1;
   q2.Active :=false;
   q2.sql.clear;
   q2.sql.add('select * from womansan order by roomno');
   q2.Prepare;
   q2.open;
   i:=1;
   while  not  q2.EOF do
      begin
        womangrid.Cells[i,0]:=q2.fieldbyname('RoomNo').asstring;
        womangrid1.Cells[i,0]:=q2.fieldbyname('status').asstring;
        i:=i+1;
        q2.Next;
      end;
   womangrid.ColCount:=i+1;
   womangrid1.ColCount:=i+1;

   q2.Active :=false;
   q2.sql.clear;
   q2.sql.add('select * from jyl');
//   q1.ParamByName ('pgridno').asinteger:=1;
   q2.Prepare;
   q2.open;
   i:=1;
   while  not  q2.EOF do
      begin
        jylgrid.Cells[i,0]:=q2.fieldbyname('RoomNo').asstring;
        jylgrid1.Cells[i,0]:=q2.fieldbyname('status').asstring;
        i:=i+1;
        q2.Next;
      end;
   jylgrid.ColCount:=i+1;
   jylgrid1.ColCount:=i+1;

   q2.Active :=false;
   q2.sql.clear;
   q2.sql.add('select room.roomno,row,col,status,gridno from Room_Position,room where room.roomno=room_position.roomno');
   q2.Prepare;
   q2.open;
   q2.First;
   while  not  q2.EOF do
      begin
         if q2.fields[4].asinteger=1 then
         begin               //列     309 [2,0]                    行
            lsroom[q2.fields[1].asinteger,q2.fieldbyname('col').asinteger]:=q2.fieldbyname('Roomno').asstring;
            lsstatusarr[q2.fields[1].asinteger,q2.fieldbyname('col').asinteger]:=q2.fieldbyname('status').asstring;
         end;
         if q2.fields[4].asinteger=2 then
         begin
            llssroom[q2.fields[1].asinteger,q2.fieldbyname('col').asinteger]:=q2.fieldbyname('Roomno').asstring;
            llssstatusarr[q2.fields[1].asinteger,q2.fieldbyname('col').asinteger]:=q2.fieldbyname('status').asstring;
         end;
          q2.Next;
      end;
   q2.Close;
   q2.Active :=false;
   end;
end;


procedure xggrid(grid1: TStringGrid);
var i,j:integer;
begin

   for i:=0 to grid1.RowCount-1 do
       for j:=0 to grid1.ColCount-1 do
           begin
             grid1.row:=grid1.RowCount-1-i;
             grid1.col:=grid1.ColCount-1-j;
           end;
end;
procedure init;
begin
  with xgftform do
  begin
    dehdno:='';
    desex:='';
    dewel:='';
    roomini;
    xggrid(grid1);
    xggrid(grid2);
 end;
end ;

procedure Txgftform.grid1DrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
var
     lsfj :string;
     lsls:string;
     cc:Tbrush;
begin
   if (col=1) and (row=0) then
      lsls:='jllkjlkjl';
   grid1.canvas.font.color:=clred;
   grid1.canvas.font.style:=[fsbold];
//   grid1.canvas.font.size:=12;
   grid1.canvas.pen.mode:=pmCopy;
   lsfj:=lsroom[row,col];
    if length(trim(lsstatusarr[row,col]))>0 then
      begin
       cc:=grid1.canvas.brush;
       if trim(lsstatusarr[row,col])='0' then
          begin
           grid1.canvas.font.color:=$0000ff00;  //GReen
           lsls:=lsfj+' 空';
          end;
       if trim(lsstatusarr[row,col])='1' then
          begin
           grid1.canvas.font.color:=$000000ff;  //GRed
           lsls:=lsfj+' 满';
          end;
       if trim(lsstatusarr[row,col])='2' then
          begin
           grid1.canvas.font.color:=$0000ffff;  //Yellow
           lsls:=lsfj+' 脏';
          end ;
       if trim(lsstatusarr[row,col])='3' then
          begin
           grid1.canvas.font.color:=$00ffff00;  //
           lsls:=lsfj+' 修';
          end;
       if trim(lsstatusarr[row,col])='4' then
          begin
           grid1.canvas.font.color:=$02aa00aa;  //
           lsls:=lsfj+' 免';
          end;
       if trim(lsstatusarr[row,col])='5' then
          begin
           grid1.canvas.font.color:=clOlive;  //
           lsls:=lsfj+' 订';
          end;
       if trim(lsstatusarr[row,col])='6' then
          begin
           grid1.canvas.font.color:=$004080FF;  //
           lsls:=lsfj+' 通';
          end;
       if trim(lsstatusarr[row,col])='7' then
          begin
           grid1.canvas.font.color:=$003F8FA0;  //
           lsls:=lsfj+' 贵';
          end;
       grid1.canvas.textrect(grid1.cellrect(col,row),grid1.cellrect(col,row).Left,grid1.cellrect(col,row).Top,lsls);
       grid1.canvas.brush:=cc;
    end;
end;


procedure Txgftform.N1Click(Sender: TObject);
var i:integer;ls:string;bz:boolean;
begin
  ls:='';bz:=false;
  for i:=9 to length(ComboBox1.Items[0]) do
  begin
      if length(trim(copy(n1.Caption,1,4)))=4 then
      begin
      if trim(ComboBox1.Items[0][i])=trim(copy(trim(n1.Caption),2,1)) then
       begin
        bz:=true;
        break;
       end
       else bz:=false;
      end ;