Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
22
Добавлен:
28.06.2014
Размер:
20 Кб
Скачать
unit UUnit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, Grids, Spin, Udeterminant, URoute, UType,
  SkinTabs, SkinGrids, SkinBoxCtrls, SkinCtrls, SkinData,
  DynamicSkinForm, SkinExCtrls,  Mask, UGraph, math, spDialogs,
  spColorCtrls, spSkinShellCtrls;

type
  TForm1 = class(TForm)
    spSkinPageControl1: TspSkinPageControl;
    spSkinLabel1: TspSkinLabel;
    BtnDraw: TspSkinButton;
    spSkinTabSheet2: TspSkinTabSheet;
    ChkOrgraph: TspSkinCheckRadioBox;
    Tab1: TspSkinTabSheet;
    SGSm: TspSkinStringGrid;
    spSkinLabel2: TspSkinLabel;
    SgIn: TspSkinStringGrid;
    spSkinLabel3: TspSkinLabel;
    spSkinListBox2: TspSkinListBox;
    Sgsys: TspSkinStringGrid;
    spSkinLabel4: TspSkinLabel;
    spSkinLabel5: TspSkinLabel;
    BtnStartSearchRoute: TspSkinButton;
    SGE: TspSkinStringGrid;
    spDynamicSkinForm1: TspDynamicSkinForm;
    spSkinData1: TspSkinData;
    spCompressedStoredSkin1: TspCompressedStoredSkin;
    imgGraph: TImage;
    edtKolV: TspSkinNumericEdit;
    NptVes: TspSkinInputDialog;
    ChkVzves: TspSkinCheckRadioBox;
    edtkole: TspSkinNumericEdit;
    spSkinLabel6: TspSkinLabel;
    spSkinTabSheet1: TspSkinTabSheet;
    spSkinLabel7: TspSkinLabel;
    spSkinLabel8: TspSkinLabel;
    EdtRad: TspSkinSpinEdit;
    EdtDelta: TspSkinSpinEdit;
    spSkinLabel9: TspSkinLabel;
    spSkinLabel10: TspSkinLabel;
    spSkinLabel11: TspSkinLabel;
    spSkinLabel12: TspSkinLabel;
    spSkinLabel13: TspSkinLabel;
    spSkinLabel14: TspSkinLabel;
    btnColorV: TspSkinColorButton;
    btnMoveV: TspSkinColorButton;
    btnDragV: TspSkinColorButton;
    btncolorNA: TspSkinColorButton;
    btncolorE: TspSkinColorButton;
    btnmoveE: TspSkinColorButton;
    spSkinLabel15: TspSkinLabel;
    btncolorRect: TspSkinColorButton;
    edtFileOptions: TspSkinFileEdit;
    spSkinCheckRadioBox1: TspSkinCheckRadioBox;
    chkOptVes: TspSkinCheckRadioBox;
    spSkinCheckRadioBox2: TspSkinCheckRadioBox;
    btncolorDelv: TspSkinColorButton;
    spSkinLabel16: TspSkinLabel;
    btncolordelE: TspSkinColorButton;
    spSkinLabel17: TspSkinLabel;
    procedure FormCreate(Sender: TObject);
    procedure ImgGraphClick(Sender: TObject);
    procedure ImgGraphMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImgGraphMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImgGraphMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure redraw(g: TGraph);
    procedure ChkOrgraphClick(Sender: TObject);
    procedure ChkVzvesClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  flagMove: boolean;
  flagg: boolean;
  g: Tgraph;
  procedure drawstr(canv:tcanvas;x1,y1,x2,y2:real; tru: boolean);
procedure Matrix(g: tgraph);


implementation

