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 + -
显示快捷键?