unit1.pas

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

       { TBitBtn(sender).Visible := True;
        ThisTag :=  TBitBtn(sender).Tag;
        DKMoveBegin := false; //移动标志结束
        IfkeyDown := false;
        TBitBtn(sender).Left := X;
        TBitBtn(sender).Top := Y;   }
      end;
     // showmessage('错');
    end
    else if Button = mbRight then//删除或改名准备
    begin
     // ThisTag := TBitBtn(sender).Tag;
     // showmessage(inttostr(thistag));
      //TBItBtn(sender).Free;
      TBitBtn(sender).SetFocus;

    end;
  except

  end;
end;

procedure TForm1.DeleteDKDB(TagC : integer);
begin
  try
    with DModule1.Qry_BrowTwo do
    begin
      CLose;
      SQL.Text := 'delete from StationXY where ComTag=:Tag1';
      Parameters.ParamByName('tag1').Value := TagC;
      ExecSQL;
      CLose;
      SQL.Text := 'delete from DKBase where DBase_Tag=:Tag1';
      Parameters.ParamByName('tag1').Value := TagC;
      ExecSQL;
    end;
  except
    showmessage('删除道口失败！');
    DModule1.ADOConnection1.RollbackTrans;
  end;
end;
//道口的移动
procedure TForm1.N2Click(Sender: TObject);
begin
  try
    if Application.MessageBox('确认要移动该道口位置吗？','提示',MB_YESNO) <> 6 then
      exit;
    DKMoveBegin := true;  //移动标志开始


   // DKMoveBegin := false; //移动标志结束
  except
    DKMoveBegin := false;
  end;
end;
//道口移动用
procedure TForm1.StationMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
  MyRect : TRect;

begin
  try  //开始移动        //鼠标左键按下标志
   { if DKMoveBegin  and IfkeyDown then //移动
    begin
     // TBitBtn(sender).Left := X;
     // TBitBtn(sender).Top := Y;
      //控件本身不移动，画一个矩形跟着鼠标Move
      MyRect :=  Rect(X,Y,X+80,Y+20);
      Canvas.Pen.Color := CLBlue;
      Canvas.Pen.Style := psDash;
      Repaint;
      Canvas.Rectangle(MyRect);

      SSTab1.Refresh;
    end;   }

  except

  end;
end;
//道口移动开始标志
procedure TForm1.StationDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  try
    if (Button = MBleft) and DKMoveBegin then
    begin
      IfkeyDown := true;
      MoveBItBtn := TBitBtn(Sender);
      MoveBItBtn.Visible := false;
    end;
  except
     IfkeyDown := false;
  end;
end;

procedure TForm1.SSTab1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MyRect : TRect;
  MyDC : Hdc;
begin
  //移动应该在这里写
  try
    if DKMoveBegin  and IfkeyDown then //移动
    begin
     // TBitBtn(sender).Left := X;
     // TBitBtn(sender).Top := Y;
      //控件本身不移动，画一个矩形跟着鼠标Move
      MyRect :=  Rect(X,Y,X+80,Y+20);//控制要画的矩形框的大小
      //Canvas.
     { Canvas.Pen.Color := CLBlack;
      Canvas.Pen.Style := psDash;
      Repaint;
      Canvas.Rectangle(MyRect);  }
     //?????SSTab控件没有Canvas属性.怎么画?????????????????????
     // SSTab1.Refresh;
      MyDc := Getdc(SStab1.Handle); //取得句柄
      if not (DrawFocusRect(MyDc,MyRect)) then //用API画
      //showmessage('画框错误');
      ReleaseDC(SStab1.Handle,Mydc);
      SStab1.Repaint ;
    end;
  except

  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LocalPath := ExtractFilePath(Application.ExeName);// 系统路径
end;

procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
  //RefrashThis;
  Form1.Close;
end;

procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i : integer;
begin
  if edit1.Text='' then
    exit;

  try
    i := strtoint(trim(edit1.Text));
    if i > 300  then
      Movestep := 300
    else
      Movestep := i;
  except
    edit1.Text := '100';
    showmessage('必须填写整数,且不能超过300！');
    Movestep := 100;
  end;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Speedbutton6.Click;
end;

procedure TForm1.ContralXYHF;
begin
  try
    Speedbutton1.Left := 3;
    Speedbutton1.Top := 377;

    Speedbutton2.Left := 999;
    Speedbutton2.Top := 377;

    Speedbutton3.Left := 462;
    Speedbutton3.Top := 3;

    Speedbutton4.Left := 462;
    Speedbutton4.Top := 743;

    Speedbutton6.Left := 136;
    Speedbutton6.Top := 3;

    edit1.Left := 64;
    edit1.Top := 3;

    Updown1.Left := 106;
    Updown1.Top := 3;

  except

  end;
end;

procedure TForm1.IfcanseeThis(cansee: boolean);
begin
  try
    Speedbutton1.Visible := cansee;
    Speedbutton2.Visible := cansee;
    Speedbutton3.Visible := cansee;
    Speedbutton4.Visible := cansee;
    //Speedbutton6.Visible := cansee;
    edit1.Visible := cansee;
    updown1.Visible := cansee;
  except

  end;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
  try
    SStab1.Picture.LoadFromFile(self.LocalPath + 'map\'+Form5.PathofMap); //装载完整地图
    n6.Enabled:=false;
    n7.Enabled:=true;
  except
    n6.Enabled:=true;
    n7.Enabled:=false;
    showmessage('装载地图文件错误！！');
  end;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
  try
    SStab1.Picture.LoadFromFile(self.LocalPath + 'map\'+Form5.PathOfRailWay); //装载完整地图
    n7.Enabled:=false;
    n6.Enabled:=true;
  except
    n7.Enabled:=true;
    n6.Enabled:=false;
    showmessage('装载地图文件错误！！');
  end;

end;



procedure TForm1.N9Click(Sender: TObject);
var
  i,thisTag : integer;
  DKName : string;
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;
             DKName := Inputbox('修改名称', '输入道口名称：', TBitBtn(SStab1.Controls[i]).Caption);
             with DModule1.Qry_BrowTwo do//修改数据库中的 名称
             begin
               Close;
               SQL.Clear;
               SQL.Add('Update StationXY set DKName=:ReName1 where  ComTag=:tag1 ');
               Parameters.ParamByName('ReName1').Value := DKName;
               Parameters.ParamByName('tag1').Value := thisTag;
               ExecSQL;
             end;
             RefrashThis;
             Exit;
          end;
      end;
      RefrashThis;
  except
    Showmessage('修改道口名称失败！');
  end;
end;
//改变道口角度
procedure TForm1.N10Click(Sender: TObject);
var
  i,thisTag : integer;
  DKName : string;
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;
             changFXtag := Thistag;
             with DModule1.Qry_BrowTwo do
             begin
               Close;
               SQL.Clear;
               SQL.Add('select Flaah from StationXY where ComTag=:tag1');
               Parameters.ParamByName('tag1').Value := thisTag;
               Open;
               if (recordcount > 0) and (fieldbyname('Flaah').AsString <> '') then
                 ThisFX := fieldbyname('Flaah').AsString
               else
                 ThisFX := 'LU';
             end;
             //DKName := Inputbox('修改名称', '输入道口名称', TBitBtn(SStab1.Controls[i]).Caption);
             Form6.Notebook1.ActivePage := 'JD';
             if thisFX = 'LU' then
               Form6.RadioGroup1.ItemIndex := 0
             else
             if thisFX = 'LD' then
               Form6.RadioGroup1.ItemIndex := 1
             else
             if thisFX = 'RU' then
               Form6.RadioGroup1.ItemIndex := 2
             else
             if thisFX = 'RD' then
               Form6.RadioGroup1.ItemIndex := 3
             else
               Form6.RadioGroup1.ItemIndex := 0;
             Form6.Height := 150;
             Form6.Width := 390;
             Form6.Caption := '改变脚标';
             Form6.Notebook1.ActivePage := 'change';
             Form6.ShowModal;
             Form6.RadioGroup1.ItemIndex := 0;
             Exit;
             {with DModule1.Qry_BrowTwo do//修改数据库中的 名称
             begin
               Close;
               SQL.Clear;
               SQL.Add('Update StationXY set Flaah=:Flaah1 where  ComTag=:tag1 ');
               Parameters.ParamByName('Flaah1').Value := DKName;
               Parameters.ParamByName('tag1').Value := thisTag;
               ExecSQL;
             end;  }
            // RefrashThis;

          end;
      end;
      RefrashThis;
  except
    Showmessage('修改道口名称失败！');
  end;
end;

//判断输入到是否是整数
function TForm1.IfLawInt(Inthis:string): boolean;
var
  PD : integer;
begin
  try
    PD := strtoint(trim(inthis));
    Result := true;
  except
    Result := false;
  end;
end;

end.