zftyfp.pas
来自「北京铁路局住房分配系统,数据库为MSSql2000,依次执行crebas4.sq」· PAS 代码 · 共 557 行 · 第 1/2 页
PAS
557 行
if (trim(copy(S,b+2,3))='') and (dwbh='') then exit;
if (copy(S,b+2,3) <> dwbh) and (copy(_userpurview,7,1) <>'0') then
begin
if (copy(S,b+2,3) <> dwbh) and (trim(copy(S,b+2,3)) <> '') and (dwbh<>'') then
begin
if Application.MessageBox('是否要更改分配单位?','提示信息',MB_YESNO+MB_DEFBUTTON2+MB_ICONQUESTION+MB_APPLMODAL)=IDNO then
exit;
end;
nret:= ZfxxUp(zfbh,dwbh,msg);
case nret of //1-单位置空 2-分配未超规定 3-相等 4-超出
1: begin
S:= StuffString(S,b+2,c-b-3,dw);
cell1.DoSetCellColor(cl,rw,rgb(0,0,0),Colr);
cell1.DoSetCellString(cl,rw,S);
cell1.DoRedrawAll;
statusBar1.Panels.Items[1].Text:='';
end;
2: begin //showmessage(dw+' '+msg); // 5-住房号不存在 8-户型不确定 9-更新出错
S:= StuffString(S,b+2,c-b-3,dw);
cell1.DoSetCellColor(cl,rw,rgb(0,0,0),Colr);
cell1.DoSetCellString(cl,rw,S);
cell1.DoRedrawAll;
statusBar1.Panels.Items[1].Text:= dw+' '+msg;
end;
3,4: statusBar1.Panels.Items[1].Text:=dw+' '+msg; // showmessage(dw+' '+msg);
5: begin
showmessage('住房编号不存在,请检查住房信息!');
exit;
end;
7: begin
showmessage('住房设置为不可分,请修改住房信息!');
exit;
end;
8: begin
showmessage('住房户型不明确,请检查住房信息!');
exit;
end;
9: begin
showmessage('更新出错!');
exit;
end;
end;
button3.Enabled:=true;
end
else
if copy(_userpurview,7,1) = '0' then
begin
showmessage('对不起,您没有修改的权限');
exit;
end;
end
else
IF copy(combobox4.Text,1,1)='1' then
begin
if (b=0) or (c=0) or (d=0) then exit;
if trim(copy(S,b+2,3))='' then exit;
dwbh:= trim(copy(S,b+2,3));
if (trim(copy(S,d+2,2))='') and (ytbh='') then exit;
if (copy(S,d+2,2) <> ytbh) and (copy(_userpurview,7,1) <>'0') then
begin
if (copy(S,d+2,2)<>ytbh) and (trim(copy(S,d+2,2))<>'') and (ytbh<>'') then
begin
if Application.MessageBox('是否要更改分配用途?','提示信息',MB_YESNO+MB_DEFBUTTON2+MB_ICONQUESTION+MB_APPLMODAL)=IDNO then
exit;
end;
nret:= ZfxxUp1(zfbh,dwbh,ytbh,msg);
case nret of //1-单位置空 2-分配未超规定 3-相等 4-超出
1: begin
if length(S)=d+1 then
S:=S+yt
else
S:= StuffString(S,d+2,length(s)-d-2,yt);
//cell1.DoSetCellColor(cl,rw,rgb(0,0,0),Colr);
cell1.DoSetCellString(cl,rw,S);
cell1.DoRedrawAll;
statusBar1.Panels.Items[1].Text:='';
end;
2: begin //showmessage(dw+' '+msg); // 5-住房号不存在 8-户型不确定 9-更新出错
if length(S)=d+1 then
S:=S+yt
else
S:= StuffString(S,d+2,length(s)-d-2,yt);
//cell1.DoSetCellColor(cl,rw,rgb(0,0,0),Colr);
cell1.DoSetCellString(cl,rw,S);
cell1.DoRedrawAll;
statusBar1.Panels.Items[1].Text:= dw+' '+yt+' '+msg;
end;
3,4: statusBar1.Panels.Items[1].Text:= dw+' '+yt+' '+msg; // showmessage(dw+' '+msg);
5: begin
showmessage('住房编号不存在,请检查住房信息!');
exit;
end;
7: begin
showmessage('住房设置为不可分,请修改住房信息!');
exit;
end;
8: begin
showmessage('住房户型不明确,请检查住房信息!');
exit;
end;
9: begin
showmessage('单位编号为空!');
exit;
end;
end;
button3.Enabled:=true;
end
else
if copy(_userpurview,7,1) = '0' then
begin
showmessage('对不起,您没有修改的权限!');
exit;
end;
end
else
if copy(combobox4.Text,1,1)='2' then
begin
nret:= ZfxxSet(zfbh,msg);
if nret= 0 then
begin
cell1.DoSetCellColor(Cl,rw,rgb(250,0,0),ClWhite);
statusBar1.Panels.Items[1].Text:= msg;
cell1.DoRedrawAll;
end
else
begin
showmessage('设置失败!');
statusBar1.Panels.Items[1].Text:= msg;
exit;
end;
end;
end;
procedure TFormTXFP.Button3Click(Sender: TObject);
var
dwbh,dw:string;
c:smallint;
CompA,CompB,nhx:smallint;
begin
for c:=1 to combobox2.Items.Count do
begin
dwbh:= copy(combobox2.Items.Strings[c-1],1,3);
dw:=combobox2.Items.Strings[c-1];
ZFTest(compA,CompB,nhx,dwbh);
case nhx of
1:showmessage(dw+' 一居室数量 <'+inttostr(CompB)+'> 超出了数量分配表一居规定数量 <'+inttostr(compA)+'> 请重新设置!');
2:showmessage(dw+' 二居室数量 <'+inttostr(CompB)+'> 超出了数量分配表二居规定数量 <'+inttostr(compA)+'> 请重新设置!');
3:showmessage(dw+' 三居室数量 <'+inttostr(CompB)+'> 超出了数量分配表三居规定数量 <'+inttostr(compA)+'> 请重新设置!');
4:showmessage(dw+' 复式二居数量 <'+inttostr(CompB)+'> 超出了数量分配表复式二居规定数量 <'+inttostr(compA)+'> 请重新设置!');
5:showmessage(dw+' 复式三居数量 <'+inttostr(CompB)+'> 超出了数量分配表复式三居规定数量 <'+inttostr(compA)+'> 请重新设置!');
6:showmessage(dw+' 其他数量 <'+inttostr(CompB)+'> 超出了数量分配表其它类型规定数量 <'+inttostr(compA)+'> 请重新设置!');
end;
end;
button3.Enabled:=false;
end;
procedure TFormTXFP.CheckBox1Click(Sender: TObject);
begin
if checkbox1.Checked= true then
begin
if copy(_userpurview,8,1)='0' then
begin
showmessage('对不起,您没有修改的权限!');
exit;
end;
colorbox1.Enabled:= true;
flag:=0;
end;
end;
procedure TFormTXFP.ComboBox2Change(Sender: TObject);
var
dwbh:string;
begin
dwbh:= copy(trim(combobox2.Text),1,3);
with datamodule1 do
begin
if ADOQry.Active= true then ADOQry.close;
ADOQry.sql.Clear;
ADOQry.sql.Add('select Col from dwxxb where dwbh=:dwbh');
ADOQry.Parameters.ParamByName('dwbh').Value:=dwbh;
ADOQry.open;
if trim(ADOQry.FieldByName('Col').AsString) <>'' then
begin
Colr:= stringtocolor(trim(ADOQry.FieldByName('Col').AsString));
colorbox1.ItemIndex:= colorbox1.Items.IndexOf(trim(ADOQry.FieldByName('Col').AsString));
if colorbox1.ItemIndex<> -1 then flag:= 1;
colorbox1.Enabled:=false;
checkbox1.Checked:= false;
end
else
begin
flag:=0;
showmessage('此单位尚未绑定单元格颜色,请指定!');
colorbox1.Enabled:= true;
colorbox1.ItemIndex:= -1;
colorbox1.SetFocus;
exit;
end;
ADOQry.Close;
end;
end;
procedure TFormTXFP.ColorBox1Change(Sender: TObject);
var
dwbh:string;
begin
if flag=0 then
begin
dwbh:= copy(trim(combobox2.Text),1,3);
with datamodule1 do
begin
if ADOQry.Active= true then ADOQry.close;
ADOQry.sql.Clear;
ADOQry.sql.Add('update dwxxb set Col= :Col where dwbh=:dwbh');
ADOQry.Parameters.ParamByName('Col').Value:=colortostring(colorbox1.Selected);
ADOQry.Parameters.ParamByName('dwbh').Value:=dwbh;
if ADOQry.ExecSQL <> 1 then
begin
showmessage('请重新选择!');
exit;
end
else
begin
ADOQry.Close;
flag:= 1;
checkbox1.Checked:=false;
colorbox1.Enabled:=false;
Colr:= colorbox1.Selected;
end;
end;
end;
end;
procedure TFormTXFP.Button1Click(Sender: TObject);
var
opendlg:TOpendialog;
Sfilename:string;
i,j:smallint;
begin
opendlg:=TOpendialog.create(Application);
opendlg.DefaultExt:='CLL';
opendlg.filter:='报表格式文件(*.CLL)|*.CLL';
if opendlg.execute then
begin
Sfilename :=opendlg.filename;
if not comp(sfilename,'高层住宅楼分配方案图') then
begin
showmessage('请打开指定名称结构文件!');
exit;
end;
if cell1.DoOpenFile(Sfilename)>0 then
begin
cell1.DoRedrawAll ;
for i:=0 to MC do
for j:=0 to MR do
cell1.DoSetCellReadOnly(i,j,true);
cell1.DoSetUnScrollRow(0,5);
cell1.DoSetUnScrollCol(0,0);
end;
combobox1.Enabled:=true;
combobox2.Enabled:=true;
button3.Enabled:=true;
end;
opendlg.free;
end;
procedure TFormTXFP.FormCreate(Sender: TObject);
begin
cell1.DoLogin('北京金天鹏软件科技有限公司',363,'00FD18FF080193035CFE09FF9908');
MC:=24; MR:=43;
combobox1.Enabled:=false;
combobox2.Enabled:=false;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?