fform.pas

图论算法

           temppoint := Tgraphpoint.create(self);
           temppoint.parent := self;
           temppoint.left := Tgraphpoint(Sender).left;
           temppoint.top  := Tgraphpoint(Sender).top;
           temppoint.pointlabel := Tgraphpoint(Sender).pointlabel;
           temppoint.fillcolor := clgray;
           temppoint.linecolor := clwhite;
           temppoint.pointlabelcolor := clwhite;
           Tgraphpoint(Sender).bringtofront;
           isdragging := True;
         end;
    end
  else if ssRight in Shift then
    begin
      currgraphpoint := Tgraphpoint(Sender);
    end;
end;

procedure TFindForm.GraphPointMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var newleft,newtop:integer;
begin
  if (ssleft in shift) and isdragging then
    begin
      with TGraphPoint(Sender) do
        begin
          newleft := left + X - grabpoint.X;
          newtop := top + Y - grabpoint.Y;
          if (newleft >= 0) and (newleft <= self.clientWidth-45) and (newtop >= 0) and (newtop <= self.clientheight-10)then
             SetBounds(newleft,newtop,Width,Height);
        end;
    end;
end;

procedure TFindForm.GraphPointMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:integer;
    theEdge:TEdge;
    Xdistance ,Ydistance :integer;
begin
  if isdragging then
    begin
      Xdistance := temppoint.left - Tgraphpoint(Sender).left;
      Ydistance := temppoint.top - Tgraphpoint(Sender).top;
      temppoint.free;
      if Xdistance*Xdistance + Ydistance*Ydistance > 0 then
         with Tvertex(Tgraphpoint(Sender).Vertex) do
           for i := 1 to Neighbourcount do NE[i].redraw;
      if controlbutton.down then
         begin
           for i := 0 to controlpointlist.count -1 do
            begin
              theEdge := Tedge(Tcontrolpoint(controlpointlist.items[i]).controledge);
              if Tvertex(Tgraphpoint(Sender).Vertex).isNeighbourEdge(theEdge) and
                 (not theEdge.iscurve) then
                begin
                  Tcontrolpoint(controlpointlist.items[i]).left := theEdge.controlpointpos[1].X - 3;
                  Tcontrolpoint(controlpointlist.items[i]).top := theEdge.controlpointpos[1].Y - 3;
                end;
            end;
         end;
      isdragging := false;
    end;
end;

procedure TFindForm.GraphPointDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if isconnecting then
     begin
       accept := true;
       if Tgraphpoint(Sender) <> Tgraphpoint(Source) then
          begin
            canvas.polyline([Tgraphpoint(Source).centerpoint,connectpoint]);
            connectpoint := Tgraphpoint(Sender).centerpoint;
            canvas.polyline([Tgraphpoint(Source).centerpoint,connectpoint]);
          end;
     end;
end;

procedure TFindForm.GraphPointDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var theEdge:Tedge;
begin
  if isconnecting then
     begin
       canvas.polyline([Tgraphpoint(Source).centerpoint,connectpoint]);
       if (Tgraphpoint(Sender) <> Tgraphpoint(Source))
         and (not Tvertex(Tgraphpoint(Source).vertex).isNeighbourVertex(Tvertex(Tgraphpoint(Sender).vertex)))
       then
          begin
           if isruning then RunButtonClick(nil);
           theEdge := TEdge.create(self,Tvertex(Tgraphpoint(Source).vertex),Tvertex(Tgraphpoint(Sender).vertex));
           Edgelist.add(theEdge);
           linebutton.down := false;
           if controlbutton.down then theEdge.drawControlpoint;
          end
       else
          beep;
       isconnecting := False;
     end;
end;

procedure TFindForm.GraphPointDblClick(Sender: TObject);
var i:integer;
    R:Trect;
begin
  isDblClick := true;
  i := TGraphpoint(Sender).PointLabel;
  form2.Clientwidth := dltourbitmaps[i].width ;
  form2.Clientheight := dltourbitmaps[i].height ;
  R := rect(0,0,dltourbitmaps[i].width,dltourbitmaps[i].height);
  form2.Dalianimage.canvas.CopyRect(R,dltourbitmaps[i].canvas,R);
  daliantimer.enabled := false;
  form2.showmodal;
  daliantimer.enabled := true;
  form2.Dalianimage.picture := nil;
end;
procedure TFindForm.GraphPointMouseEnter(Sender: TObject);
var i:integer;
begin
  i := TGraphpoint(Sender).PointLabel;
  puthint(clBlue,12,dltourStrings[i]);
  dlanistrings[3] := dltourStrings[i];
  isEnter := true;
end;

