📄 rb.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 + -