Advertisement
altervisi0n

Untitled

Jun 30th, 2023
97
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 19.38 KB | None | 0 0
  1. Unit Main;
  2.  
  3. Interface
  4.  
  5. Uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  7.   System.Classes, Vcl.Graphics,
  8.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.Menus, System.Actions,
  9.   Vcl.ActnList;
  10.  
  11. Type
  12.   TMainForm = Class(TForm)
  13.     MainGrid: TStringGrid;
  14.     MainMenu: TMainMenu;
  15.     ManageBtn: TMenuItem;
  16.     DrawBtn: TMenuItem;
  17.     MainActionList: TActionList;
  18.     AManageNodes: TAction;
  19.     AdjacencyListBtn: TMenuItem;
  20.     Savebtn: TMenuItem;
  21.     SaveDialog1: TSaveDialog;
  22.     N1: TMenuItem;
  23.     N2: TMenuItem;
  24.     Procedure FormActivate(Sender: TObject);
  25.     Procedure FormResize(Sender: TObject);
  26.     Procedure ManageBtnClick(Sender: TObject);
  27.     Procedure AManageNodesExecute(Sender: TObject);
  28.     Procedure DrawBtnClick(Sender: TObject);
  29.     Procedure AdjacencyListBtnClick(Sender: TObject);
  30.     Procedure MainGridKeyPress(Sender: TObject; Var Key: Char);
  31.     Procedure GetVerticesCoverBtnClick(Sender: TObject);
  32.     Procedure SavebtnClick(Sender: TObject);
  33.     procedure N2Click(Sender: TObject);
  34.     procedure N1Click(Sender: TObject);
  35.   Private
  36.     { Private declarations }
  37.   Public
  38.   End;
  39.  
  40. Var
  41.   MainForm: TMainForm;
  42.  
  43. Implementation
  44.  
  45. {$R *.dfm}
  46.  
  47. Uses Manage, Draw, Adjacency,
  48.   UAddLinks;
  49.  
  50. Type
  51.   TEdge = Record
  52.     P1, P2: Byte;
  53.   End;
  54.  
  55.   TEArray = Array Of TEdge;
  56.  
  57. Procedure NameFixedCells(MainGrid: TStringGrid);
  58. Var
  59.   I: Integer;
  60. Begin
  61.   For I := 1 To MainGrid.ColCount - 1 Do
  62.   Begin
  63.     MainGrid.Cells[I, 0] := IntToStr(I);
  64.   End;
  65.   For I := 1 To MainGrid.RowCount - 1 Do
  66.   Begin
  67.     MainGrid.Cells[0, I] := IntToStr(I);
  68.   End;
  69. End;
  70.  
  71. Procedure ClearTable(TablForClear: TStringGrid);
  72. Var
  73.   I, J: Integer;
  74. Begin
  75.   With TablForClear Do
  76.     For I := 1 To (RowCount - 1) Do
  77.       For J := 1 To (ColCount - 1) Do
  78.         TablForClear.Cells[J, I] := '';
  79. End;
  80.  
  81. Procedure MakeStringGridSameSize(MainGrid: TStringGrid);
  82. Begin
  83.   MainGrid.Width := MainForm.ClientWidth;
  84.   MainGrid.Height := MainForm.ClientHeight;
  85.   MainGrid.DefaultColWidth := Round(MainForm.ClientWidth / MainGrid.ColCount);
  86. End;
  87.  
  88. Procedure TMainForm.AdjacencyListBtnClick(Sender: TObject);
  89. Begin
  90.   AdjacencyForm.Show;
  91. End;
  92.  
  93. Procedure TMainForm.AManageNodesExecute(Sender: TObject);
  94. Begin
  95.   AdjacencyForm.ClearImage(AdjacencyForm.Image1);
  96.   ClearTable(MainGrid);
  97.   Savebtn.Enabled := False;
  98.   MainGrid.ColCount := StrToInt(ManageForm.NodeCountEdit.Text) + 1;
  99.   MainGrid.RowCount := StrToInt(ManageForm.NodeCountEdit.Text) + 1;
  100.   MakeStringGridSameSize(MainGrid);
  101.   NameFixedCells(MainGrid);
  102. End;
  103.  
  104. Procedure TMainForm.DrawBtnClick(Sender: TObject);
  105. Begin
  106.   DrawForm.Show;
  107. End;
  108.  
  109. Procedure TMainForm.FormActivate(Sender: TObject);
  110. Begin
  111.   MakeStringGridSameSize(MainGrid);
  112.   NameFixedCells(MainGrid);
  113. End;
  114.  
  115. Procedure TMainForm.FormResize(Sender: TObject);
  116. Begin
  117.   MakeStringGridSameSize(MainGrid);
  118. End;
  119.  
  120. Function NoSameEdges(EdgesArray: TEArray; P1: Byte; P2: Byte): Boolean;
  121. Var
  122.   I: Integer;
  123. Begin
  124.   Result := True;
  125.   For I := 0 To Length(EdgesArray) - 1 Do
  126.   Begin
  127.     If ((EdgesArray[I].P1 = P1) And (EdgesArray[I].P2 = P2)) Or
  128.       ((EdgesArray[I].P1 = P2) And (EdgesArray[I].P2 = P1)) Then
  129.     Begin
  130.       Result := False;
  131.       Break;
  132.     End;
  133.   End;
  134. End;
  135.  
  136. Function VerticleHasEdge(Ver: Byte; EdgesArray: TEArray): Boolean;
  137. Var
  138.   I: Integer;
  139. Begin
  140.   Result := False;
  141.   For I := 0 To Length(EdgesArray) - 1 Do
  142.   Begin
  143.     If (EdgesArray[I].P1 = Ver) Or (EdgesArray[I].P2 = Ver) Then
  144.     Begin
  145.       Result := True;
  146.       Break;
  147.     End;
  148.   End;
  149. End;
  150.  
  151. Function DeleteElemFromArr(Index: Byte; EdgesArray: TEArray): TEArray;
  152. Var
  153.   I: Integer;
  154. Begin
  155.   For I := Index To Length(EdgesArray) - 2 Do
  156.     EdgesArray[I] := EdgesArray[I + 1];
  157.   SetLength(EdgesArray, Length(EdgesArray) - 1);
  158.   Result := EdgesArray;
  159. End;
  160.  
  161. Function DeleteAllEdgesWithVer(Ver: Byte; EdgesArray: TEArray): TEArray;
  162. Var
  163.   IsDeletedAll: Boolean;
  164.   I: Integer;
  165. Begin
  166.   IsDeletedAll := True;
  167.   Repeat
  168.     For I := 0 To Length(EdgesArray) - 1 Do
  169.     Begin
  170.       If (EdgesArray[I].P1 = Ver) Or (EdgesArray[I].P2 = Ver) Then
  171.       Begin
  172.         IsDeletedAll := False;
  173.         EdgesArray := DeleteElemFromArr(I, EdgesArray);
  174.         Break;
  175.       End;
  176.     End;
  177.     If I = Length(EdgesArray) Then
  178.       IsDeletedAll := True;
  179.   Until IsDeletedAll;
  180.   Result := EdgesArray;
  181. End;
  182.  
  183. Procedure TMainForm.GetVerticesCoverBtnClick(Sender: TObject);
  184. Var
  185.   EdgesArray: TEArray;
  186.   ACover: Array Of Byte;
  187.   I, J: Byte;
  188.   ResStr: String;
  189. Begin
  190.   SetLength(EdgesArray, 0);
  191.   For I := 1 To MainGrid.ColCount Do
  192.   Begin
  193.     For J := 1 To MainGrid.ColCount Do
  194.     Begin
  195.       If (I <> J) And (MainGrid.Cells[I, J] = MainGrid.Cells[J, I]) And
  196.         ((MainGrid.Cells[I, J] <> '') And (MainGrid.Cells[I, J] <> '0')) Then
  197.       Begin
  198.         If NoSameEdges(EdgesArray, I, J) Then
  199.         Begin
  200.           SetLength(EdgesArray, Length(EdgesArray) + 1);
  201.           EdgesArray[Length(EdgesArray) - 1].P1 := I;
  202.           EdgesArray[Length(EdgesArray) - 1].P2 := J;
  203.         End;
  204.       End;
  205.     End;
  206.   End;
  207.   SetLength(ACover, 0);
  208.  
  209.   For I := 1 To MainGrid.ColCount Do
  210.   Begin
  211.     If VerticleHasEdge(I, EdgesArray) Then
  212.     Begin
  213.       SetLength(ACover, Length(ACover) + 1);
  214.       ACover[Length(ACover) - 1] := I;
  215.       EdgesArray := DeleteAllEdgesWithVer(I, EdgesArray);
  216.     End;
  217.   End;
  218.  
  219.   ResStr := '';
  220.   For I := 0 To Length(ACover) - 1 Do
  221.   Begin
  222.     ResStr := ResStr + ' ' + IntToStr(ACover[I]);
  223.   End;
  224.  
  225.   ShowMessage(ResStr);
  226.  
  227. End;
  228.  
  229. Procedure TMainForm.MainGridKeyPress(Sender: TObject; Var Key: Char);
  230. Begin
  231.   If Not(Key In ['0' .. '1', #8]) Then
  232.   Begin
  233.     Key := #0;
  234.   End;
  235. End;
  236.  
  237. Procedure TMainForm.ManageBtnClick(Sender: TObject);
  238. Begin
  239.   ManageForm.NodeCountEdit.Text := IntToStr(MainGrid.ColCount - 1);
  240.   NameFixedCells(MainGrid);
  241.   ManageForm.ShowModal;
  242.   FrmAddLinkns.Nheights := StrToInt(ManageForm.NodeCountEdit.Text);
  243.   FrmAddLinkns.ShowModal;
  244. End;
  245.  
  246. procedure TMainForm.N1Click(Sender: TObject);
  247. begin
  248.   Application.MessageBox
  249.     ('Импортировать список (неориентированный граф), инструкция:' +
  250.     #13#10'1. Файл должен содержать только числа, которые не превышают максимальной вершины.'#13#10
  251.     + '2. Если вершине не нужно задавать n-ую связь, то ставится пробел, смотреть пример ниже.'#13#10
  252.     + '3. Первая строка - число вершин в графе'#13#10 + 'Пример:'#13#10 +
  253.     '3'#13#10 + '2 3'#13#10 + '1  '#13#10 + '1 3'#13#10,
  254.     'Инструкция к программе', MB_OK + MB_ICONINFORMATION);
  255. end;
  256.  
  257. procedure TMainForm.N2Click(Sender: TObject);
  258. begin
  259.   Application.MessageBox('Выполнил студент группы 251004, Асепков Данила.',
  260.     'О разработчике', MB_OK + MB_ICONINFORMATION);
  261. end;
  262.  
  263. Procedure SaveStringGridToFile(StringGrid: TStringGrid; Const FileName: String);
  264. Var
  265.   FileStream: TFileStream;
  266.   StreamWriter: TStreamWriter;
  267.   Row, Col: Integer;
  268. Begin
  269.   Try
  270.     // Проверяем, существует ли файл
  271.     If Not(FileExists(FileName)) Then
  272.       Raise Exception.Create('Файл уже существует.');
  273.  
  274.     FileStream := TFileStream.Create(FileName, FmCreate);
  275.     Try
  276.       StreamWriter := TStreamWriter.Create(FileStream);
  277.       Try
  278.         For Row := 0 To StringGrid.RowCount - 1 Do
  279.         Begin
  280.           For Col := 0 To StringGrid.ColCount - 1 Do
  281.           Begin
  282.             StreamWriter.Write(StringGrid.Cells[Col, Row]);
  283.             If Col < StringGrid.ColCount - 1 Then
  284.               StreamWriter.Write(#9);
  285.             // Добавляем разделитель между ячейками
  286.           End;
  287.           StreamWriter.WriteLine; // Переходим на новую строку
  288.         End;
  289.       Finally
  290.         StreamWriter.Free;
  291.       End;
  292.     Finally
  293.       FileStream.Free;
  294.     End;
  295.   Except
  296.     On E: Exception Do
  297.     Begin
  298.       // Обработка ошибки
  299.       ShowMessage('Ошибка при сохранении файла: ' + E.Message);
  300.     End;
  301.   End;
  302. End;
  303.  
  304. Procedure TMainForm.SavebtnClick(Sender: TObject);
  305. Begin
  306.   If (SaveDialog1.Execute) Then
  307.     SaveStringGridToFile(MainGrid, SaveDialog1.FileName);
  308. End;
  309.  
  310. End.
  311.  
  312.  
  313.  
  314. unit Adjacency;
  315.  
  316. interface
  317.  
  318. uses
  319.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  320.   System.Classes, Vcl.Graphics,
  321.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
  322.  
  323. type
  324.   TAdjacencyForm = class(TForm)
  325.     Image1: TImage;
  326.     procedure FormActivate(Sender: TObject);
  327.   private
  328.     { Private declarations }
  329.   public
  330.     Procedure ClearImage(Image: TImage);
  331.   end;
  332.  
  333. var
  334.   AdjacencyForm: TAdjacencyForm;
  335.  
  336. implementation
  337.  
  338. {$R *.dfm}
  339.  
  340. Uses Main;
  341.  
  342. Procedure TAdjacencyForm.ClearImage(Image: TImage);
  343. Begin
  344.   With Image.Canvas do
  345.   Begin
  346.     Pen.Color := clWhite;
  347.     Brush.Color := clWhite;
  348.     Rectangle(0, 0, Image.Width, Image.Height);
  349.   End;
  350. End;
  351.  
  352. Procedure TAdjacencyForm.FormActivate(Sender: TObject);
  353. Var
  354.   I, J: Integer;
  355.   PosY, TempX: Integer;
  356. Begin
  357.   PosY := 20;
  358.   For I := 1 to MainForm.MainGrid.ColCount - 1 do
  359.   Begin
  360.     With Image1.Canvas do
  361.     Begin
  362.       Pen.Color := clBlack;
  363.       Brush.Color := clWhite;
  364.       Rectangle(30, PosY - 10, 60, PosY + 20);
  365.       TextOut(33, PosY - 3, MainForm.MainGrid.Cells[I, 0]);
  366.       Rectangle(59, PosY - 10, 90, PosY + 20);
  367.       TempX := 90;
  368.       For J := 1 to MainForm.MainGrid.ColCount - 1 do
  369.       Begin
  370.         With MainForm.MainGrid do
  371.         Begin
  372.           If (I <> J) and (Cells[I, J] = Cells[J, I]) and (Cells[I, J] <> '')
  373.           then
  374.           Begin
  375.             MoveTo(TempX, PosY);
  376.             TempX := TempX + 20;
  377.             LineTo(TempX, PosY);
  378.  
  379.             Rectangle(TempX, PosY - 10, TempX + 30, PosY + 20);
  380.             TextOut(TempX + 3, PosY - 3, IntToStr(J));
  381.             TempX := TempX + 30 - 1;
  382.             Rectangle(TempX, PosY - 10, TempX + 30, PosY + 20);
  383.             TempX := TempX + 30;
  384.           End;
  385.         End;
  386.       End;
  387.     End;
  388.     Inc(PosY, 40);
  389.   End;
  390. End;
  391.  
  392. end.
  393.  
  394.  
  395. Unit Manage;
  396.  
  397. Interface
  398.  
  399. Uses
  400.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  401.   System.Classes, Vcl.Graphics,
  402.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin;
  403.  
  404. Type
  405.   TManageForm = class(TForm)
  406.     NodeCountEdit: TSpinEdit;
  407.     Label1: TLabel;
  408.     SaveBtn: TButton;
  409.     procedure SaveBtnClick(Sender: TObject);
  410.  
  411.   Private
  412.     { Private declarations }
  413.   Public
  414.     { Public declarations }
  415.   End;
  416.  
  417. Var
  418.   ManageForm: TManageForm;
  419.  
  420. Implementation
  421.  
  422. {$R *.dfm}
  423.  
  424. Uses Main, uAddLinks;
  425.  
  426. Procedure TManageForm.SaveBtnClick(Sender: TObject);
  427. Begin
  428.   If StrToInt(NodeCountEdit.Text) > 10 then
  429.     NodeCountEdit.Text := '10'
  430.   Else If StrToInt(NodeCountEdit.Text) < 0 then
  431.     NodeCountEdit.Text := '1';
  432.   MainForm.aManageNodes.Execute;
  433.   frmAddLinkns.nHeights := NodeCountEdit.Value;
  434.   frmAddLinkns.ClearSgTable(frmAddLinkns.SgLinks);
  435.   Self.Close;
  436. End;
  437.  
  438. End.
  439.  
  440.  
  441.  
  442. Unit uAddLinks;
  443.  
  444. Interface
  445.  
  446. Uses
  447.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  448.   System.Classes, Vcl.Graphics,
  449.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Main,
  450.   Vcl.Menus, Manage;
  451.  
  452. Type
  453.   TfrmAddLinkns = Class(TForm)
  454.     Label1: TLabel;
  455.     SgLinks: TStringGrid;
  456.     SgHeights: TStringGrid;
  457.     Label2: TLabel;
  458.     Label3: TLabel;
  459.     MainMenu1: TMainMenu;
  460.     N1: TMenuItem;
  461.     OpenDialog1: TOpenDialog;
  462.     Procedure FormShow(Sender: TObject);
  463.     Procedure FormKeyPress(Sender: TObject; Var Key: Char);
  464.     Procedure ChangeTable();
  465.     Procedure N1Click(Sender: TObject);
  466.     Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
  467.     Procedure SgLinksSetEditText(Sender: TObject; ACol, ARow: Integer;
  468.       Const Value: String);
  469.   Private
  470.     Function NotRepeated(Str: String; Pos: Integer): Boolean;
  471.   Public
  472.     Nheights: Integer;
  473.     Procedure ClearSgTable(STRGRID: TStringGrid);
  474.   End;
  475.  
  476. Var
  477.   FrmAddLinkns: TfrmAddLinkns;
  478.  
  479. Implementation
  480.  
  481. {$R *.dfm}
  482.  
  483. Procedure TfrmAddLinkns.ClearSgTable(STRGRID: TStringGrid);
  484. Var
  485.   I, J: Integer;
  486. Begin
  487.   With STRGRID Do
  488.     For I := 0 To (RowCount - 1) Do
  489.       For J := 0 To (ColCount - 1) Do
  490.         STRGRID.Cells[J, I] := '';
  491. End;
  492.  
  493. Procedure TfrmAddLinkns.FormClose(Sender: TObject; Var Action: TCloseAction);
  494.  
  495. Var
  496.   I, J, Pos: Integer;
  497. Begin
  498.   For I := 0 To Nheights - 1 Do
  499.     For J := 0 To Nheights - 2 Do
  500.     Begin
  501.       If (SgLinks.Cells[J, I] <> '') Then
  502.       Begin
  503.         Pos := StrToInt(SgLinks.Cells[J, I]);
  504.         MainForm.MainGrid.Cells[Pos, I + 1] := '1';
  505.         MainForm.MainGrid.Cells[I + 1, Pos] := '1';
  506.       End;
  507.     End;
  508.   MainForm.Savebtn.Enabled := True;
  509. End;
  510.  
  511. Procedure TfrmAddLinkns.FormKeyPress(Sender: TObject; Var Key: Char);
  512. Var
  513.   Num, ARow: Integer;
  514. Begin
  515.   ARow := SgLinks.Row + 1;
  516.   If Not CharInSet(Key, ['1' .. '9', #08]) Then
  517.     Key := #0;
  518.   Num := Ord(Key) - 48;
  519.   If (Num > Nheights) Or (ARow = Num) Then
  520.     Key := #0;
  521. End;
  522.  
  523. Procedure TfrmAddLinkns.ChangeTable();
  524. Var
  525.   I: Integer;
  526. Begin
  527.   SgHeights.RowCount := Nheights;
  528.   SgLinks.ColCount := Nheights - 1;
  529.   SgLinks.RowCount := Nheights;
  530.   SgHeights.Height := 35 * (Nheights + 1);
  531.   SgLinks.Width := 35 * Nheights;
  532.   SgLinks.Height := 35 * (Nheights + 1);
  533.   For I := 0 To Nheights - 1 Do
  534.     SgHeights.Cells[0, I] := IntToStr(I + 1);
  535. End;
  536.  
  537. Procedure TfrmAddLinkns.FormShow(Sender: TObject);
  538. Begin
  539.   ChangeTable;
  540. End;
  541.  
  542. Function IsFileCorrect(Path: String): Boolean;
  543. Var
  544.   ISize, JSize, Num: Integer;
  545.   IsCorrect: Boolean;
  546.   MatrixFile: TextFile;
  547.   Size: Integer;
  548. Begin
  549.   ISize := 0;
  550.   JSize := 0;
  551.   IsCorrect := True;
  552.   AssignFile(MatrixFile, Path);
  553.   Reset(MatrixFile);
  554.   Readln(MatrixFile, Size);
  555.   If (Size < 1) Or (Size > 9) Then
  556.   Begin
  557.     IsCorrect := False;
  558.     MessageBox(Application.Handle,
  559.       'Файл содержит некорректные данные. Первая строка - размер. Значение от 1 до 5',
  560.       'Уведомление об ошибке', MB_ICONERROR);
  561.   End;
  562.   ManageForm.NodeCountEdit.Value := Size;
  563.   FrmAddLinkns.Nheights := Size;
  564.   FrmAddLinkns.ChangeTable;
  565.   MainForm.AManageNodes.Execute;
  566.   While Not(SeekEof(MatrixFile)) And IsCorrect Do
  567.   Begin
  568.     While Not(SeekEoln(MatrixFile)) And IsCorrect Do
  569.     Begin
  570.       Try
  571.         Read(MatrixFile, Num);
  572.         If (Num > Size) Or (Num < 0) Then
  573.         Begin
  574.           IsCorrect := False;
  575.           MessageBox(Application.Handle,
  576.             'Файл содержит некорректные данные. число должно быть вершиной ',
  577.             'Уведомление об ошибке', MB_ICONERROR);
  578.         End;
  579.         If Num = 0 Then
  580.           FrmAddLinkns.SgLinks.Cells[JSize, ISize] := ''
  581.         Else
  582.           FrmAddLinkns.SgLinks.Cells[JSize, ISize] := IntToStr(Num);
  583.       Except
  584.         IsCorrect := False;
  585.       End;
  586.       Inc(JSize);
  587.     End;
  588.     Inc(ISize);
  589.     Readln(MatrixFile);
  590.     JSize := 0;
  591.   End;
  592.   If ISize <> Size Then
  593.   Begin
  594.     IsCorrect := False;
  595.     MessageBox(Application.Handle,
  596.       'Файл содержит некорректные данные. Недостаточно строк',
  597.       'Уведомление об ошибке', MB_ICONERROR);
  598.   End;
  599.   CloseFile(MatrixFile);
  600.   IsFileCorrect := IsCorrect;
  601. End;
  602.  
  603. Procedure TfrmAddLinkns.N1Click(Sender: TObject);
  604. Begin
  605.   ManageForm.NodeCountEdit.Value := 1;
  606.   If Not((OpenDialog1.Execute) And (IsFileCorrect(OpenDialog1.Filename))) Then
  607.     ManageForm.NodeCountEdit.Value := 1
  608. End;
  609.  
  610. Function TfrmAddLinkns.NotRepeated(Str: String; Pos: Integer): Boolean;
  611. Var
  612.   I: Integer;
  613.   IsNotRepeated: Boolean;
  614. Begin
  615.   IsNotRepeated := True;
  616.   For I := 0 To Nheights - 1 Do
  617.   Begin
  618.     If SgHeights.Cells[I, Pos] = Str Then
  619.       IsNotRepeated := False;
  620.   End;
  621.   NotRepeated := IsNotRepeated;
  622. End;
  623.  
  624. Procedure TfrmAddLinkns.SgLinksSetEditText(Sender: TObject; ACol, ARow: Integer;
  625.   Const Value: String);
  626. Var
  627.   I, J: Integer;
  628. Begin
  629.   For I := 0 To SgLinks.ColCount - 1 Do
  630.     For J := 0 To SgLinks.ColCount - 1 Do
  631.     Begin
  632.       If Length(SgLinks.Cells[J, I]) > 1 Then
  633.         SgLinks.Cells[J, I] := '';
  634.     End;
  635. End;
  636.  
  637. End.
  638.  
  639.  
  640. Unit Draw;
  641.  
  642. Interface
  643.  
  644. Uses
  645.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  646.   System.Classes, Vcl.Graphics,
  647.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, System.IOUtils, Math;
  648.  
  649. Type
  650.   TDrawForm = class(TForm)
  651.     Image: TImage;
  652.     procedure FormActivate(Sender: TObject);
  653.   Private
  654.     { Private declarations }
  655.   Public
  656.     { Public declarations }
  657.   End;
  658.  
  659. Var
  660.   DrawForm: TDrawForm;
  661.  
  662. Implementation
  663.  
  664. {$R *.dfm}
  665.  
  666. Uses Main;
  667.  
  668. Type
  669.   TCoor = Record
  670.     X, Y: Integer;
  671.   End;
  672.  
  673.   TArray = Array of Byte;
  674.  
  675. Const
  676.   X_LOC: Array [1 .. 10] of Integer = (300, 200, 400, 100, 500, 100, 500, 200,
  677.     400, 300);
  678.   Y_LOC: Array [1 .. 10] of Integer = (30, 70, 70, 110, 110, 200, 200, 240,
  679.     240, 280);
  680.  
  681. Function IsAlreadyAdded(Arr: TArray; Pos: Byte): Boolean;
  682. Var
  683.   I: Integer;
  684. Begin
  685.   If Length(Arr) = 0 then
  686.     Result := False
  687.   Else
  688.   Begin
  689.     Result := False;
  690.     For I := 0 to Length(Arr) - 1 do
  691.     Begin
  692.       If Pos = Arr[I] then
  693.       Begin
  694.         Result := True;
  695.         Break;
  696.       End;
  697.     End;
  698.   End;
  699. End;
  700.  
  701. Procedure Visualize(Image: TImage);
  702. Var
  703.   I, J, Pos: Integer;
  704.   CreatedPosArray: TArray;
  705. Begin
  706.   SetLength(CreatedPosArray, 0);
  707.   For I := 1 to MainForm.MainGrid.ColCount - 1 do
  708.   Begin
  709.     Repeat
  710.       Pos := RandomRange(1, 11);
  711.     Until not IsAlreadyAdded(CreatedPosArray, Pos);
  712.     SetLength(CreatedPosArray, Length(CreatedPosArray) + 1);
  713.     CreatedPosArray[Length(CreatedPosArray) - 1] := Pos;
  714.   End;
  715.  
  716.   For I := 1 to MainForm.MainGrid.ColCount - 1 do
  717.   Begin
  718.     For J := 1 to MainForm.MainGrid.RowCount - 1 do
  719.     Begin
  720.       If I <> J then
  721.       Begin
  722.         With MainForm.MainGrid do
  723.         Begin
  724.           If (Cells[I, J] = Cells[J, I]) and
  725.             ((Cells[I, J] <> '') and (Cells[I, J] <> '0')) and
  726.             (Cells[J, I] <> '') then
  727.           Begin
  728.             With Image.Canvas do
  729.             Begin
  730.               Pen.Color := clBlack;
  731.               MoveTo(X_LOC[CreatedPosArray[I - 1]],
  732.                 Y_LOC[CreatedPosArray[I - 1]]);
  733.               LineTo(X_LOC[CreatedPosArray[J - 1]],
  734.                 Y_LOC[CreatedPosArray[J - 1]]);
  735.             End;
  736.           End;
  737.         End;
  738.       End;
  739.     End;
  740.   End;
  741.  
  742.   For I := 1 to MainForm.MainGrid.ColCount - 1 do
  743.   Begin
  744.     With Image.Canvas do
  745.     Begin
  746.       Pen.Color := clBlack;
  747.       Brush.Color := clWhite;
  748.       Rectangle((X_LOC[CreatedPosArray[I - 1]] - 20),
  749.         (Y_LOC[CreatedPosArray[I - 1]] - 20),
  750.         (X_LOC[CreatedPosArray[I - 1]] + 20),
  751.         (Y_LOC[CreatedPosArray[I - 1]] + 20));
  752.       TextOut(X_LOC[CreatedPosArray[I - 1]] - 10, Y_LOC[CreatedPosArray[I - 1]]
  753.         - 7, IntToStr(I));
  754.     End;
  755.   End;
  756. End;
  757.  
  758. Procedure ClearImage(Image: TImage);
  759. Begin
  760.   With Image.Canvas do
  761.   Begin
  762.     Pen.Color := clWhite;
  763.     Brush.Color := clWhite;
  764.     Rectangle(0, 0, Image.Width, Image.Height);
  765.   End;
  766. End;
  767.  
  768. Procedure TDrawForm.FormActivate(Sender: TObject);
  769. Begin
  770.   Image.Width := Self.ClientWidth;
  771.   Image.Height := Self.ClientHeight;
  772.   ClearImage(Image);
  773.   Visualize(Image);
  774. End;
  775.  
  776. End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement