zftyfp.pas

来自「北京铁路局住房分配系统,数据库为MSSql2000,依次执行crebas4.sq」· PAS 代码 · 共 557 行 · 第 1/2 页

unit ZFTYFP;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, CELLLib_TLB, ExtCtrls, StdCtrls,StrUtils, ComCtrls,
  Menus;

type
  TFormTXFP = class(TForm)
    Panel1: TPanel;
    Panel3: TPanel;
    Cell1: TCell;
    Button3: TButton;
    Button4: TButton;
    Panel4: TPanel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Label1: TLabel;
    ColorBox1: TColorBox;
    Label2: TLabel;
    Label3: TLabel;
    CheckBox1: TCheckBox;
    Button1: TButton;
    StatusBar1: TStatusBar;
    Label4: TLabel;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    Label5: TLabel;
    procedure Button4Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Cell1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ColorBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    MC,MR,flag: smallint;
    Colr:TColor;

  public
    { Public declarations }
  end;

var
  FormTXFP: TFormTXFP;


implementation

uses datamodl,publicfun;

{$R *.dfm}

procedure TFormTXFP.Button4Click(Sender: TObject);
begin
  close;
end;

procedure TFormTXFP.FormActivate(Sender: TObject);
begin
  flag:=0;
  combobox1.Items.Clear;
  combobox2.Items.Clear;
  with datamodule1 do
  begin
    if ADOQry.Active= true then ADOQry.close;
    ADOQry.sql.Clear;
    ADOQry.sql.Add('select lybh,mc from lyxxb');
    ADOQry.open;
    ADOQry.first;
    while not ADOQry.Eof  do
    begin
      combobox1.Items.Add(ADOQry.fieldbyname('lybh').AsString+' | '
                         +ADOQry.fieldbyname('mc').AsString);
      ADOQry.Next;
    end;
    ADOQry.Close;

    ADOQry.sql.Clear;
    ADOQry.sql.Add('select dwbh,dwmc from dwxxb');
    ADOQry.open;
    ADOQry.first;
    while not ADOQry.Eof  do
    begin
      combobox2.Items.Add(ADOQry.fieldbyname('dwbh').AsString+' | '
                         +ADOQry.fieldbyname('dwmc').AsString);
      ADOQry.Next;
    end;
    combobox2.Items.Add(' ');
    ADOQry.Close;

    ADOQry.sql.Clear;
    ADOQry.sql.Add('select bh,mc from fwytb where bh <> ''99''');
    ADOQry.open;
    ADOQry.first;
    while not ADOQry.Eof  do
    begin
      combobox3.Items.Add(ADOQry.fieldbyname('bh').AsString+' | '
                         +ADOQry.fieldbyname('mc').AsString);
      ADOQry.Next;
    end;
    combobox3.Items.Add(' ');
    ADOQry.Close;
  end;
end;

procedure TFormTXFP.ComboBox1Change(Sender: TObject);
var
  c,r,CC,Co,RR:smallint;              //c-房间号 r-楼层 CC-列 Co-列变量
  zfbh,dwbh,dwmc,hxmc,ytbh,ytmc:widestring;
  col:TColor;
 // nret1,nret2:smallint;
  lybh,hxmc1,cxmc1:string;
begin
  // cell1.DoSetCellstring(0,0,'001051703'+#13+'铁路分局'+#13+'一居室');
  // cell1.DoSetCellTextStyle(0,0,1);
  // cell1.DoRedrawAll;
  //MC:=18; MR:=39;
  c:=0;
  CC:=0;
  Co:=0;
  RR:=0;
  for c:=1 to Mc do
    for r:=4 to Mr do
      begin
        cell1.DoSetCellReadOnly(c,r,false);
        cell1.DoClearCell(c,r,1);
        cell1.DoSetCellColor(c,r,rgb(0,0,0),rgb(255,255,255));
        cell1.DoSetCellReadOnly(c,r,true);
      end;
  cell1.DoRedrawAll;
  if trim(combobox1.Text)<>'' then
     lybh:= copy(trim(combobox1.Text),1,5)
  else
     exit;
  for c:=1 to 24 do
    begin
      if c < 10 then
        begin
          HXTest(lybh,'0'+inttostr(c),hxmc1);
          CXTest(lybh,'0'+inttostr(c),Cxmc1);
          cell1.DoSetCellString(c,4,trim(hxmc1));
          cell1.DoSetCellString(c,3,trim(cxmc1));
        end
      else
        begin
          HXTest(lybh,inttostr(c),hxmc1);
          CXTest(lybh,inttostr(c),Cxmc1);
          cell1.DoSetCellString(c,4,trim(hxmc1));
          cell1.DoSetCellString(c,3,trim(cxmc1));
        end;
    end;
  if trim(combobox1.Text)<>'' then
    with datamodule1 do
    begin
      if ADOQry.Active= true then ADOQry.close;
      ADOQry.sql.Clear;
      ADOQry.sql.Add('select r=substring(zfbh,7,2),dyh=substring(zfbh,6,1),c=substring(zfbh,9,2),zfbh=substring(zfbh,6,5),a.dwbh,dwmc= b.dwmc,b.Col,hxbh,hxmc=c.mc,ytbh,ytmc=d.mc,kffp '+#10+
                     'from zfxxb a,dwxxb b,fwhxb c,fwytb d '+#10+
                     'where a.dwbh= b.dwbh and a.hxbh*=c.bh and a.ytbh*=d.bh and lybh=:lybh '+#10+
                     'union all '+#10+
                     'select r=substring(zfbh,7,2),dyh=substring(zfbh,6,1),c=substring(zfbh,9,2),zfbh=substring(zfbh,6,5),dwbh=isnull(a.dwbh,''''),'+
                     'dwmc=(case when a.dwbh is null then '''' end),Col=(case when a.dwbh is null then '''' end),a.hxbh,hxmc=c.mc,ytbh,ytmc=d.mc,kffp '+#10+
                     'from zfxxb a,fwhxb c,fwytb d '+#10+
                     'where a.hxbh*=c.bh and a.ytbh*=d.bh and a.dwbh is null and lybh=:ly '+#10+
                     'order by r,dyh,c');
      ADOQry.Parameters.ParamByName('lybh').Value:=copy(combobox1.Text,1,5);
      ADOQry.Parameters.ParamByName('ly').Value:=copy(combobox1.Text,1,5);
      ADOQry.open;
      ADOQry.First;
      while not AdoQry.Eof do
      begin
        if RR <> strtoint(AdoQry.Fields.fieldbyname('r').asstring) then
        begin
          RR := strtoint(AdoQry.Fields.fieldbyname('r').asstring);
          CC:=0;
          Co:=0;
          c :=0;
        end;
        if CC <> AdoQry.Fields.fieldbyname('dyh').AsInteger then
        begin
          CC:= AdoQry.Fields.fieldbyname('dyh').AsInteger;
          Co:= Co+c;
        end;
        r:=strtoint(AdoQry.Fields.fieldbyname('r').asstring);
        c:=strtoint(AdoQry.Fields.fieldbyname('c').AsString);
        zfbh:=trim(AdoQry.Fields.fieldbyname('zfbh').AsString);
        dwbh:=trim(AdoQry.Fields.fieldbyname('dwbh').AsString);
        dwmc:=trim(AdoQry.Fields.fieldbyname('dwmc').AsString);
        if trim(AdoQry.Fields.fieldbyname('Col').AsString)<>'' then
          Col:=stringtocolor(trim(AdoQry.Fields.fieldbyname('Col').AsString))
        else
          Col:= clwhite;
        hxmc:=trim(AdoQry.Fields.fieldbyname('hxmc').AsString);
        ytbh:=trim(AdoQry.Fields.fieldbyname('ytbh').AsString);
        ytmc:=trim(AdoQry.Fields.fieldbyname('ytmc').AsString);

        //c:=Co+c;
        if trim(dwbh)='' then dwbh:='   ';
        cell1.DoSetCellString(Co+c,r+5,'a:'+zfbh+#13+'b:'+dwbh+dwmc+#13+'c:'+hxmc+#13+'d:'+ytbh+ytmc);
        if AdoQry.Fields.fieldbyname('kffp').AsInteger= 1 then
          cell1.DoSetCellColor(Co+c,r+5,rgb(0,0,0),Col)
        else
          cell1.DoSetCellColor(Co+c,r+5,rgb(250,0,0),ClWhite);

        adoqry.Next;
      end;
      ADOQry.Close;
    end;
    cell1.DoRedrawAll;
    colorbox1.ItemIndex:=-1;
end;

procedure TFormTXFP.Cell1Click(Sender: TObject);
var
  cl,rw :smallint;
  dwbh,dw,ytbh,yt,zfbh:string;
  i,a,b,c,d:smallint;
  S,msg:string;
  nret:smallint;
begin
 { if trim(combobox2.Text)='' then
    begin
      showmessage('请选择分配单位！');
      exit;
    end; }
  if flag=0 then
    begin
      Colr:=clWhite;
      //showmessage('尚未指定单元格颜色，请指定！');
      //exit;
    end;
  a:=0;b:=0;c:=0;d:=0;
  cl:= cell1.DoGetCurrentCol;
  rw:= cell1.DoGetCurrentRow;
  if trim(combobox2.Text)='' then
    begin
      dwbh:='';
      dw:='   ';
    end
  else
    begin
     dwbh:= copy(combobox2.Text,1,3);
     dw:= copy(combobox2.Text,1,3)+copy(combobox2.Text,7,length(combobox2.Text)-6);
    end;
  if trim(combobox3.Text)='' then
    begin
      ytbh:='';
      yt:='  ';
    end
  else
    begin
     ytbh:= copy(combobox3.Text,1,2);
     yt:= copy(combobox3.Text,1,2)+copy(combobox3.Text,6,length(combobox3.Text)-5);
    end;

  S:=cell1.DoGetPageCellString(cl,rw,0);
  for i:=0 to length(S) do
  begin
    if copy(s,i,2)='a:' then
      a:=i;
    if copy(s,i,2)='b:' then
      b:=i;
    if copy(s,i,2)='c:' then
      c:=i;
    if copy(s,i,2)='d:' then
      d:=i;
  end;
  if (b=0) or (c=0) then exit;
  zfbh:=copy(trim(combobox1.Text),1,5)+ copy(S,a+2,5);

  IF copy(combobox4.Text,1,1)='0' then
  begin