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

📄 rb.pas

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

interface

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

type
  Trbform = class(TForm)
    grid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    q1: TQuery;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  rbform: Trbform;

implementation
uses dataproc;

{$R *.DFM}
var
  lsrow:integer;
  lsdate:string;

procedure  datatogrid;
begin
with rbform do
  begin
    if q1.fieldbyname('xj').asfloat=0  then
       grid1.cells[1,lsrow]:=''
    else
       begin
       grid1.cells[1,lsrow]:=floattostr(q1.fieldbyname('xj').asfloat);
       grid1.Cells[1,lsrow]:=grid1.Cells[1,lsrow]+copy('  ',1,(length(grid1.Cells[1,lsrow]) mod 2));
       end ;
    if q1.fieldbyname('zp').asfloat=0  then
       grid1.cells[2,lsrow]:=''
    else
       begin
       grid1.cells[2,lsrow]:=floattostr(q1.fieldbyname('zp').asfloat);
       grid1.Cells[2,lsrow]:=grid1.Cells[2,lsrow]+copy('  ',1,(length(grid1.Cells[2,lsrow]) mod 2));
       end;
    if q1.fieldbyname('card').asfloat=0  then
       grid1.cells[3,lsrow]:=''
    else
       begin
       grid1.cells[3,lsrow]:=floattostr(q1.fieldbyname('card').asfloat);
       grid1.Cells[3,lsrow]:=grid1.Cells[3,lsrow]+copy('  ',1,(length(grid1.Cells[3,lsrow]) mod 2));
       end;
    if q1.fieldbyname('gz').asfloat=0  then
       grid1.cells[4,lsrow]:=''
    else
       begin
       grid1.cells[4,lsrow]:=floattostr(q1.fieldbyname('gz').asfloat);
       grid1.Cells[4,lsrow]:=grid1.Cells[4,lsrow]+copy('  ',1,(length(grid1.Cells[4,lsrow]) mod 2));
       end;
    if q1.fieldbyname('md').asfloat=0  then
       grid1.cells[5,lsrow]:=''
    else
       begin
       grid1.cells[5,lsrow]:=floattostr(q1.fieldbyname('md').asfloat);
       grid1.Cells[5,lsrow]:=grid1.Cells[5,lsrow]+copy('  ',1,(length(grid1.Cells[5,lsrow]) mod 2));
       end;
    if q1.fieldbyname('other').asfloat=0  then
       grid1.cells[6,lsrow]:=''
    else
       begin
       grid1.cells[6,lsrow]:=floattostr(q1.fieldbyname('other').asfloat);
       grid1.Cells[6,lsrow]:=grid1.Cells[6,lsrow]+copy('  ',1,(length(grid1.Cells[6,lsrow]) mod 2));
       end;
    if q1.fieldbyname('xiaoj').asfloat=0  then
       grid1.cells[7,lsrow]:=''
    else
       begin
       grid1.cells[7,lsrow]:=floattostr(q1.fieldbyname('xiaoj').asfloat);
       grid1.Cells[7,lsrow]:=grid1.Cells[7,lsrow]+copy('  ',1,(length(grid1.Cells[7,lsrow]) mod 2));
       end;
    if q1.fieldbyname('leij').asfloat=0  then
       grid1.cells[8,lsrow]:=''
    else
       begin
       grid1.cells[8,lsrow]:=floattostr(q1.fieldbyname('leij').asfloat);
       grid1.Cells[8,lsrow]:=grid1.Cells[8,lsrow]+copy('  ',1,(length(grid1.Cells[8,lsrow]) mod 2));
       end;
  end
end;

procedure formini;
var
  lscode:string;
  i,groupnum:integer;
  aa:array [0..1] of string;
