ugraphform.pas

8259中断程序。接口试验程序

{*****************************************************************************
 *
 *  uGraphForm.pas - Form to play with your graph
 *
 *  Copyright (c) 1999/2000 Diego Amicabile
 *
 *  Author:     Diego Amicabile
 *  E-mail:     [e-mail]
 *  Homepage:   http://www.geocities.com/diegoami
 *
 *  This program is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation;
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 *
 *----------------------------------------------------------------------------
 *
 *  Revision history:
 *
 *     DATE     REV                 DESCRIPTION
 *  ----------- --- ----------------------------------------------------------
 *
 *****************************************************************************}

unit uGraphForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, objGraph, StdCtrls, Menus;



type


  TGraphPoint = class(TGraphNode)
    X : integer;
    Y : integer;
    procedure Ellipse(Canvas : TCanvas; Color : TColor);
    procedure LineTo(Canvas : TCanvas; GraphPoint : TGraphPoint);
    function intersectsPoint(X,Y : integer) : Boolean;
    constructor Create(X,Y : Integer; Caption : String);
  end;

  TGraphControl = class(TCustomControl)
    Graph : TMathGraph;
    SelectedNode : TGraphPoint;
    SelectedEdge : TGraphEdge;
    SelectedPath : TEdgeList;
    function getIntersectingEdge(X, Y : integer) : TGraphEdge;
    function getIntersectingNode(X, Y : Integer) : TGraphPoint;
    constructor Create(AOwner : TComponent); override;
    procedure Paint; override;
    protected
      AdaptedEdges : Boolean;
    private
      procedure NewShape(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      procedure NodeMoved(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  end;

  TGraphForm = class(TForm)
    GraphPanel :TPanel;

    RightPanel: TPanel;
    Splitter: TSplitter;
    TopLeftPanel: TPanel;
    LeftSplitter: TSplitter;
    BottomLeftPanel: TPanel;
    Label1: TLabel;
    NodeCaptionLabel: TLabel;
    NodeCaptionEdit: TEdit;
    SelectedEdgelabel: TLabel;
    EdgeweightLabel: TLabel;
    WeightEdit: TEdit;
    MainMenu1: TMainMenu;
    FileMenuItem: TMenuItem;
    LoadMenuItem: TMenuItem;
    SaveMenuItem: TMenuItem;
    SaveDialog: TSaveDialog;
    OpenDialog: TOpenDialog;
    N1: TMenuItem;
    ExitMenuItem: TMenuItem;
    EditMenuItem: TMenuItem;
    DeleteEdgeMenuItem: TMenuItem;
    DeleteNodeMenuItem: TMenuItem;
    N2: TMenuItem;
    AdaptEdgesMenuItem: TMenuItem;
    Calculate1: TMenuItem;
    ShortestPathMenuItem: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure NodeCaptionEditChange(Sender: TObject);
    procedure GraphPanelClick(Sender: TObject);
    procedure WeightEditChange(Sender: TObject);
    procedure SaveMenuItemClick(Sender: TObject);
    procedure LoadMenuItemClick(Sender: TObject);
    procedure ExitMenuItemClick(Sender: TObject);
    procedure DeleteEdgeMenuItemClick(Sender: TObject);
    procedure DeleteNodeMenuItemClick(Sender: TObject);
    procedure AdaptEdgesMenuItemClick(Sender: TObject);
    procedure ShortestPathMenuItemClick(Sender: TObject);
    protected
      GraphControl : TGraphControl;
  end;

var
  GraphForm: TGraphForm;


implementation

{$R *.DFM}

uses ObjPerst;

function PointOnLine(PX, PY, SX, SY, DX, DY : real) : boolean;
var LS, RS : real;
begin
  LS := (PX-SX)*(DY-SY)/(DX-SX);
  RS := PY-SY;
  result := abs(RS-LS) < 6;
end;

procedure TGraphForm.FormCreate(Sender: TObject);
begin
  GraphControl := TGraphControl.Create(GraphPanel);
  GraphControl.Parent := GraphPanel;
  GraphControl.OnClick := GraphPanelClick;
end;


constructor TGraphPoint.Create(X,Y : Integer; Caption : String);
begin
  inherited Create(TStringObj.Create(Caption));
  Self.X := X;
  Self.Y := Y;
end;

procedure TGraphControl.NewShape(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var GraphPoint : TGraphPoint;

  WinParent : TWinControl;
begin

  GraphPoint := getIntersectingNode(X,Y);
  if GraphPoint = nil then begin
    SelectedEdge := getIntersectingEdge(X,Y);
    if SelectedPath <> nil then
      SelectedPath.Clear;
    SelectedNode := nil
  end;
  if (GraphPoint = nil) and (SelectedEdge = nil) then begin
    GraphPoint := TGraphPoint.Create(X,Y,'');
    Graph.NodeList.InsertAtTail(GraphPoint);
    SelectedNode := GraphPoint;
  end else if (GraphPoint <> nil) then begin
    if Button = mbLeft then
      if Cursor = crDefault then
        SelectedNode := GraphPoint
      else begin
        SelectedPath := Graph.GetShortestPath(SelectedNode, GraphPoint);
        Cursor := crDefault;
        SelectedEdge := nil;
      end
    else if (SelectedNode <> nil) and (SelectedNode <> GraphPoint) then
      Graph.EdgeList.Add(TGraphEdge.Create(SelectedNode,GraphPoint));

  end;

  Repaint;

  if Assigned(OnClick) then
    OnClick(Sender);
end;


constructor TGraphControl.Create(AOwner : TComponent);
begin
  inherited;
  AdaptedEdges := False;
  Graph := TMathGraph.Create;
  OnMouseDown := NewShape;
  OnMouseMove := NodeMoved;
  Align := alClient;
end;

function TGraphPoint.intersectsPoint(X,Y : Integer) : Boolean;
begin
  result := (abs(X-Self.X) < 20) and (abs(Y-Self.Y) < 20);
end;

procedure TGraphPoint.Ellipse(Canvas : TCanvas; Color : TColor);
begin
  Canvas.Brush.Color := Color;
  Canvas.Ellipse(X-10,Y-10,X+10,Y+10);
end;

procedure TGraphPoint.LineTo(Canvas : TCanvas; GraphPoint : TGraphPoint);
var disX, disY, angle,anglea, angleb : real;

  function getAngle(dX, dY : real) : real;
  begin
    if dY > 0 then
      if dX > 0 then
        result := arctan((-dY)/dX)
      else if dX < 0 then
        result := Pi+arctan(dY/(-dX))
      else result := Pi/2
    else
      if dX > 0 then
        result := arctan((-dY)/dX)
      else if dX < 0 then
        result := Pi-arctan(dY/dX)
      else result := -Pi/2
  end;


  var midX, midY : integer;
begin
  Canvas.MoveTo(X,Y);
  Canvas.LineTo(GraphPoint.X, GraphPoint.Y);

  disX := GraphPoint.X-X;
  disY := Y-GraphPoint.Y;

  angle := GetAngle(disX,disY)+Pi;
  while angle > 2*Pi do
    angle := angle-2*Pi;
  anglea := angle+0.3;
  angleb := angle-0.3;
  midX := (GraphPoint.X+X) div 2;
  midY := (GraphPoint.Y+Y) div 2;
  Canvas.MoveTo(midX, midY);
  { arrow }
  Canvas.LineTo(Round(midX+10.0*cos(anglea)), Round(midY+10.0*sin(anglea)));
  Canvas.MoveTo(midX, midY);
  Canvas.LineTo(Round(midX+10.0*cos(angleb)), Round(midY+10.0*sin(angleb)));
end;

function TGraphControl.getIntersectingNode(X, Y : integer) : TGraphPoint;
var i : integer;
  GraphPoint : TGraphPoint;
begin
  for i := 1 to Graph.Nodelist.Size do begin
    GraphPoint := TGraphPoint(Graph.NodeList.At[i]);
    if GraphPoint.intersectsPoint(X,Y) then begin
      result := GraphPoint;
      exit
    end
  end;
  result := nil;
end;

function TGraphControl.getIntersectingEdge(X, Y : integer) : TGraphEdge;
var i : integer;
  GraphEdge : TGraphEdge;
  FromPoint, ToPoint : TGraphPoint;

begin
  for i := 0 to Graph.Edgelist.Count-1 do begin
    GraphEdge := TGraphEdge(Graph.EdgeList.Items[i]);
    FromPoint := GraphEdge.FromNode As TGraphPoint;
    ToPoint := GraphEdge.ToNode As TGraphPoint;
    if PointOnLine(X,Y,FromPoint.X,FromPoint.Y,ToPoint.X, ToPoint.Y) and
      (SelectedNode = FromPoint) then begin
      result := GraphEdge;
      exit
    end
  end;
  result := nil;
end;


procedure TGraphControl.Paint;
var  GraphEdge : TGraphEdge;

  procedure PaintEdge(GraphEdge: TGraphEdge ; Color : TColor );
  var TP, FP : TGraphPoint;
  begin
    if AdaptedEdges then
      Canvas.Pen.Width := Round(GraphEdge.GetWeight);
    Canvas.Pen.Color := Color;
    TP := GraphEdge.ToNode As TGraphPoint;
    FP := GraphEdge.FromNode As TGraphPoint;
    FP.LineTo(Canvas, TP)

  end;
var i : integer;
  GraphPoint : TGraphPoint;

begin
  for i := 1 to Graph.Nodelist.Size do begin
    GraphPoint := TGraphPoint(Graph.NodeList.At[i]);
    if GraphPoint = SelectedNode then
      GraphPoint.Ellipse(Canvas, clBlack)
    else
      GraphPoint.Ellipse(Canvas, clWhite);

  end;
  Canvas.Pen.Width := 1;
  for i := 0 to Graph.EdgeList.Count-1 do begin
    GraphEdge := TGraphEdge(Graph.EdgeList.Items[i]);
    PaintEdge(GraphEdge,clBlack);
  end;
  if (SelectedPath <> nil) then
    for i := 0 to SelectedPath.Count-1 do begin
      GraphEdge := TGraphEdge(SelectedPath.Items[i]);
      PaintEdge(GraphEdge,clYellow);
    end;
  if SelectedEdge <> nil then
    PaintEdge(SelectedEdge,clRed);
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Width := 1;
end;

procedure TGraphForm.NodeCaptionEditChange(Sender: TObject);
begin
  if GraphControl.SelectedNode <> nil then
    TStringObj(GraphControl.SelectedNode.Obj).Str := NodeCaptionEdit.Text;
end;

procedure TGraphForm.GraphPanelClick(Sender: TObject);
begin
  with GraphControl do begin
    if SelectedNode <> nil then
      NodeCaptionEdit.Text := TStringObj(SelectedNode.Obj).Str;
    if SelectedEdge <> nil then
      WeightEdit.Text := FloatToStr(SelectedEdge.GetWeight);
  end;
end;

procedure TGraphForm.WeightEditChange(Sender: TObject);
begin
  if GraphControl.SelectedEdge <> nil then
    try
      GraphControl.SelectedEdge.Weight := StrToFloat(WeightEdit.Text);
      Repaint;
    except on EConvertError do end;
end;


procedure ReadGraphPoint(Obj    : TObject; Reader : TObjectReader );
var
    GraphPoint : TGraphPoint;
begin
  GraphPoint := Obj As TGraphPoint;
  GraphPoint.Obj := Reader.ReadChildObject;
  GraphPoint.X := Reader.ReadInteger;
  GraphPoint.Y := Reader.ReadInteger;
end;

procedure WriteGraphPoint(
    const Obj    : TObject;
    const Writer : TObjectWriter ); far;
var
    GraphPoint : TGraphPoint;
begin
    GraphPoint := Obj As TGraphPoint;
    Writer.WriteChildObject(GraphPoint.Obj);
    Writer.WriteInteger(GraphPoint.X);
    Writer.WriteInteger(GraphPoint.Y);
end;


procedure TGraphForm.SaveMenuItemClick(Sender: TObject);
var Graph : TMathGraph;
   Stream : TFileStream;
  FileName : String;
begin
  Graph := GraphControl.Graph;
  if SaveDialog.Execute then
    FileName := SaveDialog.FileName;
  WriteObjectToFile(Graph, FileName, true);
end;

procedure TGraphForm.LoadMenuItemClick(Sender: TObject);
var
  Stream : TFileStream;
  FileName : String;
begin

  if OpenDialog.Execute then
    FileName := OpenDialog.FileName;
  //Stream := TFileStream.Create(Filename,fmOpenRead);
  //Graph.GraphRead(TObjectReader.Create(TObjectStream.Create(Stream)));
  GraphControl.Graph := ReadObjectFromFile(FileName, true) As TMathGraph;
  GraphControl.Repaint;
end;

procedure TGraphForm.ExitMenuItemClick(Sender: TObject);
begin
  Close;
end;

procedure TGraphForm.DeleteEdgeMenuItemClick(Sender: TObject);
begin
  with GraphControl do begin
    if SelectedEdge <> nil then begin
      Graph.EdgeList.Remove(SelectedEdge);
      SelectedEdge.Destroy;
      SelectedEdge := nil;
      Repaint;
    end;
  end;
end;

procedure TGraphForm.DeleteNodeMenuItemClick(Sender: TObject);

begin
   with GraphControl do begin
     Graph.BindEdgesFromNode;
     if (SelectedNode <> nil) and ((SelectedNode.EdgesFrom = nil) or (SelectedNode.EdgesFrom.Count = 0)) 
       and not (Graph.isTo(SelectedNode)) then begin
       //SelectedNode.Ellipse(Canvas, clGray);
       Graph.NodeList.Delete(SelectedNode,1);
       SelectedNode := nil;
       Repaint;

     end;
   end;
end;

procedure TGraphForm.AdaptEdgesMenuItemClick(Sender: TObject);
begin
  GraphControl.AdaptedEdges := not GraphControl.AdaptedEdges;
  GraphControl.Repaint;
end;

procedure TGraphControl.NodeMoved(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if (SsLeft in Shift) and (SelectedNode <> nil) and (Cursor = crDefault) then begin
    SelectedNode.X := X;
    SelectedNode.Y := Y;
    Repaint
  end;
end;




procedure TGraphForm.ShortestPathMenuItemClick(Sender: TObject);
begin
  if GraphControl.SelectedNode <> nil then
    GraphControl.Cursor := crCross;
end;

initialization
RegisterStreamable(
    TGraphPoint,
    [TObjectReadProc(@ReadGraphPoint)],
    [TObjectWriteProc(@WriteGraphPoint)]
    );


end.