unit1.pas

铁路道口管理系统 开发源码 大家随便看看 呵呵

  SSTab1.Left := 0;
  SSTab1.Top := 0;
  edit2.Text := '0';
  edit3.Text := '0';
  showmessage(inttostr(SSTab1.Width) + '/' + inttostr(SSTab1.Height) + '/' +inttostr(JPGHigh)+'/'+inttostr(JPGWidth));
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
 // showmessage(inttostr(speedbutton3.left)+' | '+inttostr(speedbutton3.Top));
  //向上移动
  Timer1.Enabled := false;
  BeforLeft:= SSTab1.Left; BeforTop := SSTab1.Top;
  SpeedButton3.Enabled := True;
  if SSTab1.Top - MoveStep > -JPGHigh then
      SSTab1.Top := SSTab1.Top - MoveStep
    else
    begin
      SSTab1.Top := -JPGHigh;
      SpeedButton4.Enabled := false;
    end;
    FinalLeave := BeforTop-SSTab1.Top;
    edit3.Text := inttostr(SSTab1.Top);
    MoveOther('U');
  //  showmessage(inttostr(speedbutton3.left)+' | '+inttostr(speedbutton3.Top));
    Timer1.Enabled := true;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin

 // showmessage(inttostr(sstab1.Picture.Graphic.Height)+' | '+inttostr(sstab1.Picture.Graphic.Width));
  //向右移动
  Timer1.Enabled := false;
  BeforLeft:= SSTab1.Left; BeforTop := SSTab1.Top;
    SpeedButton2.Enabled := True;
    if SSTab1.Left + MoveStep < 0 then
      SSTab1.Left := SSTab1.Left + MoveStep
    else
    begin
      SSTab1.Left := 0;
      SpeedButton1.Enabled := false;
    end;
    FinalLeave := SSTab1.Left - beforleft ;
    edit2.Text := inttostr(SSTab1.left);
    MoveOther('R');
    Timer1.Enabled := true;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  //向下移动
  Timer1.Enabled := false;
  BeforLeft:= SSTab1.Left; BeforTop := SSTab1.Top;
  SpeedButton4.Enabled := True;
  if SSTab1.Top + MoveStep < 0 then
      SSTab1.Top := SSTab1.Top + MoveStep
    else
    begin
      SSTab1.Top := 0;
      SpeedButton3.Enabled := false;
    end;
    FinalLeave := SSTab1.Top - BeforTop;
    edit3.Text := inttostr(SSTab1.Top);
    MoveOther('D');
    Timer1.Enabled := true;
end;

procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
 // if Application.MessageBox('确认退出本系统吗？','提示',MB_YESNO) <> 6 then
  //    exit;
  Form5.DKMoveBegin := false;
  Form5.IfkeyDown := false;
  Timer1.Enabled := false;
  //Application.Terminate;
  Form1.Close;
  Form5.Show;

end;
//刷新道口控件功能 即界面初始化
procedure TForm1.RefrashThis;
var
  MainLeftleave, MainTopLeave : integer;
  i : integer;
  BitCDS : TBitBtn;
  Mylist : TstringList;
  OneShape  : Tshape;
  FX : string;