procedure TFindForm.GraphPointMouseLeave(Sender: TObject);
begin
  if daliantimer.enabled then
  begin
    dlanistrings[3] := '请双击每个顶点观赏大连秀丽风光';
    puthint(clBlue,12,dlanistrings[3]);
  end;  
  isEnter := false;
end;

procedure TFindForm.ControlPointMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if ssleft in Shift then
    begin
      grabpoint.X := X;
      grabpoint.Y := Y;
      tempcpoint := Tcontrolpoint.create(self);
      tempcpoint.parent := self;
      tempcpoint.left := TControlPoint(Sender).left;
      tempcpoint.top  := TControlPoint(Sender).top;
      tempcpoint.fillcolor := clgray;
      tempcpoint.linecolor := clWhite;
      TControlPoint(Sender).bringtofront;
      isdragging := True;
    end
  else if ssRight in Shift then
    begin
      currControlpoint := TControlPoint(Sender);
      if Tedge(currControlpoint.controlEdge).iscurve then
         addControlpoint.enabled := True
      else
         addControlpoint.enabled := False;
    end;
end;

procedure TFindForm.ControlPointMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var newleft,newtop:integer;
begin
  if (ssleft in shift) and isdragging then
    begin
      with  TControlPoint(Sender) do
        begin
          newleft := left + X - grabpoint.X;
          newtop := top + Y - grabpoint.Y;
          if (newleft >= 0) and (newleft <= self.clientWidth-40) and (newtop >= 0) and (newtop <= self.clientheight-4)then
             SetBounds(newleft,newtop,Width,Height);
        end;
    end;
end;

procedure TFindForm.ControlPointMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  function distance(a1,b1:tpoint):integer;
    begin
      result := round(sqrt(sqr(a1.x - b1.x) + sqr (a1.y - b1.y)))
    end;
begin
  if isdragging then
    begin
      if distance(point(tempcpoint.left,tempcpoint.top),point(Tcontrolpoint(Sender).left,Tcontrolpoint(Sender).top)) < 3 then
         begin
           isdragging := False;
           tempcpoint.free;
           exit;
         end;
      tempcpoint.free;
      with Tcontrolpoint(Sender) do
        begin
          if not Tedge(controledge).isCurve then Tedge(controledge).isCurve := True;
          Tedge(controledge).Controlpointpos[orderno].X := left+3;
          Tedge(controledge).Controlpointpos[orderno].Y := top+3;
          Tedge(controledge).redraw;
        end;
      isdragging := False;
    end;
end;

procedure TFindForm.ControlPointDblClick(Sender: TObject);
var i:integer;
begin
  with Tcontrolpoint(Sender) do
    begin
     if Tedge(controledge).isCurve then Tedge(controledge).restoretoLine;
    end;
  for i := 0 to controlpointlist.count -1 do
    if (Tcontrolpoint(controlpointlist.items[i]).controledge = Tcontrolpoint(Sender).controledge)
       and (controlpointlist.items[i] <> Tcontrolpoint(Sender)) then
       begin
         Tcontrolpoint(controlpointlist.items[i]).free;
         controlpointlist.items[i] := nil;
       end;
  controlpointlist.pack;
  with Tcontrolpoint(Sender) do
    begin
      left := Tedge(controledge).controlpointpos[1].X - 3;
      top := Tedge(controledge).controlpointpos[1].Y - 3;
      orderno := 1;
    end;
end;

procedure TFindForm.newGraph;
var i:integer;
begin
  for i := 0 to Controlpointlist.count - 1 do
    TControlpoint(Controlpointlist.items[i]).free;
  Controlpointlist.clear;
  for i := 0 to VertexList.count - 1 do
    TVertex(Vertexlist.items[i]).free;
  Vertexlist.clear;
  for i := 0 to EdgeList.count - 1 do
    TEdge(Edgelist.items[i]).free;
  Edgelist.clear;
  pointlabel := 1;
  isconnecting := False;
  isdragging := False;
  ControlButton.down := false;
  pointButton.down := false;
  lineButton.down := false;

  isRuning := False;
  findimage.canvas.draw(0,0,readybitmap);
  RunButton.down := false;
  ControlButton.down := false;
  if isbegin then
     begin
       isBegin :=false;
       salesmanImage.hide;
       salesmanImage.picture := nil;
     end;
  if isDalian then
     begin
       daliantimer.enabled := false;
       freeDlbitmap;
       dalianimage1.picture := nil;
       dalianimage2.picture := nil;
       dalianimage1.visible := false;
       dalianimage2.visible := false;
       isDalian := false;
       hcplabel1.visible := true;
       hcplabel2.visible := true;
     end;
  caption := '迷路的旅行推销员(发现哈密尔顿回路)/newgraph';
end;

