Namiary na kod:
<url>www.kryczka.skip.pl/programy/programik.zip</url>
a kod podam poniżej. Zmieniłem:
procedure TGraphForm.FormCreate(Sender: TObject);
begin
GraphControl := TGraphControl.Create(GraphPanel);
GraphControl.Parent := GraphPanel;
GraphControl.OnClick := GraphPanelClick;
end;
na coś takiego:
procedure TGraphForm.FormCreate(Sender: TObject);
begin
GraphControl := TGraphControl.Create(form1);
GraphControl.Parent := form1;
GraphControl.OnClick := GraphPanelClick;
end;</
ale nie pomogło.
A oto cały kod:
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 > 2Pi do
angle := angle-2Pi;
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.0cos(anglea)), Round(midY+10.0sin(anglea)));
Canvas.MoveTo(midX, midY);
Canvas.LineTo(Round(midX+10.0cos(angleb)), Round(midY+10.0sin(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.