📄 u_web_userm.pas
字号:
unit U_WEB_USERM;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Grids, StdCtrls, teForm, AdvGrid, ImgList, Hints,
TFlatButtonUnit, BaseGrid;
type
TF_WEB_USERM = class(TForm)
PN_STAT: TPanel;
SG_JL: TAdvStringGrid;
BN_FH: TFlatButton;
BN_SER: TFlatButton;
IMG_GST: TImageList;
BN_ACCEPT: TFlatButton;
Timer1: TTimer;
IMG_DIF: TImageList;
LB_HINT: TLabel;
function savetodb(sender: TObject): boolean;
procedure calcol;
procedure fresh_rm;
procedure paste_bmp;
procedure check_paying_room(m_flag: integer = 0);
procedure SetFlag(hint_flag: integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BN_FHClick(Sender: TObject);
procedure SG_JLDblClick(Sender: TObject);
procedure SG_JLGetCellColor(Sender: TObject; ARow, ACol: Integer;
AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
procedure SG_JLGridHint(Sender: TObject; ARow, ACol: Integer;
var hintstr: string);
procedure SG_JLRightClickCell(Sender: TObject; ARow, ACol: Integer);
procedure display_0;
procedure display_1;
procedure display_2;
procedure display_3;
procedure display_4;
procedure display_6;
procedure display_7;
procedure display_8;
procedure display_9;
procedure display_10;
procedure display_11;
procedure display_13;
procedure display_14;
procedure display_15;
procedure display_16;
procedure display_17;
procedure display_21;
procedure display_22;
procedure display_23;
procedure display_24;
procedure display_25;
procedure display_26;
procedure display_27;
procedure display_28;
procedure display_29;
procedure display_30;
procedure display_31;
procedure display_32;
procedure display_33;
procedure display_34;
procedure display_35;
procedure display_36;
procedure display_37;
procedure display_szw_hskpmsg;
procedure check_chg_blkrm;
procedure SG_JLGetAlignment(Sender: TObject; ARow, ACol: Integer;
var HAlign: TAlignment; var VAlign: TVAlignment);
procedure BN_SERClick(Sender: TObject);
procedure SG_JLClickCell(Sender: TObject; ARow, ACol: Integer);
procedure BN_ACCEPTClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure SG_JLCanSort(Sender: TObject; ACol: Integer;
var DoSort: Boolean);
procedure SG_JLClickSort(Sender: TObject; ACol: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
F_WEB_USERM: TF_WEB_USERM;
implementation
uses
pub_program, u_reca_dm, teblend, U_RECA_DM_WY2, u_dm_audi,
U_RECA_EXECPLAN, U_RECA_NO, U_RECA_DM_WY, U_RECA_KSXX, ncp,
U_RECA_DM_WY3, U_RECA_AGENCY, U_RECA_CONT, U_RECA_DYDTYPE;
var
m_diff, arow, m_col: integer;
m_str, m_adate, m_ddate: string;
days: array[1..7] of string;
gridop: TGridOptions;
m_bcolor: boolean;
ttype_list: TStringList;
{$R *.DFM}
{procedure TF_RECA_USERM.calcol;
var
i, j: integer;
rate: double;
begin
if check_sg(sg_jl) then
with sg_jl do
begin
str_grid_wy(sg_jl, arow);
for i := 0 to colcount - 1 do
if pos('.', trim(cells[i, 0])) = 1 then
begin
rate := 0;
for j := 1 to rowcount - 2 do
rate := rate + strtocurr(getstr(cells[i, j]));
if (arow > 1) then
if (pos('.', cells[i, arow - 1]) > 0) then
cells[i, arow] := currtostrf(rate, fffixed, gint_dec)
else
cells[i, arow] := currtostrf(rate, fffixed, 0);
end
else
if pos('_', trim(cells[i, 0])) = 1 then
begin
rate := 0;
for j := 1 to rowcount - 2 do
rate := rate + strtocurr(getstr(cells[i, j]));
if (arow > 1) then
if (pos('.', cells[i, arow - 1]) > 0) then
cells[i, arow] := currtostrf(rate / (rowcount - 2), fffixed, gint_dec)
else
cells[i, arow] := currtostrf(rate / (rowcount - 2), fffixed, 0);
end
else
if pos('~', trim(cells[i, 0])) = 1 then
begin
if (arow > 1) then
cells[i, arow] := inttostr(rowcount - 2);
end;
cells[0, arow] := ' 合计';
fixedfooters := 1;
end;
end;
}
function TF_WEB_USERM.savetodb(sender: TObject): boolean;
var
i: integer;
begin
try //此过程只将所有STRING-GRID 中的数据存入数据库。
f_reca_dm.hoteldb.Connected := true;
f_reca_dm.hoteldb.StartTransaction;
with f_reca_dm_wy2.sp_chgblkrm_wangy do
begin
close;
parambyname('@vrsvnno_a').asstring := analy_str('rsvnno', m_str);
parambyname('@vrecno_a').asinteger := strtoint(getstr(analy_str('recno', m_str)));
parambyname('@vroom_a').asstring := analy_str('room', m_str);
parambyname('@vrsvnno_b').asstring := analy_str('rsvnno', bn_accept.Hint);
parambyname('@vrecno_b').asinteger := strtoint(getstr(analy_str('recno', bn_accept.Hint)));
parambyname('@vroom_b').asstring := analy_str('room', bn_accept.Hint);
parambyname('@vopno').asstring := gstr_czygh;
prepare;
execproc;
i := parambyname('@vresult').asinteger;
close;
end;
f_reca_dm.hoteldb.Commit;
f_reca_dm.hoteldb.Connected := false;
result := true;
case i of
0:
if sender = BN_ACCEPT then
MessageDlg(succ_msg, mtinformation, [mbok], 0);
1: MessageDlg(analy_str('rsvnno', m_str) + ' - ' + analy_str('room', m_str) + iif(m_lang = 1, ' 号排房已不存在, 不能对调!', ' ALREADY DOES EXISTS NOW, CAN NOT EXCHANGE!'), mtinformation, [mbok], 0);
2: MessageDlg(analy_str('rsvnno', bn_accept.Hint) + ' - ' + analy_str('room', bn_accept.Hint) + iif(m_lang = 1, ' 号排房已不存在, 不能对调!', ' ALREADY DOES EXISTS NOW, CAN NOT EXCHANGE!'), mtinformation, [mbok], 0);
end;
except
f_reca_dm.hoteldb.Rollback;
f_reca_dm.hoteldb.Connected := false;
MessageDlg(err_msg, mtWarning, [mbok], 0);
result := false;
end;
end;
procedure TF_WEB_USERM.check_paying_room(m_flag: integer = 0);
var
s: string;
begin
s := '';
with f_reca_dm.qy_wangy do
begin
close;
sql.Clear;
sql.Add('select room from askchk where isnull(status,0)=0 order by room');
prepare;
open;
while not eof do
begin
s := s + ', ' + fieldbyname('room').asstring;
next;
end;
close;
end;
if length(s) > 0 then
begin
pn_stat.caption := iif(m_lang = 1, ' 新待查房号：', ' NEW CHK ROOM: ') + copy(s, 3, 100);
if m_flag = 0 then
bn_accept.Visible := true;
end
else
begin
bn_accept.Visible := false;
if m_flag = 1 then
pn_stat.caption := ''
else
pn_stat.caption := iif(m_lang = 1, ' **双击表格中记录设置查房房态**', ' **DOUBLE CLICK TO SET CHECK ROOM STATUS**');
end;
end;
procedure TF_WEB_USERM.display_szw_hskpmsg;
var
i: integer;
s: string; //
begin
case m_lang of
1: s := '查房*8*回复内容*24*结帐*6*结帐时间*15*报房*6*报房时间*15*房号*6*房态*5*住客姓名*20*入住时间*15*折扣类型*10*折扣*6*批准人*12*协议名称*30*备 注*26*';
2: s := 'DB CHK*8*REPLY*24*PAID OPNO*6*PAID TIME*15*HS OPNO*6*HS TIME*15*ROOM*6*RST*5*GET NAME*20*ARR TIME*15*DISC TYPE*10*DISC*6*APPROV*12*CORP.NAME*30*REMARK*26*';
end;
title_sg_wy(sg_jl, s, false);
bold_sg(sg_jl);
caption := iif(m_lang = 1, ' 电脑报房 ** 查房时间：', ' AUTO CHK RM **CHK RM DATE: ') + datetostr(now, 1) + ' **';
with sg_jl do
with f_reca_dm.qy_wangy do
begin
fixedcols := 0;
close;
sql.Clear;
s := 'select status,c.remark,c.jzopno,c.date,bopno,bdate,a.room,b.rst,a.name,a.adate,a.dtype,a.disc,a.dname,aa=no+'' - ''+c_name,a.remark,bflsh,status ';
case m_diff of
18: s := s + 'from roomno_2 a,roomno b,askchk c where a.room=b.room and a.room=c.room and c.status > 0 order by status,a.room';
38: s := s + 'from roomno_2 a,roomno b,askchk c where a.room=b.room and a.room=c.room and c.status > 0 order by status desc,a.room';
end;
sql.Add(s);
open;
while not eof do
begin
str_grid_wy(sg_jl, arow);
for i := 0 to ColCount - 1 do
case i of
0:
case fields.fields[i].asinteger of
1: cells[i, arow] := iif(m_lang = 1, '接收', 'ACCEPT');
2: cells[i, arow] := iif(m_lang = 1, 'OK房', 'OK');
3: cells[i, arow] := iif(m_lang = 1, '问题房', 'PROBLEM');
end;
3, 5, 9: cells[i, arow] := datetostr(fields.fields[i].asdatetime, 1);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -