fform.pas

图论算法

unit FForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  mybutton, ExtCtrls, Menus, StdCtrls,VE, anyline, grapoint, ctlpoint,hamilton,
  hcplabel,shellapi, ComCtrls;

type
  TFindForm = class(TForm)
    Panel1: TPanel;
    newButton: TMyButton;
    OpenButton: TMyButton;
    saveButton: TMyButton;
    PointButton: TMyButton;
    LineButton: TMyButton;
    ControlButton: TMyButton;
    RunButton: TMyButton;
    HelpButton: TMyButton;
    DalianButton: TMyButton;
    BaguicButton: TMyButton;
    buttonTimer: TTimer;
    GraphpointPopupMenu: TPopupMenu;
    changepointcolor: TMenuItem;
    deletepoint: TMenuItem;
    ControlpointPopupMenu: TPopupMenu;
    addControlpoint: TMenuItem;
    changeEdgecolor: TMenuItem;
    changeEdgewidth: TMenuItem;
    oneWide: TMenuItem;
    twowide: TMenuItem;
    fourwide: TMenuItem;
    restoreEdge: TMenuItem;
    deleteEdge: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ColorDialog1: TColorDialog;
    statusbar: TPanel;
    findImage: TImage;
    salesmanImage: TImage;
    hintlabel: TLabel;
    dalianImage1: TImage;
    dalianImage2: TImage;
    dalianTimer: TTimer;
    hcpLabel1: ThcpLabel;
    hcpLabel2: ThcpLabel;
    procedure FormCreate(Sender: TObject);
    procedure buttonTimerTimer(Sender: TObject);
    procedure MyButtonMouseEnter(Sender: TObject);
    procedure MyButtonMouseLeave(Sender: TObject);
    procedure MyButtonClick(Sender: TObject);
    procedure newButtonMouseEnter(Sender: TObject);
    procedure newButtonMouseLeave(Sender: TObject);
    procedure newButtonClick(Sender: TObject);
    procedure DalianButtonClick(Sender: TObject);
    procedure DalianButtonMouseEnter(Sender: TObject);
    procedure DalianButtonMouseLeave(Sender: TObject);
    procedure HelpButtonClick(Sender: TObject);
    procedure HelpButtonMouseLeave(Sender: TObject);
    procedure HelpButtonMouseEnter(Sender: TObject);
    procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OpenButtonClick(Sender: TObject);
    procedure OpenButtonMouseEnter(Sender: TObject);
    procedure OpenButtonMouseLeave(Sender: TObject);
    procedure saveButtonClick(Sender: TObject);
    procedure saveButtonMouseEnter(Sender: TObject);
    procedure saveButtonMouseLeave(Sender: TObject);
    procedure PointButtonClick(Sender: TObject);
    procedure PointButtonMouseEnter(Sender: TObject);
    procedure PointButtonMouseLeave(Sender: TObject);
    procedure LineButtonClick(Sender: TObject);
    procedure LineButtonMouseEnter(Sender: TObject);
    procedure LineButtonMouseLeave(Sender: TObject);
    procedure ControlButtonClick(Sender: TObject);
    procedure ControlButtonMouseEnter(Sender: TObject);
    procedure ControlButtonMouseLeave(Sender: TObject);
    procedure RunButtonClick(Sender: TObject);
    procedure RunButtonMouseEnter(Sender: TObject);
    procedure RunButtonMouseLeave(Sender: TObject);
    procedure changepointcolorClick(Sender: TObject);
    procedure deletepointClick(Sender: TObject);
    procedure addControlpointClick(Sender: TObject);
    procedure changeEdgecolorClick(Sender: TObject);
    procedure oneWideClick(Sender: TObject);
    procedure twowideClick(Sender: TObject);
    procedure threewideClick(Sender: TObject);
    procedure restoreEdgeClick(Sender: TObject);
    procedure deleteEdgeClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure dalianTimerTimer(Sender: TObject);
    procedure BaguicButtonClick(Sender: TObject);
    procedure BaguicButtonMouseEnter(Sender: TObject);
    procedure BaguicButtonMouseLeave(Sender: TObject);
    procedure hcpLabel1Click(Sender: TObject);
    procedure hcpLabel2Click(Sender: TObject);
  private
    { Private declarations }
    isfind:boolean;
    isbreak:boolean;
    isbegin:boolean;
    isDalian:Boolean;
    isEnter:Boolean;
    isDblClick:Boolean;
    isdragging :boolean;
    isconnecting:boolean;
    pointlabel :integer;
    grabpoint:Tpoint;
    connectpoint:Tpoint;
    temppoint:Tgraphpoint;
    tempcpoint:Tcontrolpoint;
    currgraphpoint:Tgraphpoint;
    currControlpoint:TControlpoint;
  public
    { Public declarations }
    procedure GraphPointMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure GraphPointMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure GraphPointDragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);
    procedure GraphPointDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure GraphPointMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure GraphPointDblClick(Sender: TObject);
    procedure GraphPointMouseEnter(Sender: TObject);
    procedure GraphPointMouseLeave(Sender: TObject);

    procedure ControlPointMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure ControlPointMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
    procedure ControlPointMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure ControlPointDblClick(Sender: TObject);
    procedure newGraph;
    procedure puthint(thecolor:Tcolor;thesize:integer;thehint:string);
  end;

var
  FindForm: TFindForm;
  bitmaps:array[1..24] of Tbitmap;
  readybitmap,findbitmap,notfindbitmap:Tbitmap;
  dlmapbitmap:Tbitmap;
  dlanibitmaps:array[1..3] of Tbitmap;
  dlanistrings:array[1..3] of string;
  dltourbitmaps:array[1..15] of Tbitmap;
  dltourStrings:array[1..15] of string;
  dalianframe:integer;
  bitmappath:string;
  frame:integer;
  framestep :integer;
  currButton:TMyButton;
  copybitmap:Tbitmap;
  theGlyphpos:Tpoint;

  VertexList:Tlist;
  EdgeList:Tlist;
  Controlpointlist:Tlist;

implementation

uses dalian;

{$R *.DFM}
function CreateBrushPattern(thecolor:Tcolor):Tbitmap;
var
  X, Y: Integer;
  pattern:Tbitmap;
begin
  pattern := TBitmap.Create;
  Pattern.Width := 8;
  Pattern.Height := 8;
  with Pattern.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := thecolor;
    FillRect(Rect(0, 0, Pattern.Width, Pattern.Height));
    for Y := 0 to 7 do
      for X := 0 to 7 do
        begin
          if (Y mod 2) = (X mod 2) then  { toggles between even/odd pixles }
             Pixels[X, Y] := clSilver;     { on even/odd rows }
        end;
  end;
  result := pattern;
end;

procedure loadDlbitmap;
begin
  dlmapbitmap := Tbitmap.create;
  dlmapbitmap.loadfromfile(bitmappath+'dalian.bmp');
  dlanibitmaps[1] := Tbitmap.create;
  dlanibitmaps[1].loadfromfile(bitmappath+'dlani1.bmp');
  dlanistrings[1] := '美哉大连，濒临黄海，风景秀丽，北有金州，西有旅顺，虎滩赶月，星海抱月，'+chr(13)+chr(10)+'足球田径，双璧生辉，世界看中国，中国看大连。';
  dlanibitmaps[2] := Tbitmap.create;
  dlanibitmaps[2].loadfromfile(bitmappath+'dlani2.bmp');
  dlanistrings[2] := '美哉大连，气候宜人，冬暖夏凉，商业发达，交通便利，广场绿地，鸽起鸽落，' + chr(13)+chr(10)+'高校云集，人才汇聚，开拓在中国，发展在大连。';
  dlanibitmaps[3] := Tbitmap.create;
  dlanibitmaps[3].loadfromfile(bitmappath+'dlani3.bmp');
  dltourbitmaps[1] := Tbitmap.create;
  dltourbitmaps[1].loadfromfile(bitmappath+'renmin.bmp');
  dltourStrings[1] := '人民广场';
  dltourbitmaps[2] := Tbitmap.create;
  dltourbitmaps[2].loadfromfile(bitmappath+'huizhan.bmp');
  dltourStrings[2] := '星海广场';

  dltourbitmaps[3] := Tbitmap.create;
  dltourbitmaps[3].loadfromfile(bitmappath+'xinghai.bmp');
  dltourStrings[3] := '星海公园';

  dltourbitmaps[4] := Tbitmap.create;
  dltourbitmaps[4].loadfromfile(bitmappath+'lushun.bmp');
  dltourStrings[4] := '旅顺口';

  dltourbitmaps[5] := Tbitmap.create;
  dltourbitmaps[5].loadfromfile(bitmappath+'youhao.bmp');
  dltourStrings[5] := '友好广场';

  dltourbitmaps[6] := Tbitmap.create;
  dltourbitmaps[6].loadfromfile(bitmappath+'Zhongshan.bmp');
  dltourStrings[6] := '中山广场';

  dltourbitmaps[7] := Tbitmap.create;
  dltourbitmaps[7].loadfromfile(bitmappath+'zoo.bmp');
  dltourStrings[7] := '大连森林动物园';

  dltourbitmaps[8] := Tbitmap.create;
  dltourbitmaps[8].loadfromfile(bitmappath+'laohutan.bmp');
  dltourStrings[8] := '虎滩乐园';

  dltourbitmaps[9] := Tbitmap.create;
  dltourbitmaps[9].loadfromfile(bitmappath+'Seayun.bmp');
  dltourStrings[9] := '海之韵广场';

  dltourbitmaps[10] := Tbitmap.create;
  dltourbitmaps[10].loadfromfile(bitmappath+'laodong.bmp');
  dltourStrings[10] := '劳动公园';

  dltourbitmaps[11] := Tbitmap.create;
  dltourbitmaps[11].loadfromfile(bitmappath+'Tower.bmp');
  dltourStrings[11] := '电视塔';

  dltourbitmaps[12] := Tbitmap.create;
  dltourbitmaps[12].loadfromfile(bitmappath+'yejing.bmp');
  dltourStrings[12] := '大连夜景';

  dltourbitmaps[13] := Tbitmap.create;
  dltourbitmaps[13].loadfromfile(bitmappath+'kaifa.bmp');
  dltourStrings[13] := '大连开发区';

  dltourbitmaps[14] := Tbitmap.create;
  dltourbitmaps[14].loadfromfile(bitmappath+'golf.bmp');
  dltourStrings[14] := '大连金石高尔夫球场';

  dltourbitmaps[15] := Tbitmap.create;
  dltourbitmaps[15].loadfromfile(bitmappath+'jinst.bmp');
  dltourStrings[15] := '金石滩奇石';

end;

procedure freeDlbitmap;
var i:integer;
begin
  dlmapbitmap.free;
  for i := 1 to 3 do dlanibitmaps[i].free;
  for i := 1 to 15 do dltourbitmaps[i].free;
  for i := 1 to 15 do dltourstrings[i] := '';
  for i := 1 to 3 do dlanistrings[i] := '';
end;

procedure TFindForm.puthint(thecolor:Tcolor;thesize:integer;thehint:string);
begin
  with hintlabel do
   begin
     font.color := thecolor;
     font.size := thesize;
     caption := thehint;
   end;
end;

procedure TFindForm.FormCreate(Sender: TObject);
var i:integer;
    thecolor:Tcolor;
    red:integer;

    readfilestream : TFilestream;
    reader : Treader;
    theVertexcount,theEdgecount:integer;
begin
  red := $FF;
  for i := 1 to 24 do
    begin
      thecolor := RGB(red,red,red);
      bitmaps[i] := CreateBrushPattern(thecolor);
      red := red - 4;
    end;

  vertexlist := Tlist.create;
  edgelist := Tlist.create;
  Controlpointlist := Tlist.create;
  pointlabel := 1;
  isconnecting := False;
  isdragging := False;
  isbegin :=true;
  isDalian := false;
  isEnter := false;
  isDblClick := false;
  bitmappath := ExtractFilePath(paramstr(0));
  readybitmap := Tbitmap.create;
  readybitmap.loadfromfile(bitmappath+'ready.bmp');
  findbitmap := Tbitmap.create;
  findbitmap.loadfromfile(bitmappath+'find.bmp');
  notfindbitmap := Tbitmap.create;
  notfindbitmap.loadfromfile(bitmappath+'notfind.bmp');
  isruning := false;
  findimage.canvas.draw(0,0,readybitmap);
  Screen.Cursors[1] := LoadCursorFromFile(pchar(bitmappath+'hand.cur'));

  puthint(clWhite,17,'欢迎来到图的世界 !');
  if fileexists(bitmappath+'hamilton.gph') then
     begin
        caption := '迷路的旅行推销员(发现哈密尔顿回路)/hamilton';
        readfilestream := TFilestream.create(bitmappath+'hamilton.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;
        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;

  application.helpfile := bitmappath + 'hcp.hlp';
end;

procedure TFindForm.buttonTimerTimer(Sender: TObject);
var i,j:integer;
begin
  with currButton.canvas do Brush.Bitmap := bitmaps[frame];
  BitBlt(currButton.canvas.handle,theGlyphpos.X,theGlyphpos.Y,copybitmap.width,copybitmap.height,copybitmap.canvas.handle,0,0,MERGECOPY);
  frame :=frame + framestep;
  if frame > 24 then
     begin
       framestep := -1;
       frame := 24;
     end;
  if frame < 1 then
     begin
       framestep := 1;
       frame := 1;
     end;
end;

procedure TFindForm.MyButtonMouseEnter(Sender: TObject);
begin
  currButton := TMyButton(Sender);
  theGlyphpos := point(2,2);
  copybitmap := Tbitmap.create;
  with copybitmap do
    begin
      width := currButton.width-4;
      height := currButton.height-4;
      canvas.copyRect(rect(0,0,width,height),currButton.Glyph.canvas,rect(0,0,width,height));
    end;
  buttonTimer.enabled := true;
  if currButton.down then
     frame := 1
  else
     frame := 16;
  framestep := -1;
end;

procedure TFindForm.MyButtonMouseLeave(Sender: TObject);
begin
  Buttontimer.enabled := False;
  copybitmap.free;
  currButton.Invalidate;
end;

procedure TFindForm.MyButtonClick(Sender: TObject);
begin
  if currButton.down then
     frame := 1
  else
     frame := 16;
  framestep := -1;
end;

procedure TFindForm.GraphPointMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if isDblClick then
     begin
       isDblClick := false;
       exit;
     end;
  if ssleft in shift then
     begin
      if (ssCtrl in Shift) or linebutton.down then
         begin
           isconnecting := True;
           Tgraphpoint(Sender).begindrag(False);
           Tgraphpoint(Sender).dragcursor := crDefault ;
           canvas.pen.color := clBlack;
           Canvas.pen.mode := pmNotXor;
           connectpoint := Tgraphpoint(Sender).centerpoint;
           canvas.polyline([Tgraphpoint(Sender).centerpoint,connectpoint]);
         end
      else
         begin
           grabpoint.X := X;
           grabpoint.Y := Y;