double arrow

Inplementation

{$R *.DFM}

procedure TChartForm.ButtonExitClick (Sender: TObject);
begin // Выход из npoгpaммы
Close;
end;

procedure TChartForm.FormCreate (Sender: TObject);
begin // При создании формы надо проинициалаизировать таблицу
with StringGrid do
begin // Формрование заголовков столбцов таблицы
Cells[0,0]:='№';
Cells[1,0]:='X';
Cells[2,0]:='Y';
Cells[0,1]:='1';
end;
end;

procedure TChartForm.StringGridSetEditText (Sender: TObject;
ACol, ARow: Integer; const Value: String);
var i, maxRow: integer; f: boolean; tmp: double;
begin // В таблице изменился текст
try
if Value<>'' then
StrToFloat(Value);
PanelStatus.Caption:='';
except
on E:Exception do
PanelStatus.Caption:=E.Message;
end;
with StringGrid do
begin // Удаление лишних строк
MaxRow:=0;
for i:=RowCount-l downto 1 do
if (Cells[1,i]<>'') or (Cells[2,i]<>") then
begin
MaxRow:=i;
break;
end;
RowCount:=MaxRow+2;
for i:=1 to RowCount-1 do
Cells[0,i]:=IntToStr(i);
// Заполнение массивов координат
SetLength(X,MaxRow);
SetLength(Y,MaxRow);
for i:=0 to MaxRow-1 do
begin
try
X[i]:=StrToFloat(Cells[1,i+1]);
except
X[i]:=0;
end;
try
Y[i]:=StrToFloat(Cells[2,i+1]);
except
Y[i]:=0;
end;
end;
// Сортировка массива по координате X методом пузырька
repeat
f:=True;
for i:=0 to MaxRow-2 do
if X[i]>X[i+1] then
begin
tmp:=X[i]; X[i]:=X[i+l]; X[i+1]:=tmp;
tmp:=Y[i]; Y[i]:=Y[i+1]; Y[i+1]:=tnp;
f:=False;
end;
until f;
PaintBox.Invalidate; // Перерисовать график
end;
end;

procedure TChartForm.PaintBoxPaint(Sender: TObject);
var CX, CY, i, j, XX, YY: integer; D: double;
begin // Вызывается пря необходимости перерисовки графика
with PaintBox, Canvas do
begin
CX:=Width div 2;
CY:=Height div 2; // исчисляем положение начала координат в PaintBox
if Width<Height then D:=(Width-30)/20 else D:=(Height-30)/20;
// рисуем координатные оси
Pen.Color:=clNavy;
Pen.Width:=3;
Polyline([Point(0,CY), Point(Width, CY), Point(Width-10,CY+5), Point (Width, CY),
Point(Width-10,CY-5)]);
Polyline([Point(CX,Height), Point(CX,0), Point(CX+5,10), Point(CX,0),
Point(CX-5,10)]);
// Рисуем насечки на осях и подписи
Pen.Color:=clBlack; // Цвет линий сделать черным
Pen.Width:=1; // Толщину линий установить единичной
Font.Name:='Small'; // Название прифта "Small" (специальный шрифт для мелких надписей)
Font.Size:=7; // Размер шрифта
Brush.Style:=bsClear; //Заливку отключить
for i:=-10 to 10 do
if i<>0 then
begin
if i mod 5=0 then j:=5 else j:=3;
Polyline([Point (CX+round(i*D),CY-j), Poiтt (CX+round(i*D),CY+j+1)ъ);
Polyline([Point(CX-j,CY+round(i*D)), Point(СЧ+j+1,CY+round(i*D))]);
TextOut(CX+round(i*D)-4,CY-15, IntIoStr(i));
TextOut(CX+10, CY-round(i*D)-5,IntToStr(i));
end;
// Строим график
Pen.Color:=clMaroon;
Brush.Color:=clYellow;
for i:=0 to High(X) do
begin
XX:=CX+round(X[i]*D);
YY:=CY-round(Y[i]*D);
Rectangle(XX-2,YY-2,XX+3,YY+3];
if i=0 then MoveTo(XX,YY) else LineTo(XX, YY);
end;
end;
end;

end.


Понравилась статья? Добавь ее в закладку (CTRL+D) и не забудь поделиться с друзьями:  



Сейчас читают про: