close

Вход

Забыли?

вход по аккаунту

?

Отчет(2010)

код для вставкиСкачать
???????????? ?????? ? 4
????????? ?? ??????
????????: ??????? ?????? ???-21
????????? ?.?.
??????? ??????:
??????????? ???????? ??????. ???????? ?????
???: unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, ToolWin, ComCtrls, ActnMan, ActnColorMaps,
ImgList, XPMan, StdCtrls, Grids;
type
TForm1 = class(TForm)
Image1: TImage;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ImageList1: TImageList;
ToolButton2: TToolButton;
StatusBar1: TStatusBar;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
Panel1: TPanel;
StringGrid1: TStringGrid;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ToolButton3Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ToolButton4Click(Sender: TObject);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
rec = record
posx,posy : Integer;
end;
TVertex = Array of rec;
TMatrix = Array of array of integer;
const Radius = 30;
Diametr = 2*Radius;
var
Form1 : TForm1;
Vertex : TVertex;
Drawing : boolean = False;
FlagP : boolean = False;
FlagP2 : boolean = false;
nomP : integer;
A : TMatrix;
s : string; //??? ??????
implementation
uses Math;
{$R *.dfm}
procedure DrawLine(Canvas: TCanvas; X1,Y1,X2,Y2, Text: Integer);
var
Angle: Extended;
b1x,b1y,b2x,b2y,L : integer;
begin
Angle:=ArcTan2(Y1-Y2,X2-X1);
b1x := X1+Round(Radius*Cos(Angle) );
b1y := Y1-Round(Radius*Sin(Angle) );
b2x := X2-Round(Radius*Cos(Angle) );
b2y := Y2+Round(Radius*Sin(Angle) );
L := Round( Sqrt(sqr(x1-x2) + sqr(y1-y2)) );
L := L div 2;
with Canvas do begin
MoveTo(b1x,b1y );
LineTo(b2x,b2y );
Brush.Color := clWhite;
TextOut(X1+ Round(L*cos(Angle) ), y1 - Round(L * Sin(Angle)), IntToStr(Text) );
end;
end;
procedure Prime(b : TMatrix; Var s : string);
Var SM,SP : set of 1..100;
min,i,j,l,t,L2 : integer;
begin
min := maxInt;
L2 := Length(b)-1;
SM := [1..L2];
SP := [];
l := 0;
t := 0;
S := '';
for i := 1 to L2-1 do
for j := i+1 to L2 do
if (a[i,j] < min) and (a[i,j] <> 0) then begin
min := a[i,j];
l := i;
t := j;
end;
SP := [l,t];
SM := SM - [l,t];
s := s+IntToStr(l) +'-'+IntToStr(t)+';';
While SM<>[] do begin
min := maxInt;
l := 0;
t := 0;
for i := 1 to L2 do
if not(i in SP) then
for j := 1 to L2 do
if (j in SP) and (a[i,j] < min) and (a[i,j] <>0) then begin
min := a[i,j];
l := i;
t := j;
end;
SP := SP + [l];
SM := SM - [l];
s := s+IntToStr(l) +'-'+ IntToStr(t)+';';
end;
end;
Procedure ClearHolst(Im : TImage);
begin
With Im.Canvas do begin
pen.Color := clBlack;
pen.Width := 1;
pen.Mode := pmCopy;
Brush.Color := clWhite;
Rectangle(0,0,Im.Width,im.Height);
end;
end;
procedure DrawEllipse(x,y : integer; Im : TImage; Color : TColor);
begin
with Im.Canvas do begin
pen.Color := clBlack;
pen.Width := 1;
if pen.Mode <> pmCopy then pen.Mode := pmCopy;
Brush.Color := Color;
Ellipse(x-Radius,y-Radius,x+Radius,y+Radius);
end;
end;
procedure DrawCarcas(s : string; Im : TImage);
var buf : String;
i,x1,x2 : integer;
begin
ClearHolst(Im);
With Im.Canvas do begin
TextOut(5,5,'?????');
i := 0;
Repeat
inc(i);
buf := Copy(s,1,Pos(';',s) - 1);
Delete(S,1,Pos(';',S));
x1 := StrToInt( Copy(buf,1,Pos('-',buf)-1 ) ) - 1;
x2 := StrToInt( Copy(buf,Pos('-',buf)+ 1,Length(buf) ) ) - 1;
DrawEllipse(Vertex[x1].posx,Vertex[x1].posy, Im,clYellow);
DrawEllipse(Vertex[x2].posx,Vertex[x2].posy, Im,clYellow);
Im.Canvas.TextOut(Vertex[x1].posx,Vertex[x1].posy, IntToStr(x1 + 1) );
Im.Canvas.TextOut(Vertex[x2].posx,Vertex[x2].posy, IntToStr(x2 + 1) );
DrawLine(Im.Canvas,Vertex[x1].posx,Vertex[x1].posy, Vertex[x2].posx,Vertex[x2].posy , i);
until s = '';
end;
end;
procedure InitVertex(Var V : TVertex; n,MaxX,MaxY : integer);
var i : integer;
begin
SetLength(V,n);
Randomize;
for i := 0 to n - 1 do begin
V[i].posx := Radius + Random(maxX - Diametr);
V[i].posy := Radius + Random(maxY - Diametr);
end;
end;
procedure DrawVertex(V : TVertex;A : TMatrix ;Im : TImage);
var i,L,j : integer;
begin
ClearHolst(Im);
Im.Canvas.TextOut(5,5,'????');
L := length(V) - 1;
for i := 0 to L do begin
if V[i].posx = 0 then Continue;
DrawEllipse(V[i].posx,V[i].posy,Im,clSkyBlue);
Im.Canvas.TextOut(V[i].posx,V[i].posy,IntToStr(i+1));
end;
L := Length(A) - 1;
with Im.Canvas do
for i := 1 to L-1 do
for j := i to L do begin
if a[i,j] = 0 then Continue;
DrawLine(Im.Canvas,V[i-1].posx,V[i-1].posy, V[j-1].posx,V[j-1].posy,a[i,j]);
end;
end;
procedure DeleteInVertex(count : integer;var v : TVertex);
begin
V[count].posx := -500;
V[count].posy := -500;
end;
Function FindInVertexReturn(x,y : integer; V : TVertex;Var II : integer): boolean;
var n,i,Rast : integer;
begin
Result := false;
if v = nil then exit;
n := Length(V) - 1;
for i:= 0 to n do begin
Rast := Trunc( Sqrt(sqr(V[i].posx-x)+sqr(V[i].posy-y)) );
if Rast < Radius then begin
result := true;
II := i;
break;
end;
end;
end;
procedure InitStringGrid(Sg : TStringGrid; n : integer);
var i,j : integer;
begin
with SG do begin
ColCount := n + 1;
RowCount := n + 1;
cells[0,0] := 'X';
ColWidths[0] := 30;
for i := 1 to n do begin
cells[i,0] := 'X' + IntToStr(i);
cells[0,i] := 'X' + IntToStr(i);
ColWidths[i] := 30;
end;
For i := 1 to RowCount -1 do
for j := 1 to ColCount -1 do cells[i,j] := '0';
end;
end;
procedure AddToMatrix(Sg: TStringGrid;Var a : TMatrix);
var i,j,k : integer;
begin
k := 0;
with Sg do
for i := 1 to RowCount - 1 do
for j := 1 to ColCount - 1 do begin
if a[i,j] <> 0 then inc(k);
a[i,j] := StrToInt(cells[j,i] );
end;
Form1.StatusBar1.Panels[2].Text := '???-?? ????? = '+IntToStr(k div 2);
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
var
value : string;
n : integer;
flag : boolean;
begin
flag := false;
repeat
if not InputQuery('?????', '??????? ?????????? ??????', value) then exit;
if (TryStrToInt(value,n)) and (n > 1) and (n < 100) then flag := true
else ShowMessage('??????? ????? ????? ? ????? ?????? 1 ? ?????? 100');
until flag;
StatusBar1.Panels[1].Text := '???-?? ?????? = '+ IntToStr(n);
StatusBar1.Panels[2].Text := '???-?? ????? = 0';
InitVertex(Vertex,n, Image1.Width,Image1.Height);
InitStringGrid(StringGrid1,n);
SetLength(A,n+1,n+1);
DrawVertex(Vertex,A,Image1);
Drawing := true;
ToolButton3.Enabled := true;
ToolButton4.Enabled := true;
ToolButton5.Enabled := true;
end;
procedure TForm1.ToolButton2Click(Sender: TObject);
begin
FlagP := ToolButton2.Down;
StatusBar1.Panels[0].Text := '';
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not Drawing then exit;
If not FlagP then exit;
if not FindInVertexReturn(x,y,Vertex,nomP) then exit;
FlagP2 := true;
StatusBar1.Panels[0].Text := '??????? '+IntToStr(nomP + 1) + ' ???????';
end;
procedure TForm1.ToolButton3Click(Sender: TObject);
begin
Drawing := ToolButton3.Down;
ToolButton2.Enabled := Drawing;
ToolButton5.Enabled := not Drawing;
if Drawing then begin
ToolButton4.Down := false;
Panel1.Visible := false;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not Drawing then exit;
if FlagP then begin
DrawVertex(Vertex,A,Image1);
if FlagP2 then begin
DrawEllipse(x,y,Image1,clLime);
DeleteInVertex(nomP,Vertex);
Vertex[nomP].posx := x;
Vertex[nomP].posy := y;
end
else begin
if FindInVertexReturn(x,y,Vertex,nomP) then begin
StatusBar1.Panels[0].Text := '?????????? ??????? '+IntToStr(nomP + 1);
DrawEllipse(Vertex[nomP].posx,Vertex[nomP].posy,Image1,ClRed);
end
else StatusBar1.Panels[0].Text := '';
end;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not Drawing then exit;
if FlagP then begin
if not FlagP2 then exit;
FlagP2 := false;
Vertex[nomP].posx := x;
Vertex[nomP].posy := y;
end;
end;
procedure TForm1.ToolButton4Click(Sender: TObject);
begin
Panel1.Visible := ToolButton4.Down;
if ToolButton3.Down then begin
ToolButton3.Down := false;
Drawing := ToolButton3.Down;
end;
if ToolButton2.Down then begin
ToolButton2.Down := false;
FlagP := false;
ToolButton5.Enabled := true;
end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
with StringGrid1 do begin
if(ARow = ACol) or (ARow > ACol) then begin
Options := Options-[goEditing];
end
else Options := Options+[goEditing];
end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
const
clPaleRed = TColor($CCCCFF);
clPaleGreen = TColor($CCFFCC);
begin
with StringGrid1 do begin
if(ARow = ACol) and (ARow > 0) then begin
Canvas.Brush.color := clPaleRed;
canvas.fillRect(Rect);
canvas.TextOut(Rect.Left+2,Rect.Top+2,Cells[ACol,ARow]);
end;
if (aRow > ACol) and (aCol > 0) then begin
Canvas.Brush.color := clPaleGreen;
canvas.fillRect(Rect);
canvas.TextOut(Rect.Left+2,Rect.Top+2,Cells[ACol,ARow]);
end;
end;
end;
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
case key of
'0'..'9',#8 : ;
else key := Chr(0);
end;
end;
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
begin
if Value = '' then exit;
StringGrid1.Cells[ARow,ACol] := StringGrid1.cells[ACol,ARow];
AddToMatrix(StringGrid1,A);
DrawVertex(Vertex,A,Image1);
end;
procedure TForm1.ToolButton5Click(Sender: TObject);
begin
Prime(A,S);
DrawCarcas(s,Image1);
ToolButton6.Enabled := true;
end;
procedure TForm1.ToolButton6Click(Sender: TObject);
begin
If ToolButton6.Down then DrawVertex(Vertex,A,Image1)
else DrawCarcas(S,Image1);
end;
end.
?????????: ???? ?????:
2
Документ
Категория
Без категории
Просмотров
13
Размер файла
271 Кб
Теги
2010, отчет
1/--страниц
Пожаловаться на содержимое документа