begin
  try
    MainLeftleave := 0 - SSTab1.Left  ;
    MainTopLeave := 0 - SSTab1.Top;

    //删除原来的BitBtn
    for i := 0 to SSTab1.ControlCount -1 do
    begin
      if SSTab1.Controls[i].ClassType = TBitBtn then
      begin
        TBitBtn(SSTab1.Controls[i]).Free;
      end;
    end;
   // 删除原来的闪烁脚标(shape)
    for i := 0 to SSTab1.ControlCount -1 do
    begin
      if SSTab1.Controls[i].ClassType = TShape then
      begin
        TShape(SSTab1.Controls[i]).Free;
      end;
    end;

    with DModule1.Qry_Other do
    begin
      Close;
      SQL.Text := 'select * from StationXY where MapPID=:pid1 order  by ComTag';
      Parameters.ParamByName('pid1').Value := Form5.PIDm ;
      Open;
      if recordcount >0 then
      begin
        //根据数据库记录声称道口和脚标
        while not Eof do
        begin
          Bitcds := TBitBtn.Create(self);
          OneShape := Tshape.Create(self);
          Bitcds.Parent := SSTab1;
          OneShape.Parent := sstab1 ;
          OneShape.Brush.Style := bsClear;  //bsSolid;
          OneShape.Pen.Color := ClBlue;
          OneShape.Shape := stCircle;
          OneShape.Pen.Width := 2;
          OneShape.Height := 16;
          OneShape.Width := 16;                        //- MainLeftleave
          Bitcds.Left := fieldbyname('ComLeft').AsInteger ;    // - MainTopLeave
          Bitcds.Top:= fieldbyname('ComTop').AsInteger;
          //以下为给shape定位
          FX := fieldbyname('Flaah').AsString;
          if FX = 'LU' then //左上
          begin
            OneShape.Left := Bitcds.Left-Round(OneShape.Width/2) ;
            OneShape.Top := Bitcds.Top - Round(OneShape.Height/2);
          end
          else
          if FX = 'LD' then //左下
          begin
            OneShape.Left := Bitcds.Left-Round(OneShape.Width/2) ;
            OneShape.Top := Bitcds.Top + Bitcds.Height - Round(OneShape.Height/2);
          end
          else
          if FX = 'RU' then //右上
          begin
            OneShape.Left := Bitcds.Left + Bitcds.Width - Round(OneShape.Width/2) ;
            OneShape.Top := Bitcds.Top - Round(OneShape.Height/2);
          end
          else
          if FX = 'RD' then //右下
          begin
            OneShape.Left := Bitcds.Left + Bitcds.Width - Round(OneShape.Width/2) ;
            OneShape.Top := Bitcds.Top + Bitcds.Height - Round(OneShape.Height/2);
          end
          else //其他都按左上处理
          begin
            OneShape.Left := Bitcds.Left-Round(OneShape.Width/2) ;
            OneShape.Top := Bitcds.Top - Round(OneShape.Height/2);
          end;
          Bitcds.Caption := fieldbyname('DKName').AsString;
          Bitcds.OnClick := StationClick;
          Bitcds.OnMouseDown := StationDown; //开始移动标志
          Bitcds.OnMouseUp := StationUp; //删除道口和移动道口用
          Bitcds.OnMouseMove := StationMove; //移动道口位置
          Bitcds.PopupMenu := PopupMenu2;
          Bitcds.Cursor := crHandPoint;
          Bitcds.Hint := fieldbyname('DKName').AsString;
          Bitcds.Height := 25;
          //Bitcds.Width := 80;
          Bitcds.width:=self.Canvas.TextWidth(Bitcds.Caption)+8;
          Bitcds.Tag := fieldbyname('ComTag').AsInteger;
          Bitcds.ShowHint := true;
          Bitcds.Show;
          Next;
        end;
      end;
    end;

  except

    RefrashThis;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RefrashThis;
end;

procedure TForm1.StationClick(Sender: TObject);
begin
  try
    //showmessage(inttostr(TBitbtn(sender).Left)+'  '+ inttostr(TBitbtn(sender).Top));
     TagNow := TBitbtn(sender).Tag;
    Form2.OperaType := 'DKbaseOP';
    Form2.DataName := 'DKBase';
    Form2.PageControl1.ActivePageIndex := 0;
    Form2.OrderByName := 'DBase_Tag';
    Form2.Brow_Dic(Form2.DataName,TagNow);
    Form2.CDSPanel := Form2.Panel1;
    Form2.Caption :=  TBitbtn(sender).Caption+'_详细信息';
    Form2.EmpSome_Dic;
    Form2.ShowModal;
  except

  end;
end;
//新建道口
procedure TForm1.N1Click(Sender: TObject);
var
  DKName : string;
  i ,TagNo: integer;
begin
  try
    if Application.MessageBox('确认添加新道口吗？','提示',MB_YESNO) <> 6 then
      exit;
    //DKName := Inputbox('输入', '输入道口名称', '未命名道口');

    if not  InputQuery('输入', '输入道口名称:',DKName) then
      exit;
    if trim(DKName) = '' then
      exit;
    with DModule1.Qry_New do
    begin
      Close;
      SQL.Text := 'select Comtag from StationXY order by Comtag';
      Open;
      for i := 1 to recordcount  do //中间有空缺的数字
      begin
        tagNo := i;
        if fieldbyname('ComTag').AsInteger <> i then
        begin
          with DModule1.Qry_BrowTwo do
          begin
            Close;
            SQL.Clear;
            SQL.Add('insert into StationXY (ComName,DKName,ComTag,ComLeft,ComTop,MapPID)  ');
            SQL.Add('Values(:Name1,:DKname1,:Tag1,:left1,:top1,:PID1)');
            Parameters.ParamByName('Name1').Value := 'BitBtn'+ inttostr(tagNo);
            Parameters.ParamByName('DKname1').Value := DKname;
            Parameters.ParamByName('Tag1').Value := TagNo;
            Parameters.ParamByName('left1').Value := NewDKX;
            Parameters.ParamByName('top1').Value := NewDKY;
            Parameters.ParamByName('PID1').Value := Form5.PIDm;
            ExecSQL;
            RefrashThis;
            Exit;
          end;
        end;
        Next;
      end; //end for
      //中间无空缺
      Close;
      SQL.Text := 'select Max(Comtag) as a from StationXY ';
      Open;
          with DModule1.Qry_BrowTwo do
          begin
            Close;
            SQL.Clear;
            SQL.Add('insert into StationXY (ComName,DKName,ComTag,ComLeft,ComTop,MapPID)  ');
            SQL.Add('Values(:Name1,:DKname1,:Tag1,:left1,:top1,:PID1)');
            //showmessage(sql.Text);
            Parameters.ParamByName('Name1').Value := 'BitBtn'+ inttostr(DModule1.Qry_New.fieldbyname('a').AsInteger+1);
            Parameters.ParamByName('DKname1').Value := DKname;
            Parameters.ParamByName('Tag1').Value := DModule1.Qry_New.fieldbyname('a').AsInteger+1;
            Parameters.ParamByName('left1').Value := NewDKX;
            Parameters.ParamByName('top1').Value := NewDKY;
            Parameters.ParamByName('PID1').Value := Form5.PIDm;
            ExecSQL;
            RefrashThis;
          end;
    end;
  except

  end;
end;

procedure TForm1.SSTab1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,ThisTag : integer;
begin
 try
   NewDKX := X ;  NewDKY :=Y;
    if DKMoveBegin  and IfkeyDown then
    begin
      {ThisTag :=  TBitBtn(sender).Tag;    MoveBItBtn
      DKMoveBegin := false; //移动标志结束
      IfkeyDown := false;
      TBitBtn(sender).Left := X;
      TBitBtn(sender).Top := Y;}
      ThisTag :=  MoveBItBtn.Tag;
      DKMoveBegin := false; //移动标志结束
      IfkeyDown := false;
      MoveBItBtn.Left := X;
      MoveBItBtn.Top := Y;
      MoveBItBtn.Visible := true;
      //向数据库中添加坐标改动
      with DModule1.Qry_BrowTwo do
      begin
        Close;
        SQL.Clear;
        SQL.Add('Update StationXY set ComLeft=:Left1,comTop=:Top1 where ComTag=:Tag1');
        Parameters.ParamByName('left1').Value := X;
        Parameters.ParamByName('Top1').Value := Y;
        Parameters.ParamByName('Tag1').Value := ThisTag;
        ExecSQL;

      end;
       RefrashThis;
    end;
  except
    showmessage('移动操作失败！');
    DModule1.ADOConnection1.RollbackTrans;
    RefrashThis;
  end;
end;
//删除
procedure TForm1.N4Click(Sender: TObject);
var
  i,thisTag : integer;
begin
  try
    if Application.MessageBox('确认删除该道口信息吗？','提示',MB_YESNO) <> 6 then
      exit;
      for i := 0 to SStab1.ControlCount -1 do
      begin
        if SStab1.Controls[i].ClassType = TBitBtn then
          if TBitBtn(SStab1.Controls[i]).Focused then
          begin
             thisTag := TBitBtn(SStab1.Controls[i]).Tag;
             TBitBtn(SStab1.Controls[i]).Free;
             DeleteDKDB(ThisTag); //删除道口数据库信息；
             RefrashThis;
             Exit;
          end;
      end;
      RefrashThis;

  except
    showmessage('删除道口信息失败！');
    DModule1.ADOConnection1.RollbackTrans;
    RefrashThis;
  end;
end;

procedure TForm1.StationUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var
  ThisTag : integer;
begin
  try
    //showmessage(inttostr(TBitbtn(sender).Left)+'  '+ inttostr(TBitbtn(sender).Top));
    if Button = MBleft then
    begin
      if DKMoveBegin  and IfkeyDown then
      begin