{$R *.dfm}
  {
procedure TForm1.btnRouteClick(Sender: TObject);
var
i: integer;
  arr: array[1..30] of integer;
begin
 //Поиск путей и маршрутов
  if btnRoute.Caption = 'Найти маршруты' then begin
    RichEdit1.Clear;
    label3.Caption:='Маршруты';
    btnRoute.Caption := 'Остановить';
    for i := 1 to g.Vcount do begin
      arr[1]:=i;
      Route(g, SpinEdit1.Value, RichEdit1.Lines, CheckBox2.Checked);
    end;
    label3.Caption:=label3.Caption+' ('+ inttostr(RichEdit1.Lines.Count)+')';
  //Конец
    btnRoute.Caption:='Найти маршруты';
  end else
    btnRoute.Caption:='Найти маршруты';
end;

procedure TForm1.BtnStartClick(Sender: TObject);
var i, p, q: integer;
begin
  img1.Enabled:=true;
  try
    G.Vcount:=edtkol.value;
  except
  end;
  for i := 1 to G.Vcount do begin
    G.V[i].x:=round(cos(2*PI*i/edtkol.Value)*100)+150;
    G.V[i].y:=round(sin(2*PI*i/edtkol.Value)*100)+150;
    G.V[i].status:=clBlack;
  end;
  G.Ecount:=0;
  for I := 0 to richver.Lines.Count - 1 do begin
    richver.Lines.Strings[i]:=' '+richver.Lines.Strings[i];
    richver.Lines.Strings[i]:=copy(richver.Lines.Strings[i], pos(') ', richver.Lines.Strings[i])+2, maxint);
    p:=strtoint(copy(richver.Lines.Strings[i], 0, pos(' ', richver.Lines.Strings[i])-1));
    q:=strtoint(copy(richver.Lines.Strings[i], pos(' ', richver.Lines.Strings[i])+1, maxint));
    if (p <= G.Vcount) and (q <=  G.Vcount) then begin
      G.Ecount:=G.Ecount+1;
      G.E[G.Ecount].p1:=p;
      G.e[G.Ecount].p2:=q;
      richver.Lines.Strings[i]:='e'+inttostr(G.Ecount) + ') '+richver.Lines.Strings[i];
    end;
  end;
  G.Orgraph:=RadioButton1.checked;

  redraw;

end;

procedure TForm1.Button1Click(Sender: TObject);
var arr: Tarray;
i, j: integer;
arrOst: array[1..100] of boolean;
arrReb: array[1..100] of boolean;
  procedure SearchOstov(arrost: array of boolean;arrreb: array of boolean);
  var i, j, p: integer;
  flag:boolean;
  str: string;
  begin
    flag:=false;
    for i := 1 to edtkol.value do
      if not arrost[i] then
        flag:=true;
    if flag then begin
      for I := 1 to edtkol.value do
        if not arrost[i] then
          for j := 1 to edtkol.value do
            if arrost[j] then
              for p := 1 to stringgrid2.ColCount-1 do
                if (stringgrid2.Cells[p, j] <> '0') and (stringgrid2.Cells[p, i] <> '0') then begin
                  arrreb[p]:=true;
                  arrost[i]:=true;
                  searchostov(arrost, arrreb);
                  arrreb[p]:=false;
                  arrost[i]:=false;
                  break;
                end
    end else begin
      str:='';
      j:=0;
      for p:= 1 to stringgrid2.ColCount - 2 do
        if arrreb[p] then begin
          str:=str+'e'+inttostr(p)+' ';
          j:=j+1;
        end;
      str:='{' + str + '';
     { flag:=true;
      for i := 0 to lstostov.Items.Count - 1 do
         if lstostov.Items.Strings[i] = str then
           flag:=false;
      if j <> edtkol.Value-1 then
        flag:=false;
      if flag then
        lstostov.Items.Add(str);
    end;
  end;

begin
  lstostov.Clear;
  edtOstov.Text:='';
  stringgridm.colcount:=strtoint(edtkol.Text)+1;
  stringgridm.rowcount:=strtoint(edtkol.Text)+1;
  stringgridm.FixedCols:=1;
  stringgridm.FixedRows:=1;
  for i := 1 to stringgrid1.colcount -1 do begin
    StringGridm.Cells[0, i]:='v'+inttostr(i);
    StringGridm.Cells[i, 0]:='v'+inttostr(i);
  end;

  for i := 1 to edtkol.Value do
    for j:=1 to edtkol.Value do begin
      if i=j then
        arr[i, j]:= strtoint(StringGrid1.Cells[StringGrid1.ColCount-1, i])
      else
        arr[i, j]:=-strtoint(stringgrid1.cells[i, j]);
      stringgridm.Cells[i, j]:=inttostr(arr[i, j]);
    end;
//Построение матрицы
  edtOstov.Text:=inttostr(determinant(arr, edtkol.Value-1));

  for I := 1 to richver.Lines.Count do
    arrreb[i]:=false;
  arrost[1]:=true;
  for I := 2 to edtkol.value do
    arrost[i]:=false;
  searchostov(arrost, arrreb);
end;



procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
Var
  StringGrid: TStringGrid;
  Can: TCanvas;
begin
  StringGrid := Sender as TStringGrid;
  Can := StringGrid.Canvas;
  Can.Font := StringGrid.Font;
  if (ARow >= StringGrid.FixedRows) and (ACol >= StringGrid.FixedCols)
   then Can.Brush.Color := StringGrid.Color
   else Can.Brush.Color := StringGrid.FixedColor;
  If ActiveControl = Sender then // Эта строка "выключает" выделение
  if (gdSelected in State) then
  begin
    Can.Font.Color := clHighlightText;
    Can.Brush.Color := clHighlight;
  end;
  Can.FillRect(Rect);
  Can.TextOut(Rect.Left+2,Rect.Top+2, StringGrid.Cells[ACol, ARow]);
end;


procedure TForm1.img1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i: integer;
begin
for I := 1 to G.Vcount do
  if sqr(x-G.V[i].x)+sqr(y-G.V[i].y) < 100  then
    G.V[i].status:=clred
  else
    G.V[i].status:=clBlack;
  redraw;
end;

procedure TForm1.img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var i, j: integer;
  flag: boolean;
begin
  flag:=true;
  for I := 1 to G.Vcount do
    if G.V[i].status=clred  then begin
      for j := 1 to G.Vcount do
        if i <> j then
          if sqr(x-G.V[j].x)+sqr(y-G.V[j].y) < 200 then
            flag:=false;
      if flag then
        if (x <= 290) and (x >=10) and (y<=290) and (y >=10) then begin
          G.V[i].x:=x;
          G.V[i].y:=y;
          redraw;
        end;
    end else begin
      if sqr(x-G.V[i].x)+sqr(y-G.V[i].y) < 100 then begin
        G.V[i].status:=clGreen;
        redraw;
      end else
        if G.V[i].status=clGreen then  begin
          G.V[i].status:=clblack;
          redraw;
        end;
    end;
end;

procedure TForm1.img1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var i: integer;
begin
  for I := 1 to G.Vcount do
    G.V[i].status:=clblack;
  redraw;
end;

procedure drawstr(canv:tcanvas;x1,y1,x2,y2:real; tru: boolean);
var x3,x4,y3,y4:real; x5,y5,ox,oy:real;
begin

if (x1<>x2)or(y1<>y2)then begin
x5:=abs(((x2-x1)*10/sqrt(sqr(x2-x1)+sqr(y2-y1)))-x2);
y5:=abs(((y2-y1)*10/sqrt(sqr(x2-x1)+sqr(y2-y1)))-y2);
ox:=(x2-(x2-x5));
oy:=(y2-(y2-y5));
x3:=(ox-(y2-y5)/5);
y3:=(oy+(x2-x5)/5);
x4:=(ox+(y2-y5)/5);
y4:=(oy-(x2-x5)/5);
canv.Pen.Width:=1;
canv.Pen.Style:=psSolid;
canv.Pen.Color:=clBlack;
with canv do begin
moveto(round(x1),round(y1));
LineTo(round(x2),round(y2));
if tru then begin
canv.Pen.Width:=2;
LineTo(round(x3),round(y3));
moveto(round(x2),round(y2));
lineto(round(x4),round(y4));
canv.Pen.Width:=1;
end;
end;end;
end;

procedure Tform1.redraw;
var i, p, q: integer;
x1, x2, y1, y2: integer;
xt1, yt1,xt2, yt2: real;
begin
  img1.Picture:=nil;
  stringgrid1.colcount:=G.Vcount+2;
  stringgrid1.rowcount:=G.Vcount+1;
  stringgrid2.rowcount:=G.Vcount+1;
  stringgrid2.colcount:=G.Ecount+1;
  stringgrid1.FixedCols:=1;
  stringgrid1.FixedRows:=1;
  stringgrid2.FixedRows:=1;
  try
    stringgrid2.Fixedcols:=1;
  except
  end;
  for p := 1 to stringgrid1.colcount -2 do begin
    StringGrid1.Cells[0, p]:='v'+inttostr(p);
    StringGrid1.Cells[p, 0]:='v'+inttostr(p);
    StringGrid2.Cells[0, p]:='v'+inttostr(p);
  end;
  StringGrid1.Cells[ stringgrid1.colcount -1, 0]:='deg';
  StringGrid1.ColWidths[stringgrid1.colcount -1]:=20;
  for p := 1 to stringgrid2.colcount  do
    StringGrid2.Cells[p, 0]:='e'+inttostr(p);

  for p := 1 to stringgrid1.colcount  do
    for q := 1 to stringgrid1.rowcount  do
      StringGrid1.Cells[p, q]:='0';
  for p := 1 to stringgrid2.colcount  do
    for q := 1 to stringgrid2.rowcount  do
      StringGrid2.Cells[p, q]:='0';

  for i := 1 to G.ecount  do
    if not G.Orgraph then begin
      StringGrid1.Cells[G.E[i].p2, G.E[i].p1]:=inttostr(strtoint(StringGrid1.Cells[G.E[i].p2, G.E[i].p1])+1);
      StringGrid2.Cells[i+1, G.E[i].p1]:='1';
      StringGrid1.Cells[G.E[i].p1, G.E[i].p2]:=StringGrid1.Cells[G.E[i].p2, G.E[i].p1];
      StringGrid2.Cells[i+1, G.E[i].p2]:='1';
    end else begin
      StringGrid1.Cells[G.E[i].p2, G.E[i].p1]:=inttostr(strtoint(StringGrid1.Cells[G.E[i].p2, G.E[i].p1])+1);
      StringGrid2.Cells[i+1, G.E[i].p1]:='1';
      StringGrid2.Cells[i+1, G.E[i].p2]:='-1';
    end;
  for q := 1 to G.Vcount  do
    for p := 1 to G.Vcount do
      if StringGrid1.Cells[q, p]<>'0' then
        StringGrid1.Cells[stringgrid1.colcount-1, q]:=inttostr(strtoint(StringGrid1.Cells[stringgrid1.colcount-1, q])+1);
//Отрисовка
  //Вершин
  for I := 1 to G.Vcount do begin
    img1.Canvas.pen.Color:=G.V[i].status;
    img1.Canvas.Ellipse(G.V[i].x-8, G.V[i].y-8, G.V[i].x+8, G.V[i].y+8);
    img1.Canvas.TextOut(G.V[i].x-2,G.V[i].y-7,inttostr(i));
  end;
  //Ребер
   for i := 1 to G.Ecount  do begin
    x1:=G.V[G.E[i].p1].x;
    y1:=G.V[G.E[i].p1].y;
    x2:=G.V[G.E[i].p2].x;
    y2:=G.V[G.E[i].p2].y;
//    showmessage(inttostr(G.E[i].p1)+' '+inttostr(G.E[i].p2));
    xt1:=10*(x2-x1)/sqrt(sqr(x1-x2)+sqr(y1-y2)) +x1 ;
    yt1:= 10*(y2-y1)/sqrt(sqr(x1-x2)+sqr(y1-y2)) +y1;
    xt2:=10*(x1-x2)/sqrt(sqr(x1-x2)+sqr(y1-y2)) +x2;
    yt2:=10*(y1-y2)/sqrt(sqr(x1-x2)+sqr(y1-y2)) +y2;
    if not G.Orgraph then
      drawstr(img1.Canvas,xt1,yt1, xt2, yt2, false)
    else
      drawstr(img1.Canvas, 10*(x2-x1)/sqrt(sqr(x1-x2)+sqr(y1-y2)) +x1, 10*(y2-y1)/sqrt(sqr(x1-x2)+sqr(y1-y2)) +y1, 10*(x1-x2)/sqrt(sqr(x1-x2)+sqr(y1-y2)) +x2, 10*(y1-y2)/sqrt(sqr(x1-x2)+sqr(y1-y2)) +y2, true);
  end;
end;

    }

procedure TForm1.ChkOrgraphClick(Sender: TObject);
begin
G.Orgraph:=ChkOrgraph.Checked;
end;

procedure TForm1.ChkVzvesClick(Sender: TObject);
begin
G.Vzves:=ChkVzves.Checked;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ImgGraph.Repaint;
  imgGraph.Canvas.Rectangle(0,0,imgGraph.Width, imggraph.Height);
{SGEExit(sgsys);
SGEExit(SGSm);
SGEExit(sgin);
SGEExit(SGE);
sgE.Cells[0,0]:='№';
sgE.Cells[1,0]:='V1';
sgE.Cells[2,0]:='V2';
sgE.Cells[3,0]:='Вес';       }
setlength(g.V, 1);
setlength(g.e, 1);
g.e[0].ves:=0;

end;

procedure TForm1.ImgGraphClick(Sender: TObject);
begin
showmessage('1');
end;


procedure TForm1.ImgGraphMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var res: arrmouse;
begin
  if Button = mbLeft then begin
    res:=Mouse(g, x, y);
    case res[1] of
      1: g.V[res[2]].status:=clPurple; //Нажали по вершине
    end;
  end else if Button = mbRight then begin
    res:=Mouse(g, x, y);
    case res[1] of
      1: begin
        g.V[res[2]].status:=clred; //Нажали по вершине
        g.V[0].x:=g.V[res[2]].x;
        g.V[0].y:=g.V[res[2]].y;
        g.E[0].ves:=1;
        g.E[0].p1:=res[2];
      end;
      2: g.e[res[2]].status:=clred;
      end;
    end;
  redraw(g);
end;

procedure TForm1.ImgGraphMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var res: arrmouse;
  i: integer;
begin
  if g.E[0].ves = 1 then begin
    g.V[0].x:=x;
    g.V[0].y:=y;
  end;
  for i := 1 to high(g.v) do
    if g.V[i].status = clpurple then begin
      g.V[i].x:=x;
      g.V[i].y:=y;
    end;
  res:=Mouse(g, x, y);
  case res[1] of
    0: begin
      for i := 1 to high(g.E) do
         g.E[i].status:=clblack;
      for i := 1 to high(g.v) do
         g.v[i].status:=clblack;
      end;
    1:
      if g.V[res[2]].status<>clpurple then
        g.V[res[2]].status:=clgreen; //Нажали по вершине
    2: begin
    //  showmessage(inttostr(res[2]));
      //for i := 1 to min(res[2]-1, high(g.E)) do
        //g.E[i].status:=clblack;
      for i := 1 to high(g.E) do
        g.E[i].status:=clblack;
      g.e[res[2]].status:=clred;
    end;
  end;
  redraw(g);
end;

procedure TForm1.ImgGraphMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
res: arrmouse;
begin
  if Button = mbLeft then begin
    res:=mouse(g, x, y);
    case res[1] of
      0: edtkolV.Value:=createv(g, x, y);
      1: g.V[res[2]].status:=clgreen;
      2:
        if g.Vzves then
          try
            g.E[res[2]].ves:=strtoint(NptVes.InputBox('Введите вес', 'Вес для ребра e' + inttostr(res[2])+':', inttostr(g.E[res[2]].ves)));
          except
            g.E[res[2]].ves:=0;
          end;
    end;
  end else if Button = mbRight then begin
    res:=mouse(g, x, y);
    case res[1] of
    1: begin
      if g.V[res[2]].status=clred then
        deletev(g, res[2])
      else if g.E[0].ves = 1 then begin
        g.E[0].ves := 0;
        if res[2]<>g.E[0].p1 then begin
          createe(g, G.E[0].p1,res[2]);
         end else
          deletev(g, res[2]);
      end
    end;
    2: begin
         deletee(g, res[2]);
    end;
    end;
  end;
         g.E[0].ves := 0;

  edtkolv.value:=high(g.V);
  edtkolE.value:=high(g.E);
  redraw(g);
  matrix(g);
end;


procedure TForm1.redraw(g: TGraph);
var i: integer;
xt1, yt1,  xt2, yt2: real;
str: string;
begin
  ImgGraph.Repaint;
  ImgGraph.Canvas.Pen.Color:=clblack;

  imgGraph.Canvas.Rectangle(0,0,imgGraph.Width, imggraph.Height);
  for I := 1 to high(g.V) do begin
    ImgGraph.Canvas.Pen.Color:=g.V[i].status;
    ImgGraph.Canvas.Ellipse(g.v[i].x-rad, g.v[i].y-rad, g.v[i].x+rad, g.v[i].y+rad);
    ImgGraph.Canvas.Pen.Color:=clBlack;
    ImgGraph.Canvas.TextOut(g.V[i].x-2, g.V[i].y-7, inttostr(i));
  end;
  if g.e[0].ves = 1 then begin
    imgGraph.Canvas.Pen.Color:=g.e[0].status;
    drawstr(imgGraph.Canvas, g.V[g.E[0].p1].X, g.V[g.E[0].p1].y, g.V[0].x, g.V[0].y, g.Orgraph);
  end;
  for i := 1 to high(g.E) do begin
    imgGraph.Canvas.Pen.Color:=g.e[i].status;
    xt1:=rad*(g.V[g.E[i].p2].x-g.V[g.E[i].p1].x)/sqrt(sqr(g.V[g.E[i].p1].x-g.V[g.E[i].p2].x)+sqr(g.V[g.E[i].p1].y-g.V[g.E[i].p2].y)) +g.V[g.E[i].p1].x ;
    yt1:= rad*(g.V[g.E[i].p2].y-g.V[g.E[i].p1].y)/sqrt(sqr(g.V[g.E[i].p1].x-g.V[g.E[i].p2].x)+sqr(g.V[g.E[i].p1].y-g.V[g.E[i].p2].y)) +g.V[g.E[i].p1].y;
    xt2:=rad*(g.V[g.E[i].p1].x-g.V[g.E[i].p2].x)/sqrt(sqr(g.V[g.E[i].p1].x-g.V[g.E[i].p2].x)+sqr(g.V[g.E[i].p1].y-g.V[g.E[i].p2].y)) +g.V[g.E[i].p2].x;
    yt2:=rad*(g.V[g.E[i].p1].y-g.V[g.E[i].p2].y)/sqrt(sqr(g.V[g.E[i].p1].x-g.V[g.E[i].p2].x)+sqr(g.V[g.E[i].p1].y-g.V[g.E[i].p2].y)) +g.V[g.E[i].p2].y;
    drawstr(imgGraph.Canvas, xt1, yt1, xt2, yt2, g.Orgraph);
    str:='e'+inttostr(i);
    if g.Vzves then
      str:=str+' '+inttostr(g.E[i].ves);
    ImgGraph.Canvas.Pen.Color:= g.e[i].status;
    ImgGraph.Canvas.TextOut(round((g.V[g.E[i].p1].X+g.V[g.E[i].p2].X)/2)-2, round((g.V[g.E[i].p1].y+g.V[g.E[i].p2].y)/2)-7, str);
  end;

end;

procedure drawstr(canv:tcanvas;x1,y1,x2,y2:real; tru: boolean);
var x3,x4,y3,y4:real; x5,y5,ox,oy:real;
begin
if (x1<>x2)or(y1<>y2)then begin
x5:=abs(((x2-x1)*rad/sqrt(sqr(x2-x1)+sqr(y2-y1)))-x2);
y5:=abs(((y2-y1)*rad/sqrt(sqr(x2-x1)+sqr(y2-y1)))-y2);
ox:=(x2-(x2-x5));
oy:=(y2-(y2-y5));
x3:=(ox-(y2-y5)/5);
y3:=(oy+(x2-x5)/5);
x4:=(ox+(y2-y5)/5);
y4:=(oy-(x2-x5)/5);
canv.Pen.Width:=1;
//canv.Pen.Style:=psSolid;
with canv do begin
moveto(round(x1),round(y1));
LineTo(round(x2),round(y2));
if tru then begin
canv.Pen.Width:=2;
LineTo(round(x3),round(y3));
moveto(round(x2),round(y2));
lineto(round(x4),round(y4));
canv.Pen.Width:=1;
end;
end;end;
end;

procedure Matrix(g: tgraph);
var i, j: integer;
begin
  with form1.sgsm do begin
    colcount:=high(g.V)+2;
    rowcount:=high(g.V)+1;
    FixedCols:=1;
    fixedrows:=1;
    for i := 1 to colcount-2 do begin
      for j := 1 to colcount - 1 do
        Cells[i, j]:='0';
      Cells[i, 0]:='v'+inttostr(i);
      Cells[0, i]:='v'+inttostr(i);
    end;
    for j := 1 to colcount - 1 do
      Cells[colcount-1, j]:='0';
    Cells[colcount-1, 0]:='deg';
    if g.Orgraph then
      for i := 1 to high(g.E) do begin
        Cells[g.e[i].p1, g.E[i].p2]:='1';
        Cells[colcount-1, g.E[i].p2]:=inttostr(strtoint(Cells[colcount-1, g.E[i].p2])+1);
      end
    else
      for i := 1 to high(g.E) do begin
        Cells[g.e[i].p1, g.E[i].p2]:='1';
        Cells[g.e[i].p2, g.E[i].p1]:='1';
        Cells[colcount-1, g.E[i].p2]:=inttostr(strtoint(Cells[colcount-1, g.E[i].p2])+1);
        Cells[colcount-1, g.E[i].p1]:=inttostr(strtoint(Cells[colcount-1, g.E[i].p1])+1);
      end;
  end;
 { with form1.SgIn do begin
    try
      rowcount:=high(g.V)+1;
      fixedrows:=1;
      colcount:=high(g.e)+1;
      FixedCols:=1;
      for i := 1 to colcount-1 do
        Cells[i, 0]:='e'+inttostr(i);
    except
      rowcount:=high(g.V)+2;
      fixedrows:=1;
      colcount:=high(g.e)+2;
      FixedCols:=1;
    end;
    for i := 1 to high(g.v) do begin
      Cells[0, i]:='v'+inttostr(i);
      for j := 1 to high(g.E) do begin
        cells[j, i]:='0';
        cells[j, g.E[j].p1]:='1';
        cells[j, g.E[j].p2]:='1';
      end;
    end;
  end;
end;}
end;


end.
Соседние файлы в папке Программа для построения и анализа графов