procedure TFindForm.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if isconnecting then
     begin
       canvas.polyline([Tgraphpoint(Source).centerpoint,connectpoint]);
       isconnecting := False;
     end;
end;

procedure TFindForm.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if isconnecting then
     begin
       accept := true;
       canvas.polyline([Tgraphpoint(Source).centerpoint,connectpoint]);
       connectpoint.X := X;
       connectpoint.Y := Y;
       canvas.polyline([Tgraphpoint(Source).centerpoint,connectpoint]);
     end;
end;

procedure TFindForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var i:integer;
begin
  if Key = VK_LEFT then
     begin
       for i:= 0 to Vertexlist.count - 1 do
         Tvertex(Vertexlist[i]).PointControl.left := Tvertex(Vertexlist[i]).PointControl.left - 4;
       for i:= 0 to Edgelist.count - 1 do
         Tedge(Edgelist[i]).redraw;
     end
  else if Key = VK_Right then
     begin
       for i:= 0 to Vertexlist.count - 1 do
         Tvertex(Vertexlist[i]).PointControl.left := Tvertex(Vertexlist[i]).PointControl.left + 4;
       for i:= 0 to Edgelist.count - 1 do
         Tedge(Edgelist[i]).redraw;
     end
  else if Key = VK_Up then
     begin
       for i:= 0 to Vertexlist.count - 1 do
         Tvertex(Vertexlist[i]).PointControl.top := Tvertex(Vertexlist[i]).PointControl.top - 4;
       for i:= 0 to Edgelist.count - 1 do
         Tedge(Edgelist[i]).redraw;
     end
  else if Key = VK_Down then
     begin
       for i:= 0 to Vertexlist.count - 1 do
         Tvertex(Vertexlist[i]).PointControl.top := Tvertex(Vertexlist[i]).PointControl.top + 4;
       for i:= 0 to Edgelist.count - 1 do
         Tedge(Edgelist[i]).redraw;
     end
  else if key = VK_ESCAPE then
     RunButtonClick(nil);
end;

procedure TFindForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var thevertex:TVertex;
begin
  if (mbRight = Button) or pointbutton.down then
     begin
       if isruning then RunButtonClick(nil);
       theVertex := TVertex.create(self,X - 8,Y - 8,pointlabel);
       VertexList.add(theVertex);
       inc(pointlabel);
       if pointbutton.down then pointbutton.down := false;
     end;
end;

procedure TFindForm.newButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,12,'新建一个图文件');
end;

procedure TFindForm.newButtonMouseLeave(Sender: TObject);
begin
  MyButtonMouseLeave(Sender);
end;

procedure TFindForm.newButtonClick(Sender: TObject);
begin
  MyButtonClick(Sender);
  newGraph;
end;

procedure TFindForm.OpenButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,12,'打开一个图文件');
end;
procedure TFindForm.OpenButtonMouseLeave(Sender: TObject);
begin
  MyButtonMouseLeave(Sender);
end;
procedure TFindForm.OpenButtonClick(Sender: TObject);
var readfilestream : TFilestream;
    reader : Treader;
    i:integer;
    theVertexcount,theEdgecount:integer;
begin
  MyButtonClick(Sender);
  if OpenDialog1.execute then
     begin
       newGraph;
       readfilestream := TFilestream.create(openDialog1.filename,fmOpenRead);
       reader := Treader.create(readfilestream,256);
       if copy(reader.readstring,2,7) <> 'inhai20' then
          begin
            showmessage('Error graph file!');
            reader.free;
            readfilestream.free;
            exit;
          end;
       caption := '迷路的旅行推销员(发现哈密尔顿回路)/'+ExtractFileName(openDialog1.filename);
       pointlabel := reader.readinteger;
       theVertexcount := reader.readinteger;
       theEdgecount := reader.readinteger;
       for i:= 0 to theVertexcount - 1 do
         VertexList.add(TVertex.create(self,-16,-16,0));
       for i:= 0 to theEdgecount - 1 do
         EdgeList.add(TEdge.create(self,nil,nil));
       for i:= 0 to theVertexcount - 1 do
         Tvertex(VertexList.items[i]).load(reader);
       for i:= 0 to theEdgecount - 1 do
         TEdge(EdgeList.items[i]).load(reader);
       reader.free;
       readfilestream.free;
     end;
end;

procedure TFindForm.saveButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,12,'保存一个图文件');
end;

procedure TFindForm.saveButtonMouseLeave(Sender: TObject);
begin
  MyButtonMouseLeave(Sender);
end;

procedure TFindForm.saveButtonClick(Sender: TObject);
var writefilestream : TFilestream;
    writer : Twriter;
    i :integer;
begin
  MyButtonClick(Sender);
  if SaveDialog1.execute then
     begin