fform.pas

图论算法

       if fileexists(saveDialog1.filename) then
          begin
            if Application.MessageBox(pchar('请确定是否覆盖同名图文件:'+ExtractFileName(saveDialog1.filename)),
               '提示',mb_YesNo) = IDNO then
               exit;
          end;
       writefilestream := TFilestream.create(saveDialog1.filename,fmOpenWrite or fmCreate);
       writer := Twriter.create(writefilestream,256);
       writer.writestring('Linhai2000');
       writer.writeinteger(pointlabel);
       writer.writeinteger(VertexList.count);
       writer.writeinteger(EdgeList.count);
       for i:=0 to VertexList.count - 1 do
         Tvertex(VertexList.items[i]).save(writer);
       for i:=0 to EdgeList.count - 1 do
         TEdge(EdgeList.items[i]).save(writer);
       writer.free;
       writefilestream.free;
       caption := '迷路的旅行推销员(发现哈密尔顿回路)/'+ExtractFileName(saveDialog1.filename);
     end;
end;

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

procedure TFindForm.PointButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,12,'插入一个顶点');
end;

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

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

procedure TFindForm.LineButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,12,'连接两个顶点形成一条边');
end;

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

procedure TFindForm.ControlButtonClick(Sender: TObject);
var i:integer;
    themidpoint:Tpoint;
begin
  MyButtonClick(Sender);
  if ControlButton.down then
    begin
      for i := 0 to edgelist.count-1 do
        Tedge(edgelist.items[i]).drawControlPoint;
    end
  else
    begin
      for i:= 0 to Controlpointlist.count-1 do
        TControlpoint(Controlpointlist.items[i]).free;
      Controlpointlist.clear;
    end;
end;

procedure TFindForm.ControlButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,12,'显示边控制点');
end;

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

procedure TFindForm.RunButtonClick(Sender: TObject);
var i :integer;
begin
  MyButtonClick(Sender);
  if isRuning then
     begin
       isRuning := False;
       RunButton.down := false;
       findimage.canvas.draw(0,0,readybitmap);
       screen.cursor := crDefault;
       if isfind then
         for i := 0 to Edgelist.count - 1 do
           begin
             Tedge(Edgelist[i]).colorWidth(clBlack,1);
           end;
       if isbreak then isbreak := false;
       isfind := false;
     end
  else
     begin
       if vertexlist.count < 3 then
          begin
            puthint(clBlack,12,'顶点数至少为3 !');
            beep;
            exit;
          end;
       Buttontimer.enabled := False;

       isRuning := True;
       isbreak := true;
       isfind := false;
       screen.cursor := -19;
       puthint(clBlack,12,'寻找一条哈密尔顿回路');
       if not checkHamiltonian then
          begin
            if isbreak then
               begin
                 puthint(clBlack,12,'我已经很卖力了，但是 ...');
                 findimage.canvas.draw(0,0,notfindbitmap);
                 beep;
               end
            else
               puthint(clBlack,12,'中断');
          end
       else
         begin
           screen.cursor := crHourglass;
           if GetHamiltonCircuit then
              begin
                puthint(clBlack,12,'我找到啦!');
                findimage.canvas.draw(0,0,findbitmap);
                isfind := true;
                beep;
              end
           else
              begin
                if isbreak then
                   begin
                     puthint(clBlack,12,'我已经很卖力了，但是 ...');
                     findimage.canvas.draw(0,0,notfindbitmap);
                     beep;
                   end
                else
                   puthint(clBlack,12,'中断');
              end;
         end;
       screen.cursor := crDefault;
       isbreak := false;
     end;
end;

procedure TFindForm.RunButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,12,'寻找一条哈密尔顿回路');
end;

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

procedure TFindForm.dalianTimerTimer(Sender: TObject);
begin
  if not isEnter then
     begin
       case dalianframe of
        1:puthint(clBlue,11,dlanistrings[1]);
        4:puthint(clBlue,11,dlanistrings[2]);
        7:puthint(clBlue,12,dlanistrings[3]);
       end;
     end;
  case dalianframe of
    1,4,7:dalianimage2.canvas.draw(0,0,DlaniBitmaps[1]);
    2,5,8:dalianimage2.canvas.draw(0,0,DlaniBitmaps[2]);
    3,6,9:dalianimage2.canvas.draw(0,0,DlaniBitmaps[3]);
  end;
  inc(dalianframe);
  if dalianframe> 9 then dalianframe := 1;
end;

procedure TFindForm.DalianButtonClick(Sender: TObject);
var readfilestream : TFilestream;
    reader : Treader;
    i:integer;
    theVertexcount,theEdgecount:integer;
begin
  MyButtonClick(Sender);
  if not isdalian then
     begin
       newGraph;
       isDalian := true;
       hcplabel1.visible := false;
       hcplabel2.visible := false;
       if fileexists(bitmappath+'dalian.gph') then
         begin
           loadDlbitmap;
           dalianimage1.canvas.draw(0,0,DlmapBitmap);
           dalianimage2.canvas.draw(0,0,DlaniBitmaps[1]);
           dalianimage1.visible := true;
           dalianimage2.visible := true;
           dalianframe := 0;
           daliantimer.enabled := true;

           readfilestream := TFilestream.create(bitmappath+'dalian.gph',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 := '迷路的旅行推销员(发现哈密尔顿回路)/dalian';
           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;

           for i:= 0 to theVertexcount - 1 do
             begin
               Tvertex(VertexList.items[i]).PointControl.onDblClick := GraphPointDblClick;
               Tvertex(VertexList.items[i]).PointControl.OnMouseEnter := GraphPointMouseEnter;
               Tvertex(VertexList.items[i]).PointControl.OnMouseLeave := GraphPointMouseLeave;
             end;
           dlanistrings[3] := '请双击每个顶点观赏大连秀丽风光';
           puthint(clBlue,12,dlanistrings[3]);
         end;
     end;
end;

procedure TFindForm.DalianButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlue,12,'美哉 ！大连');
end;

procedure TFindForm.DalianButtonMouseLeave(Sender: TObject);
begin
  MyButtonMouseLeave(Sender);

end;

procedure TFindForm.HelpButtonClick(Sender: TObject);
begin
  MyButtonClick(Sender);
  Application.HelpContext(10);
end;

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

procedure TFindForm.HelpButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,12,'帮助');
end;

procedure TFindForm.BaguicButtonClick(Sender: TObject);
begin
  application.helpfile := bitmappath + 'hcp.hlp>baguic';
  Application.Helpcontext(50);
  application.helpfile := bitmappath + 'hcp.hlp>main';
end;
procedure TFindForm.BaguicButtonMouseEnter(Sender: TObject);
begin
  MyButtonMouseEnter(Sender);
  puthint(clBlack,17,'八卦编程语言！');
end;

procedure TFindForm.BaguicButtonMouseLeave(Sender: TObject);
begin
  MyButtonMouseLeave(Sender);

end;

procedure TFindForm.changepointcolorClick(Sender: TObject);
begin
  if ColorDialog1.execute then
     begin
       if ColorDialog1.color <> clBlack then
          begin
            currgraphpoint.fillcolor := ColorDialog1.color;
          end;
     end;
end;

procedure TFindForm.deletepointClick(Sender: TObject);
var i:integer;
    theVertex:Tvertex;
begin
  if ControlButton.down then
     begin
       ControlButton.down := false;
       for i:= 0 to Controlpointlist.count-1 do
         TControlpoint(Controlpointlist.items[i]).free;
       Controlpointlist.clear;
     end;
  if isruning then RunButtonClick(nil);
  theVertex := Tvertex(currgraphpoint.Vertex);
  //delete neighbour vertex's link which to thevertex
  for i := 1 to theVertex.Neighbourcount do
    theVertex.NV[i].removeNeighbourVertex(theVertex);
  VertexList.remove(theVertex);
  for i:= 0 to edgelist.count - 1 do  //free neighbour edge
   if theVertex.isNeighbourEdge(TEdge(edgelist.items[i])) then
      begin
        TEdge(edgelist.items[i]).free;
        edgelist.items[i] := nil;
      end;
  edgelist.pack;
  theVertex.free;
end;

procedure TFindForm.addControlpointClick(Sender: TObject);
begin
  Tedge(currControlpoint.controlEdge).addControlPoint;
  Tedge(currControlpoint.controlEdge).redraw;
end;

procedure TFindForm.changeEdgecolorClick(Sender: TObject);
begin
  if ColorDialog1.execute then
     begin
       if ColorDialog1.color <> clBlack then
          begin
            TEdge(currControlpoint.controlEdge).Edgecontrol.color := ColorDialog1.color;
          end;
     end;
end;

procedure TFindForm.threewideClick(Sender: TObject);
begin
  Tedge(currControlpoint.controlEdge).EdgeControl.linewidth := 3;
end;

procedure TFindForm.twowideClick(Sender: TObject);
begin
  Tedge(currControlpoint.controlEdge).EdgeControl.linewidth := 2;
end;

procedure TFindForm.oneWideClick(Sender: TObject);
begin
  Tedge(currControlpoint.controlEdge).EdgeControl.linewidth := 1;
end;

procedure TFindForm.restoreEdgeClick(Sender: TObject);
var i:integer;
begin
  with currControlpoint 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 = currControlpoint.controledge)
       and (controlpointlist.items[i] <> currControlpoint) then
       begin
         Tcontrolpoint(controlpointlist.items[i]).free;
         controlpointlist.items[i] := nil;
       end;
  controlpointlist.pack;
  with currControlpoint do
    begin
      left := Tedge(controledge).controlpointpos[1].X - 3;
      top := Tedge(controledge).controlpointpos[1].Y - 3;
      orderno := 1;
    end;
end;

procedure TFindForm.deleteEdgeClick(Sender: TObject);
var i:integer;
    theEdge:TEdge;
begin
  if isruning then RunButtonClick(nil);
  theEdge := TEdge(currControlpoint.controledge);
  theEdge.XVertex.removeNeighbourVertex(theEdge.YVertex);
  theEdge.YVertex.removeNeighbourVertex(theEdge.XVertex);
  Edgelist.remove(theEdge);

  for i := 0 to controlpointlist.count -1 do
    if TEdge(Tcontrolpoint(controlpointlist.items[i]).controledge) = theEdge then
       begin
         Tcontrolpoint(controlpointlist.items[i]).free;
         controlpointlist.items[i] := nil;
       end;
  controlpointlist.pack;
  theEdge.free;
end;


procedure TFindForm.FormResize(Sender: TObject);
begin
  statusbar.top := clientheight - statusbar.height;
  statusbar.width := clientwidth - panel1.width -2;
  hcpLabel1.left := statusbar.width - 108;
  hcpLabel2.left := statusbar.width - 108;
end;

procedure TFindForm.hcpLabel1Click(Sender: TObject);
begin
  ShellExecute(handle,'open','http://hcp.yeah.net',nil,'',SW_MAXIMIZE)
end;

procedure TFindForm.hcpLabel2Click(Sender: TObject);
begin
  ShellExecute(handle,'open','http://baguic.yeah.net',nil,'',SW_MAXIMIZE)
end;

end.