begin
with rbform do
begin
  q1.Active :=false;
  q1.sql.clear;
  q1.sql.add('select code from lsrb where lsdate=:prq');
  q1.ParamByName ('prq').asstring:=trim(lsdate);
  q1.Prepare;
  q1.open;
  q1.Active :=true;
  grid1.RowCount:=q1.RecordCount+1 ;
  q1.Active :=false;
  i:=1;
  lsrow:=1;
  while i<=4 do
     begin
     q1.Active :=false;
     q1.sql.Clear ;
     q1.sql.add('select * from lsrb where (lsgroup=:plsgroup and lsdate=:pdate)');
     q1.ParamByName ('plsgroup').asstring:=inttostr(i);
     q1.ParamByName ('pdate').asstring:=trim(lsdate);
     q1.Prepare;
     q1.open;
     q1.active:=true;
     while not q1.EOF do
        begin
        lscode:=q1.FieldByName('code').asstring;
        if q1.FieldByName('master').asboolean then
           begin
           if i=1 then
              grid1.Cells [0,lsrow]:='餐饮';
           if i=2 then
              grid1.Cells [0,lsrow]:='客房';
           if i=3 then
              grid1.Cells [0,lsrow]:='桑拿';
           if i=4 then
              grid1.Cells [0,lsrow]:='商品部';
           end
        else
           begin
           if lscode='rmcode' then
              grid1.Cells [0,lsrow]:='  包间';
           if lscode='cscode' then
              grid1.Cells [0,lsrow]:='  超时';
           if lscode='sacode' then
              grid1.Cells [0,lsrow]:='  散座';
           if ((lscode<>'rmcode') and (lscode<>'cscode') and (lscode<>'sacode')) then
              begin
              aa[0]:='';
              getvalue(aa,'select cusname from custype where custype="'+trim(lscode)+'"');
              if length(trim(aa[0]))=0 then
                 getvalue(aa,'select cusname from cusitem where cuscode="'+trim(lscode)+'"');
              grid1.Cells [0,lsrow]:='  '+aa[0];
              end;
           end;
        datatogrid;
        q1.next;
        lsrow:=lsrow+1;
        end;
     i:=i+1;
     end;
   q1.Active :=false;
   q1.sql.Clear ;
   q1.sql.add('select * from lsrb where ((code=:pcode1 or code=:pcode2) and lsdate=:pdt)');
   q1.ParamByName ('pcode1').asstring:='xjcode';
   q1.ParamByName ('pcode2').asstring:='ljcode';
   q1.parambyname ('pdt').asstring:=lsdate;
   q1.Prepare;
   q1.open;
   q1.active:=true;
   while not q1.eof do
      begin
      if q1.FieldByName ('code').asstring='xjcode' then
         grid1.cells [0,lsrow]:='小计';
      if q1.FieldByName ('code').asstring='ljcode' then
         grid1.cells [0,lsrow]:='累计';
      datatogrid;
      q1.next;
      lsrow:=lsrow+1;
      end;
   q1.Active :=false;
end;
end;




procedure Trbform.FormCreate(Sender: TObject);
begin
  shortdateformat:='yyyy-mm-dd';
  lsdate:=datetostr(date());
  grid1.cells [1,0]:='现金';
  grid1.cells [2,0]:='支票';
  grid1.cells [3,0]:='信用卡';
  grid1.cells [4,0]:='挂帐';
  grid1.cells [5,0]:='免单';
  grid1.cells [6,0]:='其他';
  grid1.cells [7,0]:='小计';
  grid1.cells [8,0]:='累计';
  formini;
end;

procedure Trbform.Button2Click(Sender: TObject);
begin
   rbform.close;
end;

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

procedure prn;
var
  myfile:textfile;
  s,spac:string;
  i:integer;
begin
  with rbform do
   begin
   assignprn(myfile);
   rewrite(myfile);
   i:=1;
   spac:='            ';
   printer.Canvas.Font.name:=rbform.Font.name;
   printer.Canvas.Font.size:=18;
   writeln(myfile,'                  海霸王大厦营业收入日报表');
   s:='┠──────┼─────┼─────┼─────┼─────┼─────┼─────┼─────┼─────┨';
   printer.Canvas.Font.size:=13;
   writeln(myfile,'                                                              '+datetostr(date));
   printer.Canvas.Font.size:=9;
   writeln(myfile,'┏━━━━━━┯━━━━━┯━━━━━┯━━━━━┯━━━━━┯━━━━━┯━━━━━┯━━━━━┯━━━━━┓');
   writeln(myfile,'┃      │ 现 金 │ 支 票 │ 信用卡 │ 挂 帐 │ 免 单 │ 其 它 │ 小 计 │ 累 计 ┃');
   while i<=grid1.RowCount-1 do
      begin
      writeln(myfile,s);
      writeln(myfile,'┃'+copy((grid1.cells[0,i])+spac,1,12)+'│'+copy((grid1.cells[1,i])+spac,1,10)+'│'+copy((grid1.cells[2,i])+spac,1,10)+'│'+copy((grid1.cells[3,i])+spac,1,10)+'│'+copy((grid1.cells[4,i])+spac,1,10)+'│'+copy((grid1.cells[5,i])+spac,1,10)+'│'+copy((grid1.cells[6,i])+spac,1,10)+'│'+copy((grid1.cells[7,i])+spac,1,10)+'│'+copy((grid1.cells[8,i])+spac,1,10)+'┃');
      i:=i+1;
      end;
   writeln(myfile,'┗━━━━━━┷━━━━━┷━━━━━┷━━━━━┷━━━━━┷━━━━━┷━━━━━┷━━━━━┷━━━━━┛');
   writeln(myfile,'                                                                                           制表人:'+curper.name);
   system.CloseFile (myfile);
   end;
end;

procedure Trbform.Button1Click(Sender: TObject);
begin
   prn;
end;

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

end.

⌨️ 快捷键说明

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