xf.pas

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

unit xf;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, Grids, StdCtrls, Mask,registry;

type
  Txfform = class(TForm)
    grid: TStringGrid;
    Query1: TQuery;
    Label1: TLabel;
    hdno: TMaskEdit;
    Label2: TLabel;
    time: TMaskEdit;
    Label3: TLabel;
    czy: TMaskEdit;
    Label4: TLabel;
    djno: TMaskEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label5: TLabel;
    yj: TMaskEdit;
    Label6: TLabel;
    xf: TMaskEdit;
    Label7: TLabel;
    Edit1: TEdit;
    S1: TStoredProc;
    S2: TStoredProc;
    man: TRadioButton;
    woman: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure gridSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure hdnoExit(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure gridKeyPress(Sender: TObject; var Key: Char);
    procedure gridExit(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure manClick(Sender: TObject);
    procedure womanClick(Sender: TObject);
    procedure hdnoEnter(Sender: TObject);
    procedure djnoExit(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  xfform: Txfform;

implementation
uses dataproc;

{$R *.DFM}
var
  acc,lssex,ls:string;
  code:array [0..100] of string[6] ;
  zy:array [0..100] of boolean;
  custype:array [0..100] of string[2];

procedure unlocka;
begin
 with xfform do
   begin
   s2.ParamByName ('@ihand').asstring:=acc;
   s2.ParamByName ('@iwdno').asstring:=ls;
   s2.Prepare;
   s2.ExecProc ;
 end
end;

procedure   locka;
begin
  with  xfform   do
   begin
    s1.ParamByName ('@ihand').asstring:=acc;
    s1.ParamByName ('@iwdno').asstring:=ls;
    s1.Prepare;
    s1.ExecProc ;
  end
end;

procedure init;
var
  i:integer;
begin
  acc:='';
with  xfform do
  begin

    man.Enabled :=false;
    woman.Enabled :=false;
    hdno.text:='';
    djno.text:='';
    time.text:=datetimetostr(now);
    czy.text:=curper.code+' '+curper.name;
    yj.text:='';
    xf.Text :='';
    edit1.text:='0';
    i:=1;
    while i<grid.RowCount  do
      begin
      grid.Cells [2,i]:=' ';
      grid.Cells [3,i]:=' ';
      grid.Cells [4,i]:=' ';
      i:=i+1;
      end;
  end
end;

procedure Txfform.FormCreate(Sender: TObject);
var
  i:integer;
  tt:tregistry;
begin
   tt:=Tregistry.Create;
   tt.Rootkey:=HKEY_LOCAL_MACHINE;
   if  tt.openkey('system\currentcontrolset\control\computername\computername',false) then
       ls:=tt.readstring('computername');
   tt.free;
   shortdateformat:='yyyy-mm-dd';
   init;
   query1.Active :=false;
   query1.sql.clear;
   query1.sql.add('select cusname,price,custype,cuscode,iszy from cusitem ');
   query1.Prepare;
   query1.Open;
   query1.Active :=true;
   grid.RowCount :=query1.RecordCount+1 ;
   grid.Cells[0,0]:='   消费项目   ';
   grid.Cells[1,0]:='   消费单价   ';
   grid.cells[2,0]:='   消费金额   ';
   grid.cells[3,0]:='   消费数量   ';
   grid.cells[4,0]:='   专业人员    ';
   i:=1;
   if query1.RecordCount >0 then
      begin
      query1.First ;
      while not query1.EOF  do
         begin
         grid.Cells [0,i]:=query1.fieldbyname('cusname').asstring;
         grid.Cells [1,i]:=floattostr(query1.fieldbyname('price').asfloat);
         code[i-1]:=query1.fieldbyname('cuscode').asstring;
         custype[i-1]:=query1.fieldbyname('custype').asstring;
         zy[i-1]:=query1.fieldbyname('iszy').asboolean;
         i:=i+1;
         query1.next;
         end
      end
end;

procedure Txfform.gridSetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: String);
var
  curxf,syyj:double;
  i:integer;
begin
  try
     //*****************************************//
     if length(trim(grid.cells[3,arow]))>0 then
        grid.Cells [2,arow]:=floattostr(strtofloat(grid.cells[1,arow])*strtofloat(grid.cells[3,arow]))
     else
        grid.Cells [2,arow]:='';
     curxf:=0.00;
     i:=1;
     while i<=grid.rowcount do
        begin
        if length(trim(grid.cells[2,i]))>0 then
           curxf:=curxf+strtofloat(grid.cells[2, i]);
        i:=i+1;
        end;
     edit1.text:=floattostr(curxf);
     syyj:=strtofloat(yj.text)-strtofloat(xf.text)-curxf;
     if syyj<0 then
        begin
         showmessage('押金只剩'+floattostr(syyj+strtofloat(grid.cells[2,arow]))+'元');
         edit1.text:=floattostr(curxf-strtofloat(grid.cells[2,arow]));
         grid.cells[acol,arow]:='';
         grid.cells[2,arow]:='';
        end;
     //*****************************************//
     if ((zy[arow-1]=false) or (length(trim(grid.cells[3,arow]))=0)) then
        grid.cells[4,arow]:='';
     //*****************************************//
  except
  end;
end;

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

procedure Txfform.hdnoExit(Sender: TObject);
var
  aa:array [0..1] of string;
begin
  if length(trim(hdno.text))=0 then
  begin
    grid.Enabled :=false;
    hdno.SetFocus ;
    exit;
  end ;
  query1.Active :=false;
  query1.sql.clear;
  query1.sql.add('select accno,isbj,sex from nowin where handno=:phandno');
  query1.ParamByName ('phandno').asstring:=trim(hdno.text);
  query1.Prepare;
  query1.Open;
  query1.Active :=true;
  if query1.RecordCount =0 then
      begin
          showmessage('手号不存在');
          grid.Enabled :=false;
          hdno.SetFocus ;
          exit;
      end   ;
  if query1.RecordCount =1 then
      begin
        if (query1.FieldByName ('isbj').asboolean=false)  and (query1.FieldByName ('sex').asstring='1') then
           man.Checked :=true;
        if (query1.FieldByName ('isbj').asboolean=false)  and (query1.FieldByName ('sex').asstring='0') then
           woman.Checked :=true;
        woman.enabled:=false;
        man.enabled:=false;
        lssex:=query1.fieldbyname('sex').asstring;
        acc:=query1.fieldbyname('accno').asstring;
        getvalue(aa,'select Deposit,Custom  from account where accno="'+trim(acc)+'"');
        yj.text:=trim(aa[0]);
        xf.text:=trim(aa[1]);
        if (query1.FieldByName ('isbj').asboolean=true)  then
          locka;
        exit;
      end   ;
  if query1.RecordCount >=2 then
     begin
       man.Checked :=true;
     end;
end;



procedure Txfform.Button3Click(Sender: TObject);
begin
{ if length(trim(hdno.text))>0 then
 begin
   s2.ParamByName ('@ihand').asstring:=trim(hdno.text);
   s2.ParamByName ('@iwdno').asstring:=ls;
   s2.Prepare;
   s2.ExecProc ;
 end;         }
 xfform.close;
end;

procedure Txfform.Button1Click(Sender: TObject);
var
   i:integer;
begin
   if length(trim(hdno.text))=0 then
      begin
      showmessage('手号不能为空');
      hdno.setfocus;
      exit;
      end;
   if length(trim(djno.text))=0 then
      begin
      showmessage('单号不能为空');
      djno.setfocus;
      exit;
      end;
   //********************************************//
   if strtofloat(trim(edit1.text))=0 then
      begin
      showmessage('消费单无效');
      hdno.SetFocus ;
      exit;
      end
   else
      begin
      query1.Active :=false;
      query1.sql.clear;
      query1.sql.add('update account set custom=:pcustom where accno=:paccno');
      query1.ParamByName ('pcustom').asfloat:=strtofloat(trim(xf.text))+strtofloat(trim(edit1.text));
      query1.ParamByName ('paccno').asstring:=acc;
      query1.Prepare;
      query1.ExecSQL;
      end;
   //********************************************//
   i:=1;
   while i<=grid.RowCount do
         begin
         if length(trim(grid.cells[3,i]))>0  then
            begin
            query1.Active :=false;
            query1.sql.clear;
            query1.sql.add('insert into custom (handno,sex,accno,custype,cuscode,cusprice,cusnum,money,regtime,proid,regid,djcode)');
            query1.sql.add(' values(:phandno,:psex,:paccno,:pcustype,:pcuscode,:pprice,:pnum,:pmoney,:pregtime,:pproid,:pregid,:pdjcode)');
            query1.ParamByName ('phandno').asstring:=trim(hdno.text);
            query1.ParamByName ('psex').asstring:=lssex;
            query1.ParamByName ('paccno').asstring:=acc;
            query1.ParamByName ('pcustype').asstring:=custype[i-1];
            query1.ParamByName ('pcuscode').asstring:=code[i-1];
            query1.ParamByName ('pprice').asfloat:=strtofloat(trim(grid.cells[1,i]));
            query1.ParamByName ('pnum').asfloat:=strtofloat(trim(grid.cells[3,i]));
            query1.ParamByName ('pmoney').asfloat:=strtofloat(trim(grid.cells[2,i]));
            query1.ParamByName ('pregtime').asdatetime:=strtodatetime(trim(time.text));
            query1.ParamByName ('pproid').asstring:=trim(grid.cells[4,i]);
            query1.ParamByName ('pregid').asstring:=copy(trim(czy.text),1,6);
            query1.ParamByName ('pdjcode').asstring:=trim(djno.text);
            query1.Prepare;
            query1.ExecSQL;
            end;
         i:=i+1;
         end;
   showmessage('消费单录入成功');
   unlocka;
   init;
   hdno.setfocus;
end;

procedure Txfform.Button2Click(Sender: TObject);
begin
   if length(trim(hdno.text))>0 then
   begin
     unlocka;
   end;
   init;
   hdno.setfocus;
end;

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

procedure Txfform.gridExit(Sender: TObject);
var
  aa:array [0..1] of string;
  i:integer;
  msg:string;
begin
   i:=1;
   msg:='';
   while i<=grid.RowCount do
      begin
      if ((zy[i-1]=true) and (length(trim(grid.cells[3,i]))>0)) and (length(trim(grid.cells[4,i]))>0) then
         begin
         aa[0]:='';
         getvalue(aa,'select code from stuff where code="'+trim(grid.cells[4,i])+'"');
         if length(trim(aa[0]))=0 then
            msg:=msg+' '+trim(grid.cells[4,i]);
         end;
      i:=i+1;
      end;
   if length(trim(msg))>0 then
      begin
      showmessage('专业人员 '+msg+' 错误');
      grid.SetFocus ;
      end;
end;

procedure Txfform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 query1.free;
 if length(trim(hdno.text))>0 then
   begin
     unlocka;
   end;
 s1.free;
 s2.free;
end;

procedure Txfform.manClick(Sender: TObject);
var aa :array [0..1] of string;
begin
   aa[0]:='';
   getvalue(aa,'select accno  from nowin where handno="'+hdno.text+'" and sex="'+'1"');
   if aa[0]<>'' then
      begin
        acc:=aa[0];
        unlocka;
        locka;
        grid.Enabled :=true;
        lssex:='1';
      end   ;
   aa[0]:='';
   getvalue(aa,'select deposit,custom from account where accno="'+acc+'"');
   if aa[0]<>'' then
   begin
     yj.text:=trim(aa[0]);
     xf.text:=trim(aa[1]);
   end
end;

procedure Txfform.womanClick(Sender: TObject);
var aa :array [0..1] of string;
begin
   aa[0]:='';
   getvalue(aa,'select accno  from nowin where handno="'+hdno.text+'" and sex="'+'0"');
   if aa[0]<>'' then
      begin
        acc:=aa[0];
        unlocka;
        locka;
        grid.Enabled :=true;
        lssex:='0';
      end   ;
   aa[0]:='';
   getvalue(aa,'select deposit,custom from account where accno="'+acc+'"');
   if aa[0]<>'' then
   begin
     yj.text:=trim(aa[0]);
     xf.text:=trim(aa[1]);
   end
end;

procedure Txfform.hdnoEnter(Sender: TObject);
begin
        grid.Enabled :=true;
        man.Enabled :=true;
        woman.Enabled :=true;
       if acc<>'' then
        unlocka;
end;

procedure Txfform.djnoExit(Sender: TObject);
begin
  if djno.text='' then
     djno.setfocus;
end;

end.