⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ve.pas

📁 图论算法
💻 PAS
字号:
unit VE;

interface
uses Messages, Windows, SysUtils, Classes,Dialogs,Controls, Forms, Menus,
     Graphics,grapoint,anyline,ctlpoint;

type
  TEdge = class;
  TVertex = class
    PointControl:TGraphPoint;

    NeighbourVertex:Tlist;
    NeighbourEdge  :Tlist;
    owner : Tform;
    considervisible:boolean;
    isVirtual:boolean;
    isDelete:boolean;
    ConnectiveDegree:integer; //when isDelete is true , <=2

    constructor Create(theOwner:Tform;theleft,thetop:integer;thelabel:integer);
    destructor Destroy;override;

    function isNeighbourVertex(p:Tvertex):Boolean;
    function isNeighbourEdge(p:TEdge):Boolean;
    function isConsiderVisibleNV(p:Tvertex):boolean;
    function getConsiderVisibleNE(p:TVertex):Tedge;
    function NEConsiderVisible(theindex:integer):boolean;
    function NEHignlightlook(theindex:integer):boolean;

//    procedure setNeighbourVertex(p:Tvertex);
    function getlabelno:integer;
    function getNeighbourcount:integer;
    function getNeighbourVertex(theindex:integer):Tvertex;
    function getNeighbourEdge(theindex:integer):TEdge;
    function visibleNeighbourcount:integer;
//    function NV(theindex:integer):Tvertex;
//    function NE(theindex:integer):TEdge;

    property labelno:integer read getlabelno;
    property Neighbourcount:integer read getNeighbourcount;
    property NV[index:integer]:Tvertex read getNeighbourVertex;
    property NE[index:integer]:TEdge   read getNeighbourEdge;

    procedure removeNeighbourVertex(p:Tvertex);
    procedure load(reader:Treader);
    procedure save(writer:Twriter);
  end;

  TEdge = class
    edgecontrol:Tanyline;
    owner : Tform;

    XVertex,YVertex:TVertex;
    Controlpointpos:array[1..6] of Tpoint;
    ControlpointNum:integer;

    Considervisible:boolean;
    highlightlook:boolean;
    isCurve:Boolean;

    constructor Create(theOwner:Tform;theXvertex,theYvertex:TVertex); //edgecontrol created in it
    destructor Destroy; override;

    procedure redraw;
    procedure drawControlPoint;
    function addControlPoint:boolean;
    procedure restoretoLine;
    procedure colorwidth(thecolor:Tcolor;theWidth:integer);

    procedure load(reader:Treader);
    procedure save(writer:Twriter);
  end;

implementation
uses FForm;

constructor TVertex.Create(theOwner:Tform;theleft,thetop:integer;thelabel:integer);
begin
  owner := theowner;
  considervisible := true;
  isVirtual := false;
  isDelete := false;
  if owner <> nil then
  begin
  PointControl := TGraphPoint.create(Owner);
  PointControl.parent := Owner;
  PointControl.left := theleft;
  PointControl.top  := thetop;
  PointControl.pointlabel := thelabel;
  PointControl.vertex := self;

  PointControl.onMousedown := TFindForm(Owner).GraphPointMouseDown;
  PointControl.onMouseMove := TFindForm(Owner).GraphPointMouseMove;
  PointControl.onMouseUp := TFindForm(Owner).GraphPointMouseUp;
  PointControl.onDragOver := TFindForm(Owner).GraphPointDragover;
  PointControl.onDragDrop := TFindForm(Owner).GraphPointDragDrop;
  PointControl.PopupMenu := TFindForm(Owner).GraphPointPopupmenu;

  PointControl.bringtofront;
  end
  else isVirtual := true;

  NeighbourVertex := Tlist.create;
  NeighbourEdge   := Tlist.create;

//pointControl create

end;

destructor TVertex.Destroy;
begin
  if owner <> nil then
     pointControl.free;
  NeighbourVertex.free;
  NeighbourEdge.free;
end;

function TVertex.isNeighbourVertex(p:Tvertex):Boolean;
begin
  if NeighbourVertex.indexof(p) = -1 then result := False else result := True;
end;

function TVertex.isNeighbourEdge(p:TEdge):Boolean;
begin
  if NeighbourEdge.indexof(p) = -1 then result := False else result := True;
end;

function TVertex.isConsiderVisibleNV(p:Tvertex):boolean;
var pindex:integer;
begin
  result := false;
  pindex := NeighbourVertex.indexof(p) ;
  if (pindex > -1 ) and TEdge(NeighbourEdge[pindex]).Considervisible then
     result := true;
end;

function TVertex.NEConsiderVisible(theindex:integer):boolean;
begin
  result := NE[theindex].Considervisible;
end;

function TVertex.NEHignlightlook(theindex:integer):boolean;
begin
  result := NE[theindex].highlightlook;
end;

function TVertex.getNeighbourVertex(theindex:integer):Tvertex;
begin
  result := Tvertex(NeighbourVertex.items[theindex-1]);
end;

function TVertex.getNeighbourEdge(theindex:integer):TEdge;
begin
  result := TEdge(NeighbourEdge.items[theindex-1]);
end;

{
function TVertex.NE(theindex:integer):TEdge;
begin
  result := TEdge(NeighbourEdge.items[theindex-1]);
end;
}

function TVertex.getConsiderVisibleNE(p:TVertex):Tedge;
var pindex:integer;
begin
  result := nil;
  pindex := NeighbourVertex.indexof(p);
  if (pindex > -1 ) and TEdge(NeighbourEdge[pindex]).Considervisible then
     result := NeighbourEdge[pindex];
end;

function TVertex.getlabelno:integer;
begin
  result := PointControl.pointlabel;
end;

function TVertex.getNeighbourcount:integer;
begin
  result := NeighbourVertex.count;
end;

function TVertex.visibleNeighbourcount:integer; //if neighbour vertex is visible, not edge ,because some vertex have been delete temporarily
var i:integer;
begin
  result := NeighbourVertex.count;
  for i := 0 to NeighbourVertex.count -1 do
    if not Tvertex(NeighbourVertex[i]).considervisible then
       result := result - 1 ;
end ;

procedure TVertex.removeNeighbourVertex(p:Tvertex);
var pindex:integer;
begin
  pindex := NeighbourVertex.indexof(p);
  NeighbourVertex.delete(pindex);
  NeighbourEdge.delete(pindex);
  NeighbourVertex.pack;
  NeighbourEdge.pack;
end;

procedure TVertex.load(reader:Treader);
var i:integer;
    thevertexCount:integer;
    theindex:integer;
begin
  PointControl.left := reader.readinteger;
  PointControl.top  := reader.readinteger;
  PointControl.fillcolor := reader.readinteger;
  PointControl.pointlabel := reader.readinteger;
  thevertexCount := reader.readinteger;
  for i := 0 to theVertexCount - 1 do
    begin
      theindex := reader.readinteger;
      NeighbourVertex.add(VertexList.items[theindex]);
    end;
  for i := 0 to theVertexCount - 1 do
    begin
      theindex := reader.readinteger;
      NeighbourEdge.add(EdgeList.items[theindex]);
    end;
end;

procedure TVertex.save(writer:Twriter);
var i:integer;
begin
  writer.writeinteger(PointControl.left);
  writer.writeinteger(PointControl.top);
  writer.writeinteger(PointControl.fillcolor);
  writer.writeinteger(PointControl.pointlabel);
  writer.writeinteger(NeighbourVertex.count);
  for i := 0 to NeighbourVertex.count - 1 do
    writer.writeinteger(VertexList.indexof(NeighbourVertex.items[i]));
  for i := 0 to NeighbourEdge.count - 1 do
    writer.writeinteger(EdgeList.indexof(NeighbourEdge.items[i]));
end;


constructor TEdge.Create(theOwner:Tform;theXvertex,theYvertex:TVertex);
begin
    owner := theowner;
    if theXvertex = nil then exit;

    XVertex := theXvertex;
    YVertex := theYvertex;
    if owner <> nil then
    begin
    edgecontrol := Tanyline.create(Owner);
    edgecontrol.parent := Owner;
    edgecontrol.align := alClient;
    edgecontrol.drawby([XVertex.pointControl.Centerpoint,YVertex.pointControl.Centerpoint]);
    edgecontrol.Sendtoback;
    controlpointNum := 1;
    Controlpointpos[1] := edgecontrol.getmidpoint;
    end;
    Considervisible := True;
    highlightlook := False;
    isCurve := False;

    XVertex.NeighbourVertex.add(YVertex);
    YVertex.NeighbourVertex.add(XVertex);
    XVertex.NeighbourEdge.add(self);
    YVertex.NeighbourEdge.add(self);
end;

destructor  TEdge.Destroy;
begin
  if owner <> nil then
     edgecontrol.free;
end;

procedure TEdge.redraw;
var i,j:integer;
    thepoints:array[1..8] of Tpoint;
begin
  if not isCurve then
     begin
       edgecontrol.drawby([XVertex.pointControl.Centerpoint,YVertex.pointControl.Centerpoint]);
       Controlpointpos[1] := edgecontrol.getmidpoint;
       ControlpointNum:= 1;
     end
  else
     begin
       thepoints[1] := XVertex.pointControl.Centerpoint;
       j := 2;
       for i := 1 to ControlpointNum do
         begin
           thepoints[j] := Controlpointpos[i];
           inc(j);
         end;
       thepoints[j] := YVertex.pointControl.Centerpoint;
       edgecontrol.drawby(slice(thepoints,j));
     end;
end;

procedure TEdge.drawControlPoint;
var theControlpoint:TControlpoint;
    i:integer;
begin
  for i := 1 to ControlpointNum do
    begin
      thecontrolpoint := Tcontrolpoint.create(owner);
      thecontrolpoint.parent := owner;
      thecontrolpoint.left := controlpointpos[i].X - 3;
      thecontrolpoint.top  := controlpointpos[i].Y - 3;
      thecontrolpoint.controledge := self;
      thecontrolpoint.orderno := i;
      thecontrolpoint.onMousedown := TFindForm(Owner).controlpointMouseDown;
      thecontrolpoint.onMouseMove := TFindForm(Owner).controlpointMouseMove;
      thecontrolpoint.onMouseUp := TFindForm(Owner).controlpointMouseUp;
      thecontrolpoint.onDblClick := TFindForm(Owner).controlpointDblClick;
      thecontrolpoint.popupmenu := TFindForm(Owner).ControlpointPopupMenu;
      Controlpointlist.add(thecontrolpoint);
    end;
end;

function TEdge.addControlPoint:boolean;
var theControlpoint:Tcontrolpoint;
begin
  result := false;
  if ControlpointNum < 6 then
    begin
      inc(ControlpointNum);
      controlpointpos[ControlpointNum] := edgeControl.getmidpoint;
      thecontrolpoint := Tcontrolpoint.create(owner);
      thecontrolpoint.parent := owner;
      thecontrolpoint.left := controlpointpos[ControlpointNum].X - 3;
      thecontrolpoint.top  := controlpointpos[ControlpointNum].Y - 3;
      thecontrolpoint.controledge := self;
      thecontrolpoint.orderno := ControlpointNum;
      thecontrolpoint.onMousedown := TFindForm(Owner).controlpointMouseDown;
      thecontrolpoint.onMouseMove := TFindForm(Owner).controlpointMouseMove;
      thecontrolpoint.onMouseUp := TFindForm(Owner).controlpointMouseUp;
      thecontrolpoint.onDblClick := TFindForm(Owner).controlpointDblClick;
      thecontrolpoint.popupmenu := TFindForm(Owner).ControlpointPopupMenu;
      Controlpointlist.add(thecontrolpoint);
      result := true;
    end
  else
    showmessage('At most 6 control point!');
end;

procedure TEdge.restoretoLine;
begin
  iscurve := false;
  redraw;
end;

procedure TEdge.colorwidth(thecolor:Tcolor;theWidth:integer);
begin
  EdgeControl.LineWidth := thewidth ;
  EdgeControl.Color := thecolor;
end;

procedure TEdge.load(reader:Treader);
var theindex:integer;
    i :integer;
begin
  theindex := reader.readinteger;
  XVertex := Tvertex(VertexList.items[theindex]);
  theindex := reader.readinteger;
  YVertex := Tvertex(VertexList.items[theindex]);
  ControlpointNum := reader.readinteger;
  for i := 1 to ControlpointNum do
    begin
      Controlpointpos[i].X := reader.readinteger;
      Controlpointpos[i].Y := reader.readinteger;
    end;
  edgecontrol := Tanyline.create(Owner);
  edgecontrol.parent := Owner;
  edgecontrol.align := alClient;
  isCurve := reader.readboolean;
  edgecontrol.linewidth := reader.readinteger;
  edgecontrol.color := reader.readinteger;
  redraw;
  edgecontrol.Sendtoback;

  Considervisible := reader.readboolean;
  highlightlook := reader.readboolean;
end;

procedure TEdge.save(writer:Twriter);
var i:integer;
begin
  writer.writeinteger(VertexList.indexof(XVertex));
  writer.writeinteger(VertexList.indexof(YVertex));
  writer.writeinteger(ControlpointNum);
  for i := 1 to ControlpointNum do
    begin
      writer.writeinteger(Controlpointpos[i].X);
      writer.writeinteger(Controlpointpos[i].Y);
    end;
  writer.writeboolean(isCurve);
  writer.writeinteger(edgecontrol.linewidth);
  writer.writeinteger(edgecontrol.color);

  writer.writeboolean(Considervisible);
  writer.writeboolean(highlightlook);
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -