⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fz.pas

📁 集成酒店桑拿食管管理的完整程序
💻 PAS
字号:
unit fz;

interface

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

type
  Tfzform = class(TForm)
    Bevel3: TBevel;
    oldrmno: TStringGrid;
    oldmanno: TStringGrid;
    oldwomanno: TStringGrid;
    Label1: TLabel;
    hdno: TMaskEdit;
    newrmno: TStringGrid;
    newmanno: TStringGrid;
    newwomanno: TStringGrid;
    Bevel1: TBevel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    allyj: TEdit;
    Label5: TLabel;
    Bevel2: TBevel;
    Button1: TButton;
    Button2: TButton;
    q1: TQuery;
    newyj: TMaskEdit;
    s1: TStoredProc;
    Panel1: TPanel;
    man: TRadioButton;
    woman: TRadioButton;
    Button3: TButton;
    procedure hdnoExit(Sender: TObject);
    procedure manClick(Sender: TObject);
    procedure womanClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure newyjExit(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure oldrmnoDblClick(Sender: TObject);
    procedure oldmannoDblClick(Sender: TObject);
    procedure oldwomannoDblClick(Sender: TObject);
    procedure newrmnoDblClick(Sender: TObject);
    procedure newmannoDblClick(Sender: TObject);
    procedure newwomannoDblClick(Sender: TObject);
    procedure hdnoDblClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fzform: Tfzform;

implementation
uses dataproc, newdj,fzdyunit;

{$R *.DFM}
var
  shstr,nsanstr,vsanstr,acc:string;
procedure formini;
var
  i:integer;
begin
with fzform do
   begin
   hdno.text:='';
   allyj.text:='';
   newyj.text:='';
   i:=1;
   while i<=oldrmno.RowCount do
      begin
      if length(trim(oldrmno.Cells [0,i]))>0 then
         oldrmno.Cells [0,i]:='';
      i:=i+1;
      end;
   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<=newrmno.RowCount do
      begin
      if length(trim(newrmno.Cells [0,i]))>0 then
         newrmno.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 emptygrid(tg:tstringgrid):boolean;
var
  i:integer;
begin
  i:=1;
  emptygrid:=true;
  while i<=tg.rowcount do
     begin
     if length(trim(tg.cells[0,i]))>0 then
        begin
        emptygrid:=false;
        break;
        end;
     i:=i+1;
     end;
end;


procedure seehdno;
var
  i,a,b,c:integer;
  aa:array[0..1] of string;
begin
with fzform do
   begin
   //***********clear grid ***************//
   i:=1;
   while i<=oldrmno.rowcount do
     begin
     if length(trim(oldrmno.cells[0,i]))>0 then
        oldrmno.cells[0,i]:='';
     i:=i+1;
     end;
   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;
   //***********see deposit ***************//
   aa[0]:='';
   getvalue(aa,'select deposit from account where accno='''+trim(acc)+'''');
   allyj.Text :=trim(aa[0]);
   //***********see handno****************//
  shstr:=''; nsanstr:=''; vsanstr:='';
   a:=1;
   b:=1;
   c:=1;
   q1.Active :=false;
   q1.sql.clear;
   q1.sql.Add('select handno,sex from nowin where accno=:pacc');
   q1.ParamByName ('pacc').asstring:=acc;
   q1.Prepare;
   q1.open;
   q1.Active :=true;
   while not q1.eof do
     begin
     if q1.FieldByName ('sex').asstring='2' then
        begin
        oldrmno.Cells [0,a]:=q1.fieldbyname('handno').asstring;
        a:=a+1;
        shstr:=shstr+','+q1.fieldbyname('handno').asstring;
        end;
     if q1.FieldByName ('sex').asstring='1' then
        begin
        oldmanno.Cells [0,b]:=q1.fieldbyname('handno').asstring;
        b:=b+1;
        nsanstr:=nsanstr+','+q1.fieldbyname('handno').asstring;
        end;
     if q1.FieldByName ('sex').asstring='0' then
        begin
        oldwomanno.Cells [0,c]:=q1.fieldbyname('handno').asstring;
        c:=c+1;
        vsanstr:=vsanstr+','+q1.fieldbyname('handno').asstring;
        end;
       q1.next;
     end;
        vsanstr:=vsanstr+nsanstr;
   end;
end;

procedure Tfzform.hdnoExit(Sender: TObject);
begin
  if length(trim(hdno.text))>0 then
     begin
     q1.Active :=false;
     q1.sql.clear;
     q1.sql.add('select handno,accno,isbj from nowin where handno=:phdno and sex=:psex');
     q1.ParamByName ('phdno').asstring:=trim(hdno.text);
     if (Panel1.Visible) then
     begin
       if (man.Checked) then
         q1.ParamByName ('psex').asstring:='1';
       if (woman.Checked) then
         q1.ParamByName ('psex').asstring:='0';
     end
     else
     q1.ParamByName ('psex').asstring:='2';
     q1.Prepare;
     q1.open;
     q1.active:=true;
     acc:=q1.fieldbyname('accno').asstring;
     seehdno;
  end;
end;

procedure Tfzform.manClick(Sender: TObject);
var
  aa:array [0..1] of string;
begin
  if man.Checked =true then
     begin
     aa[0]:='';
     getvalue(aa,'select accno from nowin where (handno='''+trim(hdno.text)+''') and (sex=''1'')');
     if length(trim(aa[0]))>0 then
        begin
        acc:=trim(aa[0]);
        seehdno;
        end;
     end;
end;

procedure Tfzform.womanClick(Sender: TObject);
var
  aa:array [0..1] of string;
begin
  if woman.Checked =true then
     begin
     aa[0]:='';
     getvalue(aa,'select accno from nowin where (handno='''+trim(hdno.text)+''') and (sex=''0'')');
     if length(trim(aa[0]))>0 then
        begin
        acc:=trim(aa[0]);
        seehdno;
        end;
     end;
end;

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

procedure Tfzform.FormCreate(Sender: TObject);
begin
  formini;
  oldrmno.Cells [0,0]:='房间';
  oldmanno.Cells [0,0]:='男散';
  oldwomanno.Cells [0,0]:='女散';
  newrmno.Cells [0,0]:='房间';
  newmanno.Cells [0,0]:='男散';
  newwomanno.Cells [0,0]:='女散';
end;

procedure Tfzform.Button2Click(Sender: TObject);
begin
  fzform.Close;
end;

procedure adddata(tg:tstringgrid;xb:string);
var
  i:integer;
begin
  with fzform  do
  begin
  i:=1;
  while i<=tg.RowCount do
     begin
     if length(trim(tg.cells[0,i]))>0 then
        begin
        q1.active:=false;
        q1.sql.clear;
        q1.sql.add('insert into fzpara values(:phdno,:psex)');
        q1.parambyname('phdno').asstring:=trim(tg.Cells[0,i]);
        q1.parambyname('psex').asstring:=trim(xb);
        q1.prepare;
        q1.execsql;
        q1.active:=false;
        end;
     i:=i+1;
     end;
  end;
end;

procedure Tfzform.Button1Click(Sender: TObject);
begin
   if length(trim(newyj.text))=0 then
      begin
      showmessage('新帐押金不能为空');
      newyj.SetFocus ;
      exit;
      end;
   if (emptygrid(newrmno)=true) and (emptygrid(newmanno)=true) and (emptygrid(newwomanno)=true) then
      begin
      showmessage('没有新帐房间和散座');
      newrmno.SetFocus ;
      newrmno.row:=1;
      exit;
      end;
   if emptygrid(newrmno)=false then
      adddata(newrmno,'2');
   if emptygrid(newmanno)=false then
      adddata(newmanno,'1');
   if emptygrid(newwomanno)=false then
      adddata(newwomanno,'0');
   s1.UnPrepare;
   s1.ParamByName ('@iaccno').asstring:=trim(acc);
  // s1.ParamByName ('@newacc').asstring:=xdh('nowin','lslsnowin','AccNo',6);
   s1.ParamByName ('@newacc').asstring:=getnewcode('accno');
   s1.ParamByName ('@idepo').asinteger:=strtoint(trim(newyj.text));
   s1.Prepare;
   s1.ExecProc;
   s1.UnPrepare;
   addlogo(curper.code,datetimetostr(now),trim(acc)+'分帐');
   showmessage('分帐成功');
   formini;
   hdno.SetFocus ;
end;

procedure Tfzform.newyjExit(Sender: TObject);
var
  i:integer;
begin
  try
     if length(trim(newyj.text))>0 then
        begin
        i:=strtoint(trim(newyj.text));
        if i>strtoint(allyj.text) then
           begin
           showmessage('新帐押金不能大于全部押金');
           newyj.SetFocus ;
           end;
        end;
  except
     showmessage('押金错误');
     exit;
  end

end;

procedure Tfzform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   s1.free;
   q1.free;
end;

procedure Tfzform.oldrmnoDblClick(Sender: TObject);
begin
  oldtonew(oldrmno,newrmno,1);
end;

procedure Tfzform.oldmannoDblClick(Sender: TObject);
begin
  oldtonew(oldmanno,newmanno,1);
end;

procedure Tfzform.oldwomannoDblClick(Sender: TObject);
begin
  oldtonew(oldwomanno,newwomanno,1);

end;

procedure Tfzform.newrmnoDblClick(Sender: TObject);
begin
  oldtonew(newrmno,oldrmno,1);

end;

procedure Tfzform.newmannoDblClick(Sender: TObject);
begin
  oldtonew(newmanno,oldmanno,1);

end;

procedure Tfzform.newwomannoDblClick(Sender: TObject);
begin
  oldtonew(newwomanno,oldwomanno,1);

end;

procedure Tfzform.hdnoDblClick(Sender: TObject);
begin
  Application.CreateForm(Tdjform, djform);
  djform.Panel1.Visible:=false;
  djform.rmnogrid.Visible:=false;
  djform.Button1.Enabled:=false;
  djform.Timer1.Free;
  djform.showmodal;
  hdno.Text:=copy(trim(djform.xfrmno.Text),1,6);
  if length(trim(djform.xfrmno.Text))>6 then
  begin
    Panel1.Visible:=true;
    if trim(copy(trim(djform.xfrmno.Text),7,6))='1' then
    begin
      man.Checked:=true;
      woman.Checked:=false;
    end
    else
    begin
      man.Checked:=false;
      woman.Checked:=true;
    end;
  end
  else Panel1.Visible:=false;
  djform.Free;
  activecontrol:=oldrmno;
end;

procedure Tfzform.Button3Click(Sender: TObject);
var xfh,xns,xvs:string;
  i:integer;
begin
   xfh:='';xns:='';xvs:='';
    i:=1;
  while i<=newrmno.RowCount do
     begin
     if length(trim(newrmno.cells[0,i]))>0 then
        begin
        xfh:=xfh+','+trim(newrmno.Cells[0,i]);
        end;
        i:=i+1;
     end;
    i:=1;
  while i<=newmanno.RowCount do
     begin
     if length(trim(newmanno.cells[0,i]))>0 then
        begin
        xns:=xns+','+trim(newmanno.Cells[0,i]);
        end;
        i:=i+1;
     end;
    i:=1;
  while i<=newwomanno.RowCount do
     begin
     if length(trim(newwomanno.cells[0,i]))>0 then
        begin
        xvs:=xvs+','+trim(newwomanno.Cells[0,i]);
        end;
        i:=i+1;
     end;
     xvs:=xvs+xns;
     application.CreateForm(TfzdyForm,fzdyForm);
     fzdyForm.hfsj.Caption:=formatdatetime('yyyy-mm-dd HH:mm:ss',now);
     fzdyForm.ysh.Caption:=shstr;
     fzdyForm.yfj.Caption:=vsanstr;
     fzdyForm.yyrs.Caption:=allyj.Text;
     fzdyForm.xyrs.Caption:=newyj.Text;
     fzdyForm.xsh.Caption:=xfh;
     fzdyForm.xfj.Caption:=xvs;
     fzdyForm.hide;
     fzdyForm.QuickRep1.Preview;
     fzdyForm.Close;
     fzdyForm.free;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -