Samples
BIN
Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi1.bmp
Normal file
After Width: | Height: | Size: 29 KiB |
BIN
Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi2.bmp
Normal file
After Width: | Height: | Size: 29 KiB |
BIN
Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi3.bmp
Normal file
After Width: | Height: | Size: 29 KiB |
BIN
Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi4.bmp
Normal file
After Width: | Height: | Size: 29 KiB |
BIN
Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi5.bmp
Normal file
After Width: | Height: | Size: 29 KiB |
29
Samples/Graphics/ABCObjects/Sprites/gr_SpriteCreation.pas
Normal file
@ -0,0 +1,29 @@
|
||||
// Создание спрайта и его состояний
|
||||
uses GraphABC,ABCSprites,ABCObjects,Events;
|
||||
|
||||
var s: SpriteABC;
|
||||
|
||||
begin
|
||||
Window.Title := 'Создание спрайта';
|
||||
SetWindowSize(400,300);
|
||||
CenterWindow;
|
||||
|
||||
// Создание спрайта и добавление в него кадров
|
||||
s := new SpriteABC(150,100,'SpriteFrames\multi1.bmp');
|
||||
s.Add('SpriteFrames\multi2.bmp');
|
||||
s.Add('SpriteFrames\multi3.bmp');
|
||||
s.Add('SpriteFrames\multi2.bmp');
|
||||
s.Add('SpriteFrames\multi4.bmp');
|
||||
s.Add('SpriteFrames\multi5.bmp');
|
||||
|
||||
// Добавление состояний к спрайту
|
||||
s.AddState('fly',4); // Летать - 4 кадра
|
||||
s.AddState('stand',1); // Стоять - 1 кадр
|
||||
s.AddState('sit',1); // Сидеть - 1 кадр
|
||||
|
||||
// Задание скорости спрайт-анимации (1..10)
|
||||
s.Speed := 9;
|
||||
|
||||
// Сохранение спрайта в "длинный" рисунок и создание информационного файла спрайта
|
||||
s.SaveWithInfo('spr.png');
|
||||
end.
|
27
Samples/Graphics/ABCObjects/Sprites/gr_SpriteUsing.pas
Normal file
@ -0,0 +1,27 @@
|
||||
// Переключение состояний спрайта щелчком мыши
|
||||
uses GraphABC,ABCSprites,ABCObjects,Events;
|
||||
|
||||
var
|
||||
s: SpriteABC;
|
||||
t: TextABC;
|
||||
|
||||
procedure MyMouseDown(x,y,mb: integer);
|
||||
begin
|
||||
if s.PtInside(x,y) then
|
||||
begin
|
||||
// Переход к следующему состоянию спрайта
|
||||
if s.State<s.StateCount then
|
||||
s.State := s.State + 1
|
||||
else s.State := 1;
|
||||
t.Text := 'Состояние спрайта: ' + s.StateName;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Window.Title := 'Щелкните мышью на спрайте';
|
||||
SetWindowSize(400,300);
|
||||
CenterWindow;
|
||||
s := new SpriteABC(150,100,'spr.spinf');
|
||||
t := new TextABC(55,30,15,'Состояние спрайта: '+s.StateName,clRed);
|
||||
OnMouseDown := MyMouseDown;
|
||||
end.
|
BIN
Samples/Graphics/ABCObjects/Sprites/spr.png
Normal file
After Width: | Height: | Size: 2.3 KiB |
7
Samples/Graphics/ABCObjects/Sprites/spr.spinf
Normal file
@ -0,0 +1,7 @@
|
||||
spr.png // имя файла спрайта
|
||||
100 // ширина кадра
|
||||
9 // скорость
|
||||
3 // количество состояний
|
||||
fly 4 // имена состояний и количество кадров в них
|
||||
stand 1
|
||||
sit 1
|
BIN
Samples/Graphics/ABCObjects/demo.bmp
Normal file
After Width: | Height: | Size: 12 KiB |
43
Samples/Graphics/ABCObjects/gr_All_Brown.pas
Normal file
@ -0,0 +1,43 @@
|
||||
// Изменение свойств графических объектов
|
||||
// Броуновское движение графических объектов
|
||||
uses ABCObjects,GraphABC;
|
||||
|
||||
procedure MoveAll(a,b: integer);
|
||||
begin
|
||||
for var j:=0 to Objects.Count-1 do
|
||||
Objects[j].moveOn(a,b);
|
||||
end;
|
||||
|
||||
begin
|
||||
// LockDrawingObjects;
|
||||
Window.Title := 'Броуновское движение объектов';
|
||||
var sq := new SquareABC(30,5,90,clSkyBlue);
|
||||
var r := new RectangleABC(10,10,100,180,RGB(255,100,100));
|
||||
var rr := new RoundRectABC(200,180,180,50,20,clRandom);
|
||||
var rsq:= new RoundSquareABC(20,180,80,10,clRandom);
|
||||
var c := new CircleABC(160,55,70,clGreen);
|
||||
var z := new StarABC(200,150,70,135,5,clRandom);
|
||||
z.Filled := False;
|
||||
var el := new EllipseABC(5,55,65,50,clRandom);
|
||||
el.Bordered := False;
|
||||
var t := new TextABC(100,170,15,'Hello, ABCObjects!');
|
||||
var br := new BoardABC(200,20,7,5,20,20);
|
||||
br.Filled := False;
|
||||
z.Height := 200;
|
||||
z.Radius := 70;
|
||||
sq.Width := 120;
|
||||
t.TransparentBackground := False;
|
||||
t.BackgroundColor := clYellow;
|
||||
t.FontName := 'Times New Roman';
|
||||
t.FontSize := 20;
|
||||
c.Height := 50;
|
||||
c.Scale(2);
|
||||
MoveAll(160,110);
|
||||
|
||||
while True do
|
||||
begin
|
||||
for var j:=0 to Objects.Count-1 do
|
||||
Objects[j].moveOn(Random(-1,1),Random(-1,1));
|
||||
// RedrawObjects;
|
||||
end;
|
||||
end.
|
31
Samples/Graphics/ABCObjects/gr_Clone_Recur.pas
Normal file
@ -0,0 +1,31 @@
|
||||
// Клонирование графических объектов.
|
||||
// Контейнер графических объектов. Вложенные контейнеры
|
||||
uses GraphABC,ABCObjects;
|
||||
|
||||
/// Создание четырех графических объектов из одного
|
||||
procedure Four(var g: ObjectABC);
|
||||
begin
|
||||
var w := 8*g.Width div 7;
|
||||
var f := ContainerABC.Create(0,0);
|
||||
f.Add(g);
|
||||
g := g.Clone;;
|
||||
g.moveon(w,0);
|
||||
g := g.Clone;
|
||||
g.moveon(0,w);
|
||||
g := g.Clone;
|
||||
g.moveon(-w,0);
|
||||
g := f;
|
||||
end;
|
||||
|
||||
begin
|
||||
LockDrawingObjects;
|
||||
SetWindowSize(630,630);
|
||||
|
||||
var g: ObjectABC := new SquareABC(0,0,14,clYellow);
|
||||
Four(g);
|
||||
Four(g);
|
||||
Four(g);
|
||||
Four(g);
|
||||
Four(g);
|
||||
UnLockDrawingObjects;
|
||||
end.
|
40
Samples/Graphics/ABCObjects/gr_DragPicture.pas
Normal file
@ -0,0 +1,40 @@
|
||||
// Передвижение графических объектов мышью
|
||||
uses ABCObjects,GraphABC;
|
||||
|
||||
var
|
||||
ob: ObjectABC;
|
||||
sx,sy: integer;
|
||||
|
||||
procedure MyMouseDown(x,y,mb: integer);
|
||||
begin
|
||||
ob := ObjectUnderPoint(x,y);
|
||||
if ob<>nil then
|
||||
begin
|
||||
sx := ob.Left - x;
|
||||
sy := ob.Top - y;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MyMouseMove(x,y,mb: integer);
|
||||
begin
|
||||
if ob<>nil then
|
||||
ob.Position := new Point(x+sx,y+sy);
|
||||
end;
|
||||
|
||||
procedure MyMouseUp(x,y,mb: integer);
|
||||
begin
|
||||
ob := nil;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
Window.Title := 'Передвигайте мышью объекты';
|
||||
for var i:=1 to 10 do
|
||||
begin
|
||||
var p := new PictureABC(Random(Window.Width-100),Random(Window.Height-100),'demo.bmp');
|
||||
p.Transparent := True;
|
||||
end;
|
||||
OnMouseDown := MyMouseDown;
|
||||
OnMouseMove := MyMouseMove;
|
||||
OnMouseUp := MyMouseUp;
|
||||
end.
|
28
Samples/Graphics/ABCObjects/gr_Intersect.pas
Normal file
@ -0,0 +1,28 @@
|
||||
// Иллюстрация метода Intersect для графических объектов
|
||||
uses ABCObjects,GraphABC;
|
||||
|
||||
var Destroyer: CircleABC;
|
||||
|
||||
procedure CheckPulyaIntersects;
|
||||
begin
|
||||
for var i:=Objects.Count-1 downto 0 do
|
||||
begin
|
||||
if (Destroyer.Intersect(Objects[i])) and (Objects[i]<>Destroyer) then
|
||||
Objects[i].Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Window.Title := 'Разрушитель: метод Intersect пересечения объектов';
|
||||
for var i:=1 to 500 do
|
||||
new RectangleABC(Random(WindowWidth-200)+100,Random(WindowHeight-100),Random(200),Random(200),clRandom);
|
||||
Destroyer := new CircleABC(10,WindowHeight div 2,100,clBlack);
|
||||
Destroyer.FontColor := clYellow;
|
||||
Destroyer.Text := 'Destroyer';
|
||||
|
||||
for var i:=1 to 900 do
|
||||
begin
|
||||
Destroyer.MoveOn(1,0);
|
||||
CheckPulyaIntersects;
|
||||
end;
|
||||
end.
|
70
Samples/Graphics/ABCObjects/gr_Move_Param.pas
Normal file
@ -0,0 +1,70 @@
|
||||
// Движение по траектории
|
||||
uses ABCObjects,GraphABC;
|
||||
|
||||
const
|
||||
/// Шаг по параметру кривой
|
||||
step = 0.03;
|
||||
/// Задержка по времени, мс
|
||||
delay = 10;
|
||||
|
||||
type
|
||||
PointR = record
|
||||
x,y: real;
|
||||
end;
|
||||
|
||||
function Position(t: real): PointR; // астроида
|
||||
begin
|
||||
var si := sin(1.5 * t);
|
||||
var co := cos(1.5 * t);
|
||||
Result.x := si*si*si;
|
||||
Result.y := co*co*co;
|
||||
end;
|
||||
|
||||
function Position1(t: real): PointR; // фигура Лиссажу
|
||||
begin
|
||||
Result.x := cos(4*t);
|
||||
Result.y := cos(2.97221*t + 2*Pi/3);
|
||||
end;
|
||||
|
||||
function LogicalToScreen(p: PointR): Point;
|
||||
begin
|
||||
var ww := WindowWidth div 2;
|
||||
var hh := WindowHeight div 2;
|
||||
Result.x := round((ww - 50) * p.x + ww);
|
||||
Result.y := round((hh - 50) * p.y + hh);
|
||||
end;
|
||||
|
||||
procedure InitScreen;
|
||||
begin
|
||||
SetBrushColor(clMoneyGreen);
|
||||
Rectangle(10,10,WindowWidth-10,WindowHeight-10);
|
||||
var p := LogicalToScreen(Position1(0));
|
||||
MoveTo(p.x,p.y);
|
||||
end;
|
||||
|
||||
begin
|
||||
Window.IsFixedSize := True;
|
||||
Window.Title := 'Движение по траектории';
|
||||
SetWindowSize(640,480);
|
||||
CenterWindow;
|
||||
|
||||
InitScreen;
|
||||
var c := new CircleABC(200,200,25,clGreen);
|
||||
var d := new StarABC(200,200,40,20,5,clYellow);
|
||||
|
||||
var t: real := 0;
|
||||
while True do
|
||||
begin
|
||||
c.Center := LogicalToScreen(Position1(t));
|
||||
d.Center := LogicalToScreen(Position(t));
|
||||
if t<20*Pi then
|
||||
LineTo(c.Center.x,c.Center.y)
|
||||
else
|
||||
begin
|
||||
t := 0;
|
||||
InitScreen;
|
||||
end;
|
||||
t += step;
|
||||
Sleep(delay);
|
||||
end;
|
||||
end.
|
14
Samples/Graphics/GraphABC/DigitalClock.pas
Normal file
@ -0,0 +1,14 @@
|
||||
uses GraphABC,System;
|
||||
|
||||
begin
|
||||
Font.Size := 80;
|
||||
var x0 := (Window.Width - TextWidth('00:00:00')) div 2;
|
||||
var y0 := (Window.Height - TextHeight('00:00:00')) div 2;
|
||||
while True do
|
||||
begin
|
||||
var t := DateTime.Now;
|
||||
var s := string.Format('{0:d2}:{1:d2}:{2:d2}',t.Hour,t.Minute,t.Second);
|
||||
TextOut(x0,y0,s);
|
||||
Sleep(1000);
|
||||
end;
|
||||
end.
|
67
Samples/Graphics/GraphABC/Flame.pas
Normal file
@ -0,0 +1,67 @@
|
||||
uses GraphABC;
|
||||
|
||||
type TByteArray = array of byte;
|
||||
const frames = 25;
|
||||
size = 250;
|
||||
dxy = size div 2;
|
||||
dm = 2*PI/1024;
|
||||
flameh = 4;
|
||||
Light: byte = 255;
|
||||
|
||||
procedure FillPallete(ColorsTable: array of Color);
|
||||
begin
|
||||
for var i:=0 to 255 do
|
||||
if(i<128) then
|
||||
ColorsTable[i] := RGB(i,0,i div 2)
|
||||
else
|
||||
ColorsTable[i] := RedColor(i);
|
||||
end;
|
||||
|
||||
begin
|
||||
//Создаюм буфер экрана
|
||||
var ScreenBuffer := new TByteArray[size+1];
|
||||
for var i:=0 to size do
|
||||
ScreenBuffer[i] := new byte[size+1];
|
||||
//Создаем палитру
|
||||
var ColorsTable := new Color[256];
|
||||
FillPallete(ColorsTable);
|
||||
//Настраиваем окно
|
||||
SetWindowSize(size,size);
|
||||
SetBrushColor(clBlack);
|
||||
FillRectangle(0,0,WindowWidth,WindowHeight);
|
||||
SetSmoothingOff;
|
||||
LockDrawing;
|
||||
//Поехали
|
||||
var x, y, s, tt, xx, yy: Integer;
|
||||
var dt := System.DateTime.Now;
|
||||
var ds := WindowWidth div 4;
|
||||
repeat
|
||||
tt := tt + 1;
|
||||
xx := dxy + Round(ds*Sin(tt*dm));
|
||||
yy := dxy + Round(ds*Cos(tt*dm));
|
||||
ScreenBuffer[xx,yy] := Light;
|
||||
SetPixel(xx,yy,ColorsTable[Light]);
|
||||
for var i:=0 to 5 do begin
|
||||
x := Random(size-1) + 1;
|
||||
y := Random(size-1) + 1;
|
||||
s := ScreenBuffer[Y,X];
|
||||
if s>=flameh then
|
||||
s := s - flameh;
|
||||
if s=0 then
|
||||
continue;
|
||||
ScreenBuffer[y-1,x+1] := s;
|
||||
ScreenBuffer[y-1,x ] := s;
|
||||
ScreenBuffer[y-1,x-1] := s;
|
||||
ScreenBuffer[y+1,x ] := s;
|
||||
var c := ColorsTable[s];
|
||||
SetPixel(y-1,x+1,c);
|
||||
SetPixel(y-1,x, c);
|
||||
SetPixel(y-1,x-1,c);
|
||||
SetPixel(y+1,x, c);
|
||||
end;
|
||||
if((system.datetime.Now-dt).TotalMilliseconds>1000/frames) then begin
|
||||
dt := System.Datetime.Now;
|
||||
Redraw;
|
||||
end;
|
||||
until False;
|
||||
end.
|
70
Samples/Graphics/GraphABC/Fractals/Dragon.pas
Normal file
@ -0,0 +1,70 @@
|
||||
// Пример из пакета KuMir/PMir
|
||||
program Dragon;
|
||||
|
||||
uses GraphABC,Utils;
|
||||
|
||||
var
|
||||
x := 200;
|
||||
y := 150;
|
||||
dx := 0;
|
||||
dy := -4;
|
||||
turn: array [1..1000] of Boolean;
|
||||
|
||||
begin
|
||||
SetWindowSize(790,500);
|
||||
Window.Title := 'Кривая Дракона';
|
||||
var f := True;
|
||||
for var a := 1 to 64 do
|
||||
begin
|
||||
turn[2*a-1] := f;
|
||||
f := not f;
|
||||
turn[2*a] := turn[a];
|
||||
end;
|
||||
var b := 0;
|
||||
var d := 1;
|
||||
f := false;
|
||||
MoveTo(x,y);
|
||||
|
||||
for var a:=1 to 128 do
|
||||
begin
|
||||
var t: integer;
|
||||
LockDrawing;
|
||||
for var i:=1 to 127*4 do
|
||||
begin
|
||||
b += d;
|
||||
x += dx;
|
||||
y += dy;
|
||||
LineTo(x,y);
|
||||
if f and not turn[b] or not f and turn[b] then
|
||||
begin
|
||||
t := dy;
|
||||
dy := -dx;
|
||||
end
|
||||
else
|
||||
begin
|
||||
t := -dy;
|
||||
dy := dx;
|
||||
end;
|
||||
dx := t;
|
||||
end;
|
||||
b += d;
|
||||
x += dx;
|
||||
y += dy;
|
||||
LineTo(x,y);
|
||||
d := -d;
|
||||
f := not f;
|
||||
if turn[a] then
|
||||
begin
|
||||
t := dy;
|
||||
dy := -dx;
|
||||
end
|
||||
else
|
||||
begin
|
||||
t := -dy;
|
||||
dy := dx;
|
||||
end;
|
||||
dx := t;
|
||||
UnLockDrawing;
|
||||
end;
|
||||
write('Время работы = ',Milliseconds/1000,' с');
|
||||
end.
|
40
Samples/Graphics/GraphABC/Fractals/Mandelbrot.pas
Normal file
@ -0,0 +1,40 @@
|
||||
// Демонстрация фрактальной графики. Множество Мандельброта
|
||||
// Для каждой точки комплексной плоскости z=(x,y) выполняем итерационный процесс z=z*2+c, c=(cx,cy)
|
||||
// Считаем количество итераций i до тех пор пока не выполнится условие |z|>max
|
||||
// После этого рисуем точку z=(x,y) с насыщенностью красного цвета, пропорциональной i
|
||||
uses GraphABC;
|
||||
|
||||
const
|
||||
max = 10;
|
||||
coef1 = 0.5;
|
||||
coef2 = 0.88;
|
||||
scalex = 0.0035;
|
||||
scaley = 0.0035;
|
||||
dx = 430;
|
||||
dy = 300;
|
||||
|
||||
begin
|
||||
Window.Title := 'Фракталы: множество Мандельброта';
|
||||
SetWindowSize(600,600);
|
||||
CenterWindow;
|
||||
for var ix:=0 to Window.Width-1 do
|
||||
for var iy:=0 to Window.Height-1 do
|
||||
begin
|
||||
var cx := scalex * (ix - dx);
|
||||
var cy := scaley * (iy - dy);
|
||||
var c := Cplx(cx,cy);
|
||||
var z := Cplx(0,0);
|
||||
|
||||
var i := 1;
|
||||
while i<255 do
|
||||
begin
|
||||
z := z*z+c;
|
||||
if z.Magnitude>max then break;
|
||||
i += 1;
|
||||
end;
|
||||
if i>=255 then SetPixel(ix,iy,clRed)
|
||||
else SetPixel(ix,iy,RGB(255,255-i,255-i));
|
||||
end;
|
||||
writeln('Время расчета = ',Milliseconds/1000,' с');
|
||||
end.
|
||||
|
22
Samples/Graphics/GraphABC/Fractals/Paporotnik/Main.pas
Normal file
@ -0,0 +1,22 @@
|
||||
//(c) DarkStar 2008
|
||||
uses GraphABC, Paporotnik, PaporotnikData;
|
||||
|
||||
const
|
||||
Iterations = 300000;
|
||||
Height = 600;
|
||||
Fast = false;
|
||||
Width = Height div 2;
|
||||
WindowWidth= Width * 3;
|
||||
Brightness = 170;
|
||||
|
||||
var
|
||||
Paprotnik := new PaporotnikFractal(PaprotnikData);
|
||||
SimplePaprotnik := new PaporotnikFractal(SimplePaprotnikData);
|
||||
Elka := new PaporotnikFractal(ElkaData);
|
||||
|
||||
begin
|
||||
InitWindow(200, 50, WindowWidth , Height, clBlack);
|
||||
Paprotnik.Draw(0, 0, Iterations, Height, Brightness, fast);
|
||||
SimplePaprotnik.Draw(Width, 0, Iterations, Height, Brightness, fast);
|
||||
Elka.Draw(Width*2, 0, Iterations, Height, Brightness, fast);
|
||||
end.
|
51
Samples/Graphics/GraphABC/Fractals/Paporotnik/Paporotnik.pas
Normal file
@ -0,0 +1,51 @@
|
||||
///Модуль для рисования фракталов семейства "Лист папоротника"
|
||||
unit Paporotnik;
|
||||
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
|
||||
///Настройки фрактала
|
||||
PaporotnikFractalInitalData = record
|
||||
data: array of array of real;
|
||||
P0,P1,P2,P3:real;
|
||||
end;
|
||||
|
||||
///Фрактал "Лист папоротника"
|
||||
PaporotnikFractal = class
|
||||
private
|
||||
data: array of array of real;
|
||||
P0,P1,P2,P3:real;
|
||||
public
|
||||
constructor(initdata: PaporotnikFractalInitalData);
|
||||
begin
|
||||
data := initdata.data;
|
||||
P0 := initdata.P0;
|
||||
P1 := initdata.P1;
|
||||
P2 := initdata.P2;
|
||||
P3 := initdata.P3;
|
||||
end;
|
||||
procedure Draw(x0,y0,Iterations,Height,Brightness: integer; fast: boolean);
|
||||
begin
|
||||
var plotx, ploty, x, y : real;
|
||||
var Size := Height/11;
|
||||
var Width := Height div 2;
|
||||
var dx := Width div 2;
|
||||
var dc := Iterations div Brightness;
|
||||
if fast then
|
||||
LockDrawing;
|
||||
for var i:=1 to Iterations do begin
|
||||
var P := Random(100);
|
||||
var rnd := P<P0 ? 0 : P<P1+P0 ? 1 : P<P2+P1+P0 ? 2 : 3;
|
||||
plotx := data[rnd,0]*x + data[rnd,1]*y;
|
||||
ploty := data[rnd,2]*x + data[rnd,3]*y + data[rnd,5];
|
||||
x := plotx;
|
||||
y := ploty;
|
||||
SetPixel(x0+Round(x*Size) + dx, y0+Height - Round(y*Size), GreenColor(byte(30 + (i div dc))));
|
||||
end;
|
||||
if fast then
|
||||
UnlockDrawing;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
@ -0,0 +1,41 @@
|
||||
///Константы задающие фракталы
|
||||
unit PaporotnikData;
|
||||
|
||||
uses Paporotnik;
|
||||
|
||||
var
|
||||
///Папоротник с изогнутым листом
|
||||
PaprotnikData: PaporotnikFractalInitalData := (
|
||||
data: (( 0.0000, 0.0000, 0.0000, 0.1600, 0, 0.0000),
|
||||
( 0.8500, 0.0400, -0.0400, 0.8500, 0, 1.6000),
|
||||
( 0.1667, -0.2887, 0.2887, 0.1667, 0, 1.6000),
|
||||
(-0.1667, 0.2887, 0.2887, 0.1667, 0, 0.4400));
|
||||
P0: 3;
|
||||
P1: 83;
|
||||
P2: 7;
|
||||
P3: 7);
|
||||
|
||||
///Папоротник с прямым листом
|
||||
SimplePaprotnikData: PaporotnikFractalInitalData := (
|
||||
data: (( 0.00, 0.00, 0.00, 0.16, 0, 0.00),
|
||||
( 0.85, 0.00, 0.00, 0.85, 0, 1.60),
|
||||
( 0.20, -0.26, 0.23, 0.22, 0, 1.60),
|
||||
(-0.20, 0.26, 0.23, 0.22, 0, 1.60));
|
||||
P0: 3;
|
||||
P1: 83;
|
||||
P2: 7;
|
||||
P3: 7);
|
||||
|
||||
///Елка
|
||||
ElkaData: PaporotnikFractalInitalData := (
|
||||
data: (( 0.1000, 0.0000, 0.0000, 0.1600, 0, 0.0000),
|
||||
( 0.8500, 0.0000, 0.0000, 0.8500, 0, 1.6000),
|
||||
(-0.1667, -0.2887, 0.2887, -0.1667, 0, 1.6000),
|
||||
(-0.1667, 0.2887, -0.2887, -0.1667, 0, 1.6000));
|
||||
P0: 1;
|
||||
P1: 85;
|
||||
P2: 7;
|
||||
P3: 7);
|
||||
|
||||
|
||||
end.
|
42
Samples/Graphics/GraphABC/Fractals/Paporotnik1.pas
Normal file
@ -0,0 +1,42 @@
|
||||
// Демонстрация фрактальной графики. Папоротник
|
||||
// Для каждой точки комплексной плоскости z=(x,y) выполняем итерационный процесс z=z^2+c, c=(cx,cy)
|
||||
// Считаем количество итераций i до тех пор пока не выполнится условие |x|>max и |y|>max
|
||||
// После этого рисуем точку x,y с насыщенностью красного цвета, пропорциональной i
|
||||
uses GraphABC,Utils;
|
||||
|
||||
const
|
||||
max = 10;
|
||||
cx = 0.251;
|
||||
cy = 0.95;
|
||||
coef1 = 0.5;
|
||||
coef2 = 0.88;
|
||||
|
||||
scalex = 0.001;
|
||||
scaley = 0.001;
|
||||
dx = 200;
|
||||
dy = 130;
|
||||
|
||||
begin
|
||||
Window.Title := 'Фракталы: папоротник';
|
||||
SetWindowSize(800,600);
|
||||
CenterWindow;
|
||||
for var ix:=0 to Window.Width-1 do
|
||||
for var iy:=0 to Window.Height-1 do
|
||||
begin
|
||||
var x := scalex*(ix-dx);
|
||||
var y := scaley*(iy-dy);
|
||||
var i := 1;
|
||||
while i<255 do
|
||||
begin
|
||||
var x1 := coef1*x*x-coef2*y*y+cx;
|
||||
var y1 := x*y+cy;
|
||||
x := x1;
|
||||
y := y1;
|
||||
if (abs(x)>max) and (abs(y)>max) then break;
|
||||
i += 1;
|
||||
end;
|
||||
if i>=255 then SetPixel(ix,iy,clRed)
|
||||
else SetPixel(ix,iy,RGB(255,255-i,255-i));
|
||||
end;
|
||||
writeln('Время расчета = ',Milliseconds/1000,' с');
|
||||
end.
|
9
Samples/Graphics/GraphABC/Graphics/DrawFunc.pas
Normal file
@ -0,0 +1,9 @@
|
||||
uses GraphABC;
|
||||
|
||||
begin
|
||||
Brush.Color := ARGB(0,0,0,0); // ïðîçðà÷íàÿ êèñòü
|
||||
Draw(x->x*sin(x),-20,20);
|
||||
Draw(sin);
|
||||
Draw(cos);
|
||||
Draw(exp);
|
||||
end.
|
27
Samples/Graphics/GraphABC/Graphics/DrawFunc2.pas
Normal file
@ -0,0 +1,27 @@
|
||||
uses GraphABC;
|
||||
|
||||
function System.Drawing.Rectangle.Scale(m: real): System.Drawing.Rectangle;
|
||||
begin
|
||||
Result := Self;
|
||||
Result.Width := Trunc(Result.Width * m);
|
||||
Result.Height := Trunc(Result.Height * m)
|
||||
end;
|
||||
|
||||
function System.Drawing.Rectangle.Move(dx,dy: integer): System.Drawing.Rectangle;
|
||||
begin
|
||||
Result := Self;
|
||||
Result.X := Result.X + dx;
|
||||
Result.Y := Result.Y + dy;
|
||||
end;
|
||||
|
||||
begin
|
||||
var r := ClientRectangle;
|
||||
r := r.Scale(0.5);
|
||||
var r1 := r.Move(r.Width,0);
|
||||
var r2 := r.Move(0,r.Height);
|
||||
var r3 := r.Move(r.Width,r.Height);
|
||||
Draw(x->x*sin(x),-20,20,r);
|
||||
Draw(sin,r1);
|
||||
Draw(cos,r2);
|
||||
Draw(exp,20,10,r3);
|
||||
end.
|
11
Samples/Graphics/GraphABC/Hypno.pas
Normal file
@ -0,0 +1,11 @@
|
||||
// Иллюстрация прозрачности
|
||||
uses GraphABC;
|
||||
|
||||
begin
|
||||
for var Transparency:=0 to 255 do
|
||||
begin
|
||||
Brush.Color := ARGB(Transparency,Random(256),Random(256),Random(256));
|
||||
FillCircle(Random(Window.Width),Random(Window.Height),Random(20,60));
|
||||
sleep(100);
|
||||
end;
|
||||
end.
|
51
Samples/Graphics/GraphABC/Mosaic.pas
Normal file
@ -0,0 +1,51 @@
|
||||
// Мозаика. Квадратики случайным образом меняются местами
|
||||
uses GraphABC;
|
||||
|
||||
const
|
||||
w = 25;
|
||||
w1 = 1;
|
||||
m = 50;
|
||||
n = 70;
|
||||
x0 = 0;
|
||||
y0 = 0;
|
||||
delay = 10;
|
||||
|
||||
var a: array [0..n,0..m] of Color;
|
||||
|
||||
begin
|
||||
Window.Title := 'Мозаика';
|
||||
Window.SetSize(800,600);
|
||||
|
||||
// Заполнение массива случайными цветами
|
||||
for var i:=0 to n-1 do
|
||||
for var j:=0 to m-1 do
|
||||
begin
|
||||
a[i,j] := clRandom;
|
||||
Brush.Color := a[i,j];
|
||||
FillRect(x0+i*w,y0+j*w,x0+(i+1)*w-w1,y0+(j+1)*w-w1);
|
||||
end;
|
||||
|
||||
var k := 0;
|
||||
while true do
|
||||
begin
|
||||
k += 1;
|
||||
if k mod 1000 = 0 then
|
||||
begin
|
||||
k := 0;
|
||||
Sleep(delay);
|
||||
end;
|
||||
|
||||
var i := Random(1,n-2);
|
||||
var j := Random(1,m-2);
|
||||
var di := Random(-1,1);
|
||||
var dj := Random(-1,1);
|
||||
var i1 := i+di;
|
||||
var j1 := j+dj;
|
||||
Swap(a[i,j],a[i1,j1]);
|
||||
|
||||
Brush.Color := a[i,j];
|
||||
FillRect(x0+i*w,y0+j*w,x0+(i+1)*w-w1,y0+(j+1)*w-w1);
|
||||
Brush.Color := a[i1,j1];
|
||||
FillRect(x0+i1*w,y0+j1*w,x0+(i1+1)*w-w1,y0+(j1+1)*w-w1);
|
||||
end;
|
||||
end.
|
5
Samples/Graphics/GraphABC/MouseDownEvent.pas
Normal file
@ -0,0 +1,5 @@
|
||||
uses GraphABC;
|
||||
|
||||
begin
|
||||
OnMouseDown := (x,y,mb) -> Circle(x,y,5);
|
||||
end.
|
7
Samples/Graphics/GraphABC/MouseDraw.pas
Normal file
@ -0,0 +1,7 @@
|
||||
uses GraphABC;
|
||||
|
||||
begin
|
||||
Window.Title := 'Ðèñîâàíèå ìûøüþ';
|
||||
OnMouseDown := (x,y,mb) -> MoveTo(x,y);
|
||||
OnMouseMove := (x,y,mb) -> if mb=1 then LineTo(x,y);
|
||||
end.
|
7
Samples/Graphics/GraphABC/SetPixel.pas
Normal file
@ -0,0 +1,7 @@
|
||||
uses GraphABC;
|
||||
|
||||
begin
|
||||
for var x:=0 to Window.Width-1 do
|
||||
for var y:=0 to Window.Height-1 do
|
||||
SetPixel(x,y,RGB(2*x-y,x-3*y,x+y));
|
||||
end.
|
24
Samples/Graphics/GraphABC/Stamps/Stamp1.pas
Normal file
@ -0,0 +1,24 @@
|
||||
// Штампы - это классы графических фигур, хранящие их параметры
|
||||
// В любой момент можно нарисовать графическую фигуру, вызвав метод Stamp.
|
||||
|
||||
// Класс штампа прямоугольника
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
RectangleStamp = auto class
|
||||
x,y,w,h: integer;
|
||||
procedure Stamp;
|
||||
begin
|
||||
Rectangle(x,y,x+w,y+h);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var r := new RectangleStamp(30,30,50,50);
|
||||
r.Stamp;
|
||||
for var i:=1 to 10 do
|
||||
begin
|
||||
r.x := r.x + r.w +5;
|
||||
r.Stamp;
|
||||
end;
|
||||
end.
|
37
Samples/Graphics/GraphABC/Stamps/Stamp2.pas
Normal file
@ -0,0 +1,37 @@
|
||||
// Класс штампа ряда прямоугольников
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
RectangleStamp = auto class
|
||||
x,y,w,h: integer;
|
||||
procedure Stamp;
|
||||
begin
|
||||
Rectangle(x,y,x+w,y+h);
|
||||
end;
|
||||
end;
|
||||
|
||||
RowRectanglesStamp = auto class
|
||||
x,y,w,h,n: integer;
|
||||
procedure Stamp;
|
||||
begin
|
||||
var r := new RectangleStamp(x,y,w,h);
|
||||
r.Stamp;
|
||||
for var i:=1 to n-1 do
|
||||
begin
|
||||
r.x += r.w + 5;
|
||||
r.Stamp;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
const n=8;
|
||||
|
||||
begin
|
||||
var r := new RowRectanglesStamp(30,30,50,50,n);
|
||||
r.Stamp;
|
||||
for var i:=1 to n-1 do
|
||||
begin
|
||||
r.y += r.h + 5;
|
||||
r.Stamp;
|
||||
end;
|
||||
end.
|
28
Samples/Graphics/GraphABC/Stamps/Stamp3.pas
Normal file
@ -0,0 +1,28 @@
|
||||
// Класс штампа прямоугольника с методами увеличения-уменьшения
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
RectangleStamp = auto class
|
||||
x,y,w,h: integer;
|
||||
procedure Stamp := Rectangle(x,y,x+w,y+h);
|
||||
procedure Increase(dw,dh: integer);
|
||||
begin
|
||||
w += dw; h += dh;
|
||||
end;
|
||||
procedure Decrease(dw,dh: integer) := Increase(-dw,-dh);
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var r := new RectangleStamp(100,100,300,300);
|
||||
r.Stamp;
|
||||
while r.w>2 do
|
||||
begin
|
||||
r.Decrease(8,8);
|
||||
r.MoveOn(4,4);
|
||||
r.Stamp;
|
||||
end;
|
||||
end.
|
39
Samples/Graphics/GraphABC/Stamps/Stamp4.pas
Normal file
@ -0,0 +1,39 @@
|
||||
// Класс штампа прямоугольника с методами увеличения-уменьшения от центра
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
RectangleStamp = class
|
||||
x,y,w,h: integer;
|
||||
constructor (xx,yy,ww,hh: integer);
|
||||
begin
|
||||
x := xx; y := yy;
|
||||
w := ww; h := hh;
|
||||
end;
|
||||
procedure Stamp;
|
||||
begin
|
||||
Rectangle(x,y,x+w,y+h);
|
||||
end;
|
||||
procedure IncreaseFromCenter(dw: integer);
|
||||
begin
|
||||
w += dw*2; h += dw*2;
|
||||
x -= dw; y -= dw;
|
||||
end;
|
||||
procedure DecreaseFromCenter(dw: integer);
|
||||
begin
|
||||
IncreaseFromCenter(-dw);
|
||||
end;
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var r := new RectangleStamp(100,100,300,300);
|
||||
r.Stamp;
|
||||
while r.w>2 do
|
||||
begin
|
||||
r.DecreaseFromCenter(4);
|
||||
r.Stamp;
|
||||
end;
|
||||
end.
|
36
Samples/Graphics/GraphABC/Stamps/Stamp5.pas
Normal file
@ -0,0 +1,36 @@
|
||||
// Класс штампа треугольника
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
TriangleStamp = auto class
|
||||
x,y,w,orient: integer;
|
||||
procedure Stamp;
|
||||
begin
|
||||
MoveTo(x,y);
|
||||
var dx := w;
|
||||
var dy := w;
|
||||
case orient of
|
||||
2: dx := -dx;
|
||||
3: dy := -dy;
|
||||
4: begin dx := -dx; dy := -dy; end;
|
||||
end;
|
||||
LineTo(x+dx,y);
|
||||
LineTo(x,y+dy);
|
||||
LineTo(x,y);
|
||||
end;
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var r := new TriangleStamp(200,200,100,1);
|
||||
r.Stamp;
|
||||
r.orient := 2;
|
||||
r.Stamp;
|
||||
r.orient := 3;
|
||||
r.Stamp;
|
||||
r.orient := 4;
|
||||
r.Stamp;
|
||||
end.
|
77
Samples/Graphics/GraphABC/Stamps/StampCompound.pas
Normal file
@ -0,0 +1,77 @@
|
||||
// Класс штампа составного объекта
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
TextStamp = class
|
||||
x,y,pt: integer;
|
||||
Text: string;
|
||||
constructor (xx,yy,ppt: integer; t: string);
|
||||
begin
|
||||
x := xx; y := yy;
|
||||
pt := ppt;
|
||||
text := t;
|
||||
end;
|
||||
procedure Stamp;
|
||||
begin
|
||||
Font.Size := pt;
|
||||
Brush.Color := clWhite;
|
||||
TextOut(x,y,text);
|
||||
end;
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
RectangleStamp = class
|
||||
x,y,w,h: integer;
|
||||
constructor (xx,yy,ww,hh: integer);
|
||||
begin
|
||||
x := xx; y := yy;
|
||||
w := ww; h := hh;
|
||||
end;
|
||||
procedure Stamp;
|
||||
begin
|
||||
Brush.Color := clRandom;
|
||||
Rectangle(x,y,x+w,y+h);
|
||||
end;
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
RectWithTextStamp = class
|
||||
x,y,w,h: integer;
|
||||
Text: string;
|
||||
constructor (xx,yy,ww,hh: integer; t: string);
|
||||
begin
|
||||
x := xx; y := yy;
|
||||
w := ww; h := hh;
|
||||
text := t;
|
||||
end;
|
||||
procedure Draw;
|
||||
begin
|
||||
var r := new RectangleStamp(x,y,w,-h);
|
||||
var t := new TextStamp(x,y+3,10,Text);
|
||||
r.Stamp;
|
||||
t.Stamp;
|
||||
end;
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var a: array of integer := (100,70,50,120,90,200,111,150,230,11,44);
|
||||
var rt := new RectWithTextStamp(100,300,30,a[0],IntToStr(a[0]));
|
||||
rt.Draw;
|
||||
for var i:=1 to a.Length-1 do
|
||||
begin
|
||||
rt.MoveOn(40,0);
|
||||
rt.h := a[i];
|
||||
rt.Text := IntToStr(a[i]);
|
||||
rt.Draw;
|
||||
end;
|
||||
end.
|
51
Samples/Graphics/GraphABC/Stamps/StampCross.pas
Normal file
@ -0,0 +1,51 @@
|
||||
// Класс штампа креста
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
CrossStamp = class
|
||||
x,y,w: integer;
|
||||
constructor (xx,yy,ww: integer);
|
||||
begin
|
||||
x := xx; y := yy;
|
||||
w := ww;
|
||||
end;
|
||||
procedure Stamp;
|
||||
begin
|
||||
MoveTo(x,y);
|
||||
LineTo(x+w,y);
|
||||
LineTo(x+w,y+w);
|
||||
LineTo(x+2*w,y+w);
|
||||
LineTo(x+2*w,y);
|
||||
LineTo(x+3*w,y);
|
||||
LineTo(x+3*w,y-w);
|
||||
LineTo(x+2*w,y-w);
|
||||
LineTo(x+2*w,y-2*w);
|
||||
LineTo(x+w,y-2*w);
|
||||
LineTo(x+w,y-w);
|
||||
LineTo(x,y-w);
|
||||
LineTo(x,y);
|
||||
end;
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
procedure MoveOnRel(a,b: integer);
|
||||
begin
|
||||
MoveOn(a*w,b*w);
|
||||
end;
|
||||
function Clone := new CrossStamp(x,y,w);
|
||||
end;
|
||||
|
||||
begin
|
||||
var r := new CrossStamp(100,150,20);
|
||||
for var k:=1 to 2 do
|
||||
begin
|
||||
var r1 := r.Clone;
|
||||
for var i:=1 to 8 do
|
||||
begin
|
||||
r1.Stamp;
|
||||
r1.MoveOnRel(2,1);
|
||||
end;
|
||||
r.MoveOnRel(-1,2);
|
||||
end;
|
||||
end.
|
79
Samples/Graphics/GraphABC/Stamps/StampFunc.pas
Normal file
@ -0,0 +1,79 @@
|
||||
// Êëàññ øòàìïà ãðàôèêà ôóíêöèè
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
FuncType = function (r: real): real;
|
||||
FuncStamp = class
|
||||
xs0,ys0,ws,hs: integer;
|
||||
xf0,yf0,wf,hf: real;
|
||||
f: FuncType;
|
||||
constructor (xs0p,ys0p,xs1p,ys1p: integer; xf0p,yf0p,xf1p,yf1p: real; ff: FuncType);
|
||||
begin
|
||||
SetScreenWindow(xs0p,ys0p,xs1p,ys1p);
|
||||
SetFuncWindow(xf0p,yf0p,xf1p,yf1p);
|
||||
f := ff;
|
||||
end;
|
||||
function WorldToScreenX(xf: real): integer;
|
||||
begin
|
||||
var a := ws/wf;
|
||||
var b := xs0-a*xf0;
|
||||
Result := Round(a * xf + b);
|
||||
end;
|
||||
function WorldToScreenY(yf: real): integer;
|
||||
begin
|
||||
var c := hs/hf;
|
||||
var d := ys0-c*yf0;
|
||||
Result := hs + 2*ys0 - Round(c * yf + d);
|
||||
end;
|
||||
procedure Stamp;
|
||||
const n = 100;
|
||||
begin
|
||||
Pen.Color := Color.Gray;
|
||||
Rectangle(xs0,ys0,xs0+ws,ys0+hs);
|
||||
Pen.Color := Color.Black;
|
||||
var x := xf0;
|
||||
var y := f(x);
|
||||
var h := wf/n;
|
||||
var xs := WorldToScreenX(x);
|
||||
var ys := WorldToScreenY(y);
|
||||
MoveTo(xs,ys);
|
||||
for var i:=1 to n do
|
||||
begin
|
||||
x += h;
|
||||
y := f(x);
|
||||
xs := WorldToScreenX(x);
|
||||
ys := WorldToScreenY(y);
|
||||
LineTo(xs,ys);
|
||||
end;
|
||||
end;
|
||||
procedure SetScreenWindow(xs0p,ys0p,xs1p,ys1p: integer);
|
||||
begin
|
||||
xs0 := xs0p; ys0 := ys0p;
|
||||
ws := xs1p-xs0p; hs := ys1p-ys0p;
|
||||
end;
|
||||
procedure SetFuncWindow(xf0p,yf0p,xf1p,yf1p: real);
|
||||
begin
|
||||
xf0 := xf0p; yf0 := yf0p;
|
||||
wf := xf1p-xf0p; hf := yf1p-yf0p;
|
||||
end;
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
xs0 += dx; ys0 += dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var fs := new FuncStamp(10,10,310,230,0,-2*Pi,2*Pi,2*Pi,x->x*sin(5*x));
|
||||
fs.Stamp;
|
||||
fs.MoveOn(320,0);
|
||||
fs.SetFuncWindow(-Pi,-1,Pi,1);
|
||||
fs.f := sin;
|
||||
fs.Stamp;
|
||||
fs.MoveOn(-320,240);
|
||||
fs.f := cos;
|
||||
fs.Stamp;
|
||||
fs.MoveOn(320,0);
|
||||
fs.SetFuncWindow(-2*Pi,-2,2*Pi,2);
|
||||
fs.f := x->sin(3*x)+sin(4*x);
|
||||
fs.Stamp;
|
||||
end.
|
49
Samples/Graphics/GraphABC/Stamps/StampPoly.pas
Normal file
@ -0,0 +1,49 @@
|
||||
// Класс штампа правильного многоугольника
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
RegularPolygonStamp = class
|
||||
x,y,r: real;
|
||||
n: integer;
|
||||
constructor (xx,yy,rr: real; nn: integer);
|
||||
begin
|
||||
x := xx; y := yy;
|
||||
r := rr; n := nn;
|
||||
end;
|
||||
procedure Stamp;
|
||||
begin
|
||||
var t := 0.0;
|
||||
var xr := r*cos(t);
|
||||
var yr := r*sin(t);
|
||||
MoveTo(Round(x + xr),Round(y + yr));
|
||||
for var i:=1 to n do
|
||||
begin
|
||||
t += 2*Pi/n;
|
||||
xr := Round(r*cos(t));
|
||||
yr := Round(r*sin(t));
|
||||
LineTo(Round(x + xr),Round(y + yr));
|
||||
end;
|
||||
end;
|
||||
procedure MoveOn(dx,dy: real);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
function Clone: RegularPolygonStamp;
|
||||
begin
|
||||
Result := new RegularPolygonStamp(x,y,r,n);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var r := new RegularPolygonStamp(Window.Center.X,Window.Center.Y,50,6);
|
||||
r.Stamp;
|
||||
var t := 2*Pi/12;
|
||||
var rr := r.r*sqrt(3)+10;
|
||||
for var i:=1 to 6 do
|
||||
begin
|
||||
var r1 := r.Clone;
|
||||
r1.MoveOn(rr*cos(t),rr*sin(t));
|
||||
r1.Stamp;
|
||||
t += 2*Pi/6;
|
||||
end;
|
||||
end.
|
25
Samples/Graphics/GraphABC/Stamps/StampText.pas
Normal file
@ -0,0 +1,25 @@
|
||||
// Класс штампа текста
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
TextStamp = auto class
|
||||
x,y,pt: integer;
|
||||
Text: string;
|
||||
procedure Stamp;
|
||||
begin
|
||||
Font.Size := pt;
|
||||
TextOut(x,y,text);
|
||||
end;
|
||||
procedure MoveOn(dx,dy: integer);
|
||||
begin
|
||||
x += dx; y += dy;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var txt := new TextStamp(200,200,14,'Привет!');
|
||||
txt.Stamp;
|
||||
txt.MoveOn(0,40);
|
||||
txt.Text := 'До свидания!';
|
||||
txt.Stamp;
|
||||
end.
|
17
Samples/Graphics/GraphABC/Star.pas
Normal file
@ -0,0 +1,17 @@
|
||||
uses GraphABC;
|
||||
|
||||
const
|
||||
n = 17; // количество точек
|
||||
n1 = 7; // через сколько точек соединять
|
||||
|
||||
begin
|
||||
var a := -Pi/2;
|
||||
var Center := Window.Center;
|
||||
var Radius := Window.Height/2.2;
|
||||
MoveTo(Round(Center.X+Radius*cos(a)),Round(Center.Y+Radius*sin(a)));
|
||||
for var i:=1 to n do
|
||||
begin
|
||||
a += n1*2*Pi/n;
|
||||
LineTo(Round(Center.X+Radius*cos(a)),Round(Center.Y+Radius*sin(a)));
|
||||
end;
|
||||
end.
|
82
Samples/Graphics/GraphABC/Tentacles.pas
Normal file
@ -0,0 +1,82 @@
|
||||
//Программа "Щупальца". Порт с midletPascal :)
|
||||
|
||||
uses
|
||||
GraphABC;
|
||||
|
||||
const
|
||||
S = 14; // Кол-во щупалец
|
||||
N = 18; // Кол-во звеньев в каждом из них
|
||||
W = 2; //Ширина щупалец
|
||||
|
||||
var
|
||||
i, j: Integer;
|
||||
x, y: Real;
|
||||
tx, ty: Real;
|
||||
k, d: Real;
|
||||
|
||||
// Углы поворота звеньев относительно друг-друга
|
||||
a: array [1..N] of Real;
|
||||
|
||||
// Длина одного звена
|
||||
len: Real;
|
||||
|
||||
begin
|
||||
Pen.Width := W;
|
||||
SetWindowSize(320, 320);
|
||||
SetWindowTitle('Щупальца');
|
||||
|
||||
if Window.Width > Window.Height then
|
||||
len := Window.Height / 1.8 / N
|
||||
else
|
||||
len := Window.Width / 1.8 / N;
|
||||
k := random(360) * pi / 180;
|
||||
d := pi * 2 / S;
|
||||
|
||||
var k1 := 1;
|
||||
|
||||
// Главный цикл
|
||||
repeat
|
||||
|
||||
if Window.Width > Window.Height then
|
||||
len := Window.Height / 1.8 / N
|
||||
else
|
||||
len := Window.Width / 1.8 / N;
|
||||
|
||||
LockDrawing(); //Блокируем рисование(для оптимизации)
|
||||
ClearWindow(ClBlack); // Стираем всё
|
||||
|
||||
// Расчёт коэфицента поворота
|
||||
if random(50) = 0 then
|
||||
k := random(360) * pi / 180;
|
||||
|
||||
// Поворот всех щупалец
|
||||
a[1] := a[1] + sin(k) / 15;
|
||||
|
||||
// Интерполяция углов между щупальцами
|
||||
for i := 2 to N do
|
||||
a[i] := a[i] + (a[i - 1] - a[i]) * 0.1;
|
||||
for j := 0 to S - 1 do
|
||||
begin
|
||||
x := 0.5 * Window.Width;
|
||||
y := 0.5 * Window.Height;
|
||||
for i := 2 to N do
|
||||
begin
|
||||
SetPenColor(Color.FromArgb(255, trunc(255 - 255 * i / N), 255));
|
||||
|
||||
// Немного школьной тригонометрии :)
|
||||
tx := x + cos(j * d + a[i]) * len;
|
||||
ty := y + sin(j * d + a[i]) * len;
|
||||
Line(trunc(x), trunc(y), trunc(tx), trunc(ty));
|
||||
x := tx;
|
||||
y := ty;
|
||||
end;
|
||||
end;
|
||||
Redraw(); //Перерисуем изображение
|
||||
|
||||
k1 += 1;
|
||||
SetWindowTitle('Щупальца( Средн. FPS ' + Format('{0,5:f2}',k1/Milliseconds*1000)+')');
|
||||
|
||||
sleep(5);
|
||||
until false;
|
||||
|
||||
end.
|
85
Samples/Graphics/GraphABC/ThroughTheUniverse.pas
Normal file
@ -0,0 +1,85 @@
|
||||
//Программа "Скозь вселенную". Порт с midletPascal
|
||||
|
||||
uses GraphABC;
|
||||
|
||||
type
|
||||
// Описываем тип-элемент Звезда
|
||||
TStar = record
|
||||
X, Y, Z : real; // Положение в пространстве
|
||||
end;
|
||||
|
||||
const
|
||||
MAX_STARS = 1000; // Кол-во звёздочек
|
||||
SPEED = 200; // Скорость, в единицах/сек
|
||||
|
||||
var
|
||||
i : Integer;
|
||||
// Наши звёздочки :)
|
||||
Stars : array [1..MAX_STARS] of TStar;
|
||||
// Ширина и высота дисплея
|
||||
scr_W : Integer;
|
||||
scr_H : Integer;
|
||||
// Время
|
||||
time, dt : Integer;
|
||||
|
||||
// Рисует текущую звёздочку (i), цвета (c)
|
||||
procedure SetPix(c: Integer);
|
||||
var
|
||||
sx, sy : Integer;
|
||||
begin
|
||||
// Данные действия, проецируют 3D точку на 2D полоскость дисплея
|
||||
try
|
||||
sx := trunc(scr_W / 2 + Stars[i].X * 200 / (Stars[i].Z + 200));
|
||||
sy := trunc(scr_H / 2 - Stars[i].Y * 200 / (Stars[i].Z + 200));
|
||||
except
|
||||
end;
|
||||
|
||||
try
|
||||
SetPixel(sx, sy, Color.FromArgb(c, c, c));
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
MaximizeWindow();
|
||||
scr_W := Window.Width;
|
||||
scr_H := Window.Height;
|
||||
|
||||
//случайным образом раскидаем звёздочки
|
||||
randomize;
|
||||
for i := 1 to MAX_STARS do
|
||||
begin
|
||||
Stars[i].X := random(scr_W * 4) - scr_W * 2;
|
||||
Stars[i].Y := random(scr_H * 4) - scr_H * 2;
|
||||
Stars[i].Z := random(1900);
|
||||
end;
|
||||
|
||||
// Очистка содержимого дисплея (чёрный цвет)
|
||||
ClearWindow(Color.Black);
|
||||
|
||||
time := Milliseconds;
|
||||
// Главный цикл отрисовки
|
||||
repeat
|
||||
scr_W := Window.Width;
|
||||
scr_H := Window.Height;
|
||||
dt := Milliseconds - time; // Сколько мс прошло, с прошлой отрисовки
|
||||
time := Milliseconds; // Засекаем время
|
||||
for i := 1 to MAX_STARS do
|
||||
begin
|
||||
// Затираем звёздочку с предыдущего кадра
|
||||
SetPix(0);
|
||||
// Изменяем её позицию в зависимости прошедшего с последней отрисовки времени
|
||||
Stars[i].Z := Stars[i].Z - SPEED * dt/1000;
|
||||
// Если звезда "улетела" за позицию камеры - генерируем её вдали
|
||||
if Stars[i].Z <= -200 then
|
||||
begin
|
||||
Stars[i].X := random(scr_W * 4) - scr_W * 2;
|
||||
Stars[i].Y := random(scr_H * 4) - scr_H * 2;
|
||||
Stars[i].Z := 1900; // Откидываем звезду далеко вперёд :)
|
||||
end;
|
||||
// Рисуем звёздочку в новом положении (цвет зависит от Z координаты)
|
||||
SetPix(trunc(255 - 255 * (Stars[i].Z + 200) / 2100));
|
||||
end;
|
||||
sleep(10);
|
||||
until false;
|
||||
end.
|
64
Samples/Graphics/GraphABC/graph3d.pas
Normal file
@ -0,0 +1,64 @@
|
||||
// Пример из пакета KuMir/PMir
|
||||
// Публикуется практически без изменений
|
||||
// Дорог как память :)
|
||||
Uses GraphABC;
|
||||
|
||||
var Xmin,Xmax,Xstep: real;
|
||||
Ymin,Ymax,Ystep,asp: real;
|
||||
dx: integer;
|
||||
|
||||
function f(x,y:real): integer;
|
||||
var r: real;
|
||||
begin
|
||||
r := x*x+y*y+1;
|
||||
f := round(5*asp*(cos(r)/r+0.1))
|
||||
end;
|
||||
|
||||
procedure gr(N : integer);
|
||||
var X,Y: real;
|
||||
i,j,k,Z0,dy: integer;
|
||||
pred: array [1..100] of integer;
|
||||
jj,maxX,maxY: integer;
|
||||
begin
|
||||
Xmin := -4;
|
||||
Xmax := 4;
|
||||
Ymin := -3;
|
||||
Ymax := 3;
|
||||
maxX := 600;
|
||||
maxY := 400;
|
||||
Xstep := dx*(Xmax-Xmin)/maxX;
|
||||
X := Xmin;
|
||||
Ystep := (Ymax-Ymin)/N;
|
||||
Y := Ymin;
|
||||
dy := maxY div N div 2;
|
||||
asp := maxY/8;
|
||||
for i := 1 to N do
|
||||
begin
|
||||
pred[i] := maxY-i*dy-f(X,Y);
|
||||
Y := Y + Ystep
|
||||
end;
|
||||
for jj := 1 to maxX div dx do
|
||||
begin
|
||||
j := jj*dx;
|
||||
X := X + Xstep;
|
||||
Y := Ymin; Z0 := maxY;
|
||||
for i := 1 to N do
|
||||
begin
|
||||
k := maxY-i*dy-f(X,Y);
|
||||
if k<Z0 then
|
||||
begin
|
||||
Line(j-dx,pred[i],j,k);
|
||||
Z0 := k
|
||||
end;
|
||||
pred[i] := Z0;
|
||||
Y := Y+Ystep
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
SetWindowCaption('График функции двух переменных');
|
||||
SetWindowSize(600,400);
|
||||
dx := 2; { разрешение по оси X }
|
||||
gr(100); { количество линий по Y <= MaxN }
|
||||
end.
|
68
Samples/Graphics/GraphABC/graphic.pas
Normal file
@ -0,0 +1,68 @@
|
||||
// Процедура drawGraph рисования графика функции в полном окне
|
||||
// с масштабированием по оси OY
|
||||
// Перерисовывает график при изменении размеров окна
|
||||
uses GraphABC;
|
||||
|
||||
function f(x: real) := x*sin(x)*exp(-0.1*x);
|
||||
|
||||
// l (logical) - логические координаты
|
||||
// s (screen) - физические координаты
|
||||
procedure drawGraph(x1,x2: real; f: real -> real);
|
||||
var
|
||||
xl0,wl,yl0,hl: real;
|
||||
xs0,ws,ys0,hs: integer;
|
||||
|
||||
function LtoSx(xl: real) := round(ws/wl*(xl-xl0)+xs0);
|
||||
function LtoSy(yl: real) := round(hs/hl*(yl-yl0)+ys0);
|
||||
function StoLx(xs: integer) := wl/ws*(xs-xs0)+xl0;
|
||||
|
||||
begin // drawGraph
|
||||
xs0 := 0;
|
||||
ys0 := WindowHeight-1;
|
||||
ws := WindowWidth;
|
||||
hs := WindowHeight-1;
|
||||
|
||||
xl0 := x1;
|
||||
wl := x2-x1;
|
||||
|
||||
var yi: array of real;
|
||||
SetLength(yi,ws+1);
|
||||
|
||||
var min := real.MaxValue;
|
||||
var max := real.MinValue;
|
||||
for var xi:=0 to ws do
|
||||
begin
|
||||
yi[xi] := f(StoLx(xi+xs0));
|
||||
if yi[xi]<min then
|
||||
min := yi[xi];
|
||||
if yi[xi]>max then
|
||||
max := yi[xi];
|
||||
end;
|
||||
|
||||
yl0 := min;
|
||||
hl := -(max-min);
|
||||
|
||||
// Нарисовать оси системы координат
|
||||
Line(0,LtoSy(0),ws,LtoSy(0));
|
||||
Line(LtoSx(0),0,LtoSx(0),hs);
|
||||
|
||||
Pen.Color := clBlue;
|
||||
MoveTo(xs0,LtoSy(yi[0]));
|
||||
for var xi:=xs0+1 to xs0+ws do
|
||||
LineTo(xi,LtoSy(yi[xi-xs0]));
|
||||
end;
|
||||
|
||||
procedure Resize;
|
||||
begin
|
||||
ClearWindow;
|
||||
drawGraph(0,60,f);
|
||||
Redraw;
|
||||
end;
|
||||
|
||||
begin
|
||||
LockDrawing;
|
||||
SetWindowCaption('График функции: масштабирование');
|
||||
drawGraph(0,60,f);
|
||||
Redraw;
|
||||
OnResize := Resize;
|
||||
end.
|
27
Samples/Graphics/GraphABC/rain.pas
Normal file
@ -0,0 +1,27 @@
|
||||
// Имитация кругов на воде от капель дождя
|
||||
uses GraphABC;
|
||||
|
||||
const speed = 2;
|
||||
|
||||
procedure Kaplia(x0,y0: integer);
|
||||
begin
|
||||
var r := 1;
|
||||
for var i:=0 to 63 do
|
||||
begin
|
||||
Pen.Color := RGB(i*4,i*4,i*4);
|
||||
Circle(x0,y0,r);
|
||||
if i mod speed = 0 then Sleep(10);
|
||||
Pen.Color := clWhite;
|
||||
Circle(x0,y0,r);
|
||||
r += 2;
|
||||
end;
|
||||
end;
|
||||
|
||||
const z=50;
|
||||
|
||||
begin
|
||||
Window.Title := 'Капли дождя';
|
||||
SetWindowSize(800,600);
|
||||
while True do
|
||||
Kaplia(Random(z,WindowWidth-z),Random(z,WindowHeight-z));
|
||||
end.
|
15
Samples/Graphics/GraphWPF/ArcSector.pas
Normal file
@ -0,0 +1,15 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Дуги и секторы';
|
||||
var (x,y) := (200,Window.Height/2);
|
||||
Circle(x,y,5);
|
||||
for var i:=1 to 18*2 do
|
||||
Arc(x,y,5*i,0,10*i);
|
||||
(x,y) := (600,Window.Height/2);
|
||||
for var i:=1 to 12 do
|
||||
begin
|
||||
Brush.Color := RandomColor;
|
||||
Sector(x,y,180,30*(i-1),30*i);
|
||||
end;
|
||||
end.
|
12
Samples/Graphics/GraphWPF/Clock.pas
Normal file
@ -0,0 +1,12 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Цифровые часы';
|
||||
Font.Size := 180;
|
||||
while True do
|
||||
begin
|
||||
DrawText(Window.ClientRect,System.DateTime.Now.ToLongTimeString,Colors.Red);
|
||||
Sleep(1000);
|
||||
Window.Clear;
|
||||
end;
|
||||
end.
|
36
Samples/Graphics/GraphWPF/CurjaMurja.pas
Normal file
@ -0,0 +1,36 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Всякая Курья Мурья';
|
||||
Pen.Width := 0.5;
|
||||
Brush.Color := RGB(128,200,100);
|
||||
Ellipse(100,100,30,20);
|
||||
Brush.Color := RandomColor;
|
||||
Circle(170,100,20);
|
||||
Brush.Color := RandomColor;
|
||||
Rectangle(220,80,70,50);
|
||||
Line(220,80,220+70,80+50);
|
||||
//DrawImage(200,140,'cofe.jpg');
|
||||
Brush.Color := RGB(200,200,255);
|
||||
Polygon(Arr(Pnt(20,20),Pnt(20,120),Pnt(120,20)));
|
||||
Brush.Color := Colors.Black;
|
||||
for var i:=0 to 400 do
|
||||
Rectangle(1+2*i,2,0,0);
|
||||
Font.Size := 30;
|
||||
Font.Color := Colors.Red;
|
||||
TextOut(0,0,'Hello');
|
||||
Font.Size := 40;
|
||||
Font.Color := Colors.Blue;
|
||||
Font.Name := 'Times New Roman';
|
||||
Font.Style := FontStyle.BoldItalic;
|
||||
TextOut(200,0,'Привет');
|
||||
Sleep(1000);
|
||||
Window.Save('1.png');
|
||||
Window.Title := 'Сохранили';
|
||||
Sleep(1000);
|
||||
Window.Clear;
|
||||
Window.Title := 'Очистили';
|
||||
Sleep(1000);
|
||||
Window.Load('1.png');
|
||||
Window.Title := 'Загрузили';
|
||||
end.
|
16
Samples/Graphics/GraphWPF/DrawCircleByMouse.pas
Normal file
@ -0,0 +1,16 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
var x1,y1: real;
|
||||
var c: Color;
|
||||
OnMouseDown := procedure(x,y,mb) -> begin
|
||||
(x1,y1) := (x,y);
|
||||
c := RandomColor;
|
||||
end;
|
||||
OnMouseMove := procedure(x,y,mb) -> if mb=1 then
|
||||
begin
|
||||
var r := Sqrt(Sqr(x1-x)+Sqr(y1-y));
|
||||
Window.Clear;
|
||||
Circle(x1,y1,r,c);
|
||||
end;
|
||||
end.
|
11
Samples/Graphics/GraphWPF/DrawGraphic.pas
Normal file
@ -0,0 +1,11 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Графики функций';
|
||||
var ww := Window.Width / 2;
|
||||
var hh := Window.Height / 2;
|
||||
DrawGraph(x -> sin(4 * x) + cos(3 * x), -5, 5, 0, 0, ww, hh);
|
||||
DrawGraph(x -> x * x, -5, 5, ww - 1, 0, ww, hh);
|
||||
DrawGraph(x -> exp(x), -5, 5, 0, hh-1, ww, hh);
|
||||
DrawGraph(x -> x*cos(2*x-1), -5, 5, ww - 1, hh-1, ww, hh);
|
||||
end.
|
7
Samples/Graphics/GraphWPF/EllRectInWindow.pas
Normal file
@ -0,0 +1,7 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Pen.Width := 1;
|
||||
Rectangle(0,0,Window.Width-1,Window.Height-1);
|
||||
Ellipse((Window.Width-1)/2,(Window.Height-1)/2,(Window.Width-1)/2,(Window.Height-1)/2);
|
||||
end.
|
14
Samples/Graphics/GraphWPF/Ellipses.pas
Normal file
@ -0,0 +1,14 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Рисование эллипсов';
|
||||
Pen.Width := 1;
|
||||
var n := 20000;
|
||||
for var i:=1 to n do
|
||||
begin
|
||||
if i mod 10000 = 0 then
|
||||
Println(i,MillisecondsDelta);
|
||||
Brush.Color := RandomColor;
|
||||
Ellipse(Random(800),Random(600),Random(20),Random(20));
|
||||
end;
|
||||
end.
|
16
Samples/Graphics/GraphWPF/anim1.pas
Normal file
@ -0,0 +1,16 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Простая анимация';
|
||||
var x := 30;
|
||||
Brush.Color := Colors.Beige;
|
||||
Circle(x,50,20);
|
||||
loop 600 do
|
||||
begin
|
||||
Sleep(10);
|
||||
Window.Clear;
|
||||
x += 1;
|
||||
Circle(x,50,20);
|
||||
Window.Title := '' + (Milliseconds div 100)/10;
|
||||
end;
|
||||
end.
|
25
Samples/Graphics/GraphWPF/anim2.pas
Normal file
@ -0,0 +1,25 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Отражение шарика. Вещественное направление движения';
|
||||
Brush.Color := Colors.Beige;
|
||||
var x := 400.0;
|
||||
var y := 300.0;
|
||||
var dx := 2.1;
|
||||
var dy := -1.2;
|
||||
Circle(x,y,20);
|
||||
while True do
|
||||
begin
|
||||
Sleep(10);
|
||||
Window.Clear;
|
||||
x += dx;
|
||||
y += dy;
|
||||
if not x.Between(0,Window.Width) then
|
||||
dx := -dx;
|
||||
if not y.Between(0,Window.Height) then
|
||||
dy := -dy;
|
||||
Circle(x,y,20);
|
||||
if Milliseconds>2000 then
|
||||
Window.Title := 'Секунды: ' + (Milliseconds div 100)/10;
|
||||
end;
|
||||
end.
|
45
Samples/Graphics/GraphWPF/anim4.pas
Normal file
@ -0,0 +1,45 @@
|
||||
uses GraphWPF;
|
||||
|
||||
function RandomReal(a,b: real): real := Random*(b-a)+a;
|
||||
|
||||
type
|
||||
BallInfo = auto class
|
||||
x,y,r,dx,dy: real;
|
||||
c: Color;
|
||||
procedure Move := (x,y) := (x+dx,y+dy);
|
||||
procedure Draw := FillCircle(x,y,r,c);
|
||||
procedure CheckDirection;
|
||||
begin
|
||||
if not x.Between(r,Window.Width-r) then
|
||||
dx := -dx;
|
||||
if not y.Between(r,Window.Height-r) then
|
||||
dy := -dy;
|
||||
end;
|
||||
procedure Step;
|
||||
begin
|
||||
Move;
|
||||
CheckDirection;
|
||||
Draw;
|
||||
end;
|
||||
class function CreateRandomBallArray(n: integer): array of BallInfo;
|
||||
begin
|
||||
var rr := 20;
|
||||
Result := ArrGen(n,i->new BallInfo(RandomReal(rr,Window.Width-rr),
|
||||
RandomReal(rr,Window.Height-rr),RandomReal(5,15),
|
||||
RandomReal(-3,3),RandomReal(-3,3),RandomColor));
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Window.Title := 'Отражение шариков. Анимация на основе кадра';
|
||||
|
||||
var n := 1000;
|
||||
var a := BallInfo.CreateRandomBallArray(n);
|
||||
|
||||
BeginFrameBasedAnimation(()->
|
||||
foreach var ball in a do
|
||||
ball.Step
|
||||
);
|
||||
|
||||
//BeginFrameBasedAnimation(()->a.ForEach(ball->ball.Step));
|
||||
end.
|
6
Samples/Graphics/GraphWPF/mouse1.pas
Normal file
@ -0,0 +1,6 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
OnMouseDown := (x,y,mb) -> if mb=1 then Circle(x,y,5);
|
||||
OnKeyDown := k -> Print(k);
|
||||
end.
|
10
Samples/Graphics/GraphWPF/mouse2.pas
Normal file
@ -0,0 +1,10 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Рисование мышью';
|
||||
Pen.Color := Colors.Blue;
|
||||
Pen.Width := 3;
|
||||
OnMouseDown := (x,y,mb) -> MoveTo(x,y);
|
||||
OnMouseMove := (x,y,mb) -> if mb=1 then LineTo(x,y);
|
||||
OnKeyDown := k -> if k = Key.Space then Window.Save('a.png');
|
||||
end.
|
12
Samples/Graphics/GraphWPF/ВсеТочкиМногоугольника.pas
Normal file
@ -0,0 +1,12 @@
|
||||
uses GraphWPF;
|
||||
|
||||
procedure ВсеТочкиМногоугольника(x0,y0,r: real; n: integer);
|
||||
begin
|
||||
var q := Partition(0,2*Pi,n).Select(a->Pnt(x0 + r * Cos(a), y0 - r * Sin(a)));
|
||||
q.Cartesian(q).ForEach(p->Line(p[0].x,p[0].y,p[1].x,p[1].y,RandomColor));
|
||||
end;
|
||||
|
||||
begin
|
||||
Pen.Width := 0.5;
|
||||
ВсеТочкиМногоугольника(400,300,290,30)
|
||||
end.
|
30
Samples/Graphics/GraphWPF/ВыравниваниеТекста1.pas
Normal file
@ -0,0 +1,30 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Выравнивание шрифта';
|
||||
Font.Size := 20;
|
||||
var (x,y) := (200,200);
|
||||
var (w,h) := (400,200);
|
||||
DrawRectangle(x,y,w,h);
|
||||
DrawText(x,y,w,h,'LeftTop',Alignment.LeftTop);
|
||||
DrawText(x,y,w,h,'LeftCenter',Alignment.LeftCenter);
|
||||
DrawText(x,y,w,h,'LeftBottom',Alignment.LeftBottom);
|
||||
DrawText(x,y,w,h,'CenterTop',Alignment.CenterTop);
|
||||
DrawText(x,y,w,h,'Center');
|
||||
DrawText(x,y,w,h,'CenterBottom',Alignment.CenterBottom);
|
||||
DrawText(x,y,w,h,'RightTop',Alignment.RightTop);
|
||||
DrawText(x,y,w,h,'RightCenter',Alignment.RightCenter);
|
||||
DrawText(x,y,w,h,'RightBottom',Alignment.RightBottom);
|
||||
// Выравнивание относительно точки
|
||||
TextOut(150,100,'PointRightBottom',Alignment.RightBottom);
|
||||
TextOut(150,100,'PointRightTop',Alignment.RightTop);
|
||||
TextOut(150,100,'PointLeftTop',Alignment.LeftTop);
|
||||
TextOut(150,100,'PointLeftBottom',Alignment.LeftBottom);
|
||||
FillCircle(150,100,5,Colors.Red);
|
||||
TextOut(600,100,'PointCenterTop',Alignment.CenterTop);
|
||||
TextOut(600,100,'PointCenterBottom',Alignment.CenterBottom);
|
||||
FillCircle(600,100,5,Colors.Red);
|
||||
TextOut(400,500,'PointLeftCenter',Alignment.LeftCenter);
|
||||
TextOut(400,500,'PointRightCenter',Alignment.RightCenter);
|
||||
FillCircle(400,500,5,Colors.Red);
|
||||
end.
|
34
Samples/Graphics/GraphWPF/ВыравниваниеТекста2.pas
Normal file
@ -0,0 +1,34 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Выравнивание шрифта';
|
||||
Font.Size := 20;
|
||||
|
||||
var sc := 40;
|
||||
SetMathematicCoords;
|
||||
|
||||
var (x,y) := (-5,-2);
|
||||
var (w,h) := (10,4);
|
||||
DrawRectangle(x,y,w,h);
|
||||
DrawText(x,y,w,h,'LeftTop',Alignment.LeftTop);
|
||||
DrawText(x,y,w,h,'LeftCenter',Alignment.LeftCenter);
|
||||
DrawText(x,y,w,h,'LeftBottom',Alignment.LeftBottom);
|
||||
DrawText(x,y,w,h,'CenterTop',Alignment.CenterTop);
|
||||
DrawText(x,y,w,h,'Center');
|
||||
DrawText(x,y,w,h,'CenterBottom',Alignment.CenterBottom);
|
||||
DrawText(x,y,w,h,'RightTop',Alignment.RightTop);
|
||||
DrawText(x,y,w,h,'RightCenter',Alignment.RightCenter);
|
||||
DrawText(x,y,w,h,'RightBottom',Alignment.RightBottom);
|
||||
// Выравнивание относительно точки
|
||||
TextOut(-5,5,'PointRightBottom',Alignment.RightBottom);
|
||||
TextOut(-5,5,'PointRightTop',Alignment.RightTop);
|
||||
TextOut(-5,5,'PointLeftTop',Alignment.LeftTop);
|
||||
TextOut(-5,5,'PointLeftBottom',Alignment.LeftBottom);
|
||||
FillCircle(-5,5,0.1,Colors.Red);
|
||||
TextOut(5,5,'PointCenterTop',Alignment.CenterTop);
|
||||
TextOut(5,5,'PointCenterBottom',Alignment.CenterBottom);
|
||||
FillCircle(5,5,0.1,Colors.Red);
|
||||
TextOut(5,-5,'PointLeftCenter',Alignment.LeftCenter);
|
||||
TextOut(5,-5,'PointRightCenter',Alignment.RightCenter);
|
||||
FillCircle(5,-5,0.1,Colors.Red);
|
||||
end.
|
20
Samples/Graphics/GraphWPF/Многоугольник.pas
Normal file
@ -0,0 +1,20 @@
|
||||
uses GraphWPF;
|
||||
|
||||
procedure Многоугольник(x0,y0,r: real; n: integer);
|
||||
begin
|
||||
var a := Pi / 2;
|
||||
MoveTo(x0 + r * Cos(a), y0 - r * Sin(a));
|
||||
loop n do
|
||||
begin
|
||||
a += 2 * Pi / n;
|
||||
//FillCircle(x0 + r * Cos(a), y0 - r * Sin(a),3,Colors.Black);
|
||||
LineTo(x0 + r * Cos(a), y0 - r * Sin(a));
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var (x0,y0) := (400.0,300.0);
|
||||
var r := 30.0;
|
||||
for var n := 3 to 11 do
|
||||
Многоугольник(x0,y0,r+(n-3)*30,n)
|
||||
end.
|
19
Samples/Graphics/GraphWPF/Светофор.pas
Normal file
@ -0,0 +1,19 @@
|
||||
uses GraphWPF;
|
||||
|
||||
procedure Светофор(x,y,r: real);
|
||||
begin
|
||||
Rectangle(x,y,4*r,10*r,Colors.LightGray);
|
||||
x += 2*r;
|
||||
y += 2*r;
|
||||
var dy := 3*r;
|
||||
|
||||
Circle(x,y,r,Colors.Red);
|
||||
Circle(x,y + dy,r,Colors.Yellow);
|
||||
Circle(x,y + 2*dy,r,Colors.Green);
|
||||
end;
|
||||
|
||||
begin
|
||||
Pen.Width := 2;
|
||||
Window.Title := 'Светофор';
|
||||
Светофор(150,40,50);
|
||||
end.
|
18
Samples/Graphics/GraphWPF/Система координат.pas
Normal file
@ -0,0 +1,18 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Система координат';
|
||||
Font.Size := 20;
|
||||
|
||||
// SetMathematicCoords; // так тоже можно
|
||||
// SetMathematicCoords(-10,10); // так тоже можно
|
||||
SetMathematicCoords(-10,10,-9.2);
|
||||
DrawGrid;
|
||||
|
||||
Print('Видимые координаты:',XMin,XMax,YMin,YMax);
|
||||
|
||||
Polygon(Arr((-3,2),(2,1),(-2,-4)),ARGB(100,255,228,196));
|
||||
TextOut(-3,2,'A(-3,2)',Alignment.RightBottom);
|
||||
TextOut(2,1,'B(2,1)',Alignment.LeftBottom);
|
||||
TextOut(-2,-4,'C(-2,-4)',Alignment.CenterTop);
|
||||
end.
|
16
Samples/Graphics/GraphWPF/ТаблицаУмножения.pas
Normal file
@ -0,0 +1,16 @@
|
||||
uses GraphWPF;
|
||||
|
||||
begin
|
||||
Window.Title := 'Таблица умножения';
|
||||
Font.Size := 16;
|
||||
var n := 9;
|
||||
var w := 40;
|
||||
var (x0,y0) := (50,50);
|
||||
for var i:=0 to n-1 do
|
||||
for var j:=0 to n-1 do
|
||||
begin
|
||||
var (xx,yy) := (x0+i*w,y0+j*w);
|
||||
Rectangle(xx,yy,w,w);
|
||||
DrawText(xx,yy,w,w,(i+1)*(j+1));
|
||||
end;
|
||||
end.
|
7
Samples/LINQ/Consonants.pas
Normal file
@ -0,0 +1,7 @@
|
||||
// Вывод английских согласных
|
||||
var vowel: string := 'aeiouy';
|
||||
|
||||
begin
|
||||
var all := Range('a','z').JoinIntoString('');
|
||||
all.Except(vowel).Println;
|
||||
end.
|
4
Samples/LINQ/Delimiters.pas
Normal file
@ -0,0 +1,4 @@
|
||||
begin
|
||||
Range(#0,#127).Where(c->char.IsLetterOrDigit(c)).Println;
|
||||
Range(#0,#127).Where(c->char.IsPunctuation(c)).Println;
|
||||
end.
|
4
Samples/LINQ/First3Min.pas
Normal file
@ -0,0 +1,4 @@
|
||||
// Первые 3 минимума
|
||||
begin
|
||||
SeqRandom(20).Println.Sorted.Distinct.Take(3).Println;
|
||||
end.
|
6
Samples/LINQ/FunTable.pas
Normal file
@ -0,0 +1,6 @@
|
||||
// Вывод таблицы значений функции sin
|
||||
|
||||
begin
|
||||
Range(0,Pi,20).Select(x->Format('({0:f4}, {1:f7})',x,sin(x))).Println(NewLine);
|
||||
end.
|
||||
|
6
Samples/LINQ/Linq1.pas
Normal file
@ -0,0 +1,6 @@
|
||||
begin
|
||||
Range(1,20).Select(x->x*x).Println;
|
||||
Range(0.0,1.0,10).Println;
|
||||
Range('a','z').Println;
|
||||
end.
|
||||
|
13
Samples/LINQ/Linq2.pas
Normal file
@ -0,0 +1,13 @@
|
||||
function IsPrime(x: integer): boolean;
|
||||
begin
|
||||
var sqx := Round(Sqrt(x));
|
||||
var i := 2;
|
||||
while (i <= sqx) and (x mod i <> 0) do
|
||||
i += 1;
|
||||
Result := i > sqx;
|
||||
end;
|
||||
|
||||
begin
|
||||
Range(2,1000).Where(IsPrime).Print;
|
||||
end.
|
||||
|
18
Samples/LINQ/Linq3.pas
Normal file
@ -0,0 +1,18 @@
|
||||
function IsPrime(x: integer): boolean;
|
||||
begin
|
||||
var sqx := Round(Sqrt(x));
|
||||
var i := 2;
|
||||
while (i <= sqx) and (x mod i <> 0) do
|
||||
i += 1;
|
||||
Result := i > sqx;
|
||||
end;
|
||||
|
||||
var n := 3000000;
|
||||
|
||||
begin
|
||||
writeln(Range(2,n).Where(IsPrime).Count);
|
||||
writeln(Milliseconds);
|
||||
writeln(Range(2,n).AsParallel.Where(IsPrime).Count);
|
||||
writeln(MillisecondsDelta);
|
||||
end.
|
||||
|
7
Samples/LINQ/MonteCarlo.pas
Normal file
@ -0,0 +1,7 @@
|
||||
// Вычисление числа Pi методом Монте-Карло
|
||||
|
||||
begin
|
||||
var n := 10000000;
|
||||
var pp := Range(1,n).Select(x->Rec(Random(),Random())).Where(p->sqr(p.Item1)+sqr(p.Item2)<1).Count/n*4;
|
||||
Print(pp);
|
||||
end.
|
6
Samples/LINQ/Palindroms.pas
Normal file
@ -0,0 +1,6 @@
|
||||
// Вывести все палиндромы в строке, упорядоченные по длине
|
||||
|
||||
begin
|
||||
var s := ' hello aha paap zz ';
|
||||
s.ToWords.Where(w -> w.Inverse = w).OrderBy(s->s.Length).Println(',');
|
||||
end.
|
19
Samples/LINQ/QuickSortLinq.pas
Normal file
@ -0,0 +1,19 @@
|
||||
function QuickSort(a: sequence of integer): sequence of integer;
|
||||
begin
|
||||
if a.Count = 0 then
|
||||
Result := a
|
||||
else
|
||||
begin
|
||||
var head := a.First();
|
||||
var tail := a.Skip(1);
|
||||
Result := QuickSort(tail.Where(x->x<=head)) +
|
||||
head +
|
||||
QuickSort(tail.Where(x->x>head));
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var a := ArrRandom(20);
|
||||
a.Println;
|
||||
QuickSort(a).Println;
|
||||
end.
|
3
Samples/LINQ/Seq.pas
Normal file
@ -0,0 +1,3 @@
|
||||
begin
|
||||
Seq(1,5,3,2,4).Print;
|
||||
end.
|
13
Samples/LINQ/SumInv.pas
Normal file
@ -0,0 +1,13 @@
|
||||
// Сравнение производительности обычного алгоритма накопления суммы
|
||||
// и метода, использующего лямбда-выражение
|
||||
begin
|
||||
var n := 100000000;
|
||||
var q := Range(1,n).Select(x->1/x).Sum();
|
||||
Println(q,MillisecondsDelta);
|
||||
|
||||
var s := 0.0;
|
||||
for var i:=1 to n do
|
||||
s += 1.0/i;
|
||||
|
||||
Println(s,MillisecondsDelta);
|
||||
end.
|
7
Samples/LINQ/TextFileCount.pas
Normal file
@ -0,0 +1,7 @@
|
||||
begin
|
||||
var d := new Dictionary<string,integer>;
|
||||
foreach var s in ReadLines('TextFileCount.pas') do
|
||||
foreach var word in s.ToWords(' ',':',')','(',';','''',',','.','=','<','>','[',']','+','-') do
|
||||
d[word] := d.Get(word) + 1;
|
||||
d.Print(NewLine);
|
||||
end.
|
8
Samples/LINQ/TextFileCount1.pas
Normal file
@ -0,0 +1,8 @@
|
||||
begin
|
||||
var d := Dict('begin' => 0);
|
||||
var delims := Seq(' ',')','(',';','''',',','.','[',']',#10,#13);
|
||||
var words := ReadAllText('TextFileCount1.pas').ToWords(delims);
|
||||
foreach var word in words do
|
||||
d[word] := d.Get(word) + 1;
|
||||
d.Print(NewLine);
|
||||
end.
|
5
Samples/LINQ/Zip.pas
Normal file
@ -0,0 +1,5 @@
|
||||
begin
|
||||
var a := Seq(1,5,3,2,4);
|
||||
var b := Seq(2,3,4,1,6);
|
||||
a.Zip(b,(x,y)->x*y).Print;
|
||||
end.
|
4
Samples/LINQ/Zip2.pas
Normal file
@ -0,0 +1,4 @@
|
||||
begin
|
||||
var a := Seq(1,5,3,2,4);
|
||||
a.Zip(a.Skip(1),(x,y)->y-x).Print;
|
||||
end.
|
13
Samples/LanguageFeatures/AutoClassPoint.pas
Normal file
@ -0,0 +1,13 @@
|
||||
type
|
||||
Point = auto class
|
||||
x,y: integer;
|
||||
procedure MoveOn(dx,dy: integer) := (x,y) := (x+dx,y+dy);
|
||||
function Distance(p: Point) := sqrt(sqr(x-p.x)+sqr(y-p.y));
|
||||
class function operator implicit(t: (integer,integer)): Point := new Point(t[0],t[1]);
|
||||
end;
|
||||
|
||||
begin
|
||||
var p: Point;
|
||||
p := (2,3);
|
||||
Println(p);
|
||||
end.
|
22
Samples/LanguageFeatures/Boxing.pas
Normal file
@ -0,0 +1,22 @@
|
||||
// Упаковка-распаковка размерных типов
|
||||
var
|
||||
i: integer := 2;
|
||||
r: real := 3.14;
|
||||
o: object;
|
||||
|
||||
begin
|
||||
o := i; // Упаковка: объект размерного типа integer упаковывается в объект ссылочного типа,
|
||||
// котрый и присваивается переменной o
|
||||
// Преобразование типов при упаковке - неявное
|
||||
writeln(integer(o)); // Распаковка: из упакованного объекта извлекается значение
|
||||
// Преобразование типов при распаковке - явное
|
||||
o := r;
|
||||
writeln(real(o));
|
||||
|
||||
try // При неверном преобразовании типов генерируется исключение InvalidCastException
|
||||
writeln(shortint(o));
|
||||
except
|
||||
on e: Exception do
|
||||
writeln(e.GetType);
|
||||
end;
|
||||
end.
|
36
Samples/LanguageFeatures/ClassConstructor.pas
Normal file
@ -0,0 +1,36 @@
|
||||
// Иллюстрация использования статических (классовых) конструкторов
|
||||
type
|
||||
Person = class
|
||||
private
|
||||
class arr: array of Person; // Классовое поле. Связано не с переменной класса, а с классом.
|
||||
name: string;
|
||||
age: integer;
|
||||
public
|
||||
class constructor; // Конструктор класса. Вызывается до создания первого объекта класса и до вызова любого классового метода
|
||||
begin
|
||||
writeln(' Вызван классовый конструктор');
|
||||
SetLength(arr,3);
|
||||
arr[0] := new Person('Иванов',20);
|
||||
arr[1] := new Person('Петрова',19);
|
||||
arr[2] := new Person('Попов',35);
|
||||
end;
|
||||
constructor (n: string; a: integer);
|
||||
begin
|
||||
name := n;
|
||||
age := a;
|
||||
end;
|
||||
function ToString: string; override;
|
||||
begin
|
||||
Result := Format('Имя: {0} Возраст: {1}',name,age);
|
||||
end;
|
||||
class function RandomPerson: Person; // Классовый метод. Может обращаться только к классовым полям
|
||||
begin
|
||||
Result := arr[Random(3)];
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
writeln('Случайные персоны');
|
||||
for var i:=1 to 5 do
|
||||
writeln(Person.RandomPerson); // Вызов классового метода
|
||||
end.
|
BIN
Samples/LanguageFeatures/DllTest/MyDll.dll
Normal file
16
Samples/LanguageFeatures/DllTest/MyDll.pas
Normal file
@ -0,0 +1,16 @@
|
||||
// Dll-библиотека
|
||||
library MyDll;
|
||||
|
||||
const n = 10;
|
||||
|
||||
function add(a,b: integer): integer;
|
||||
begin
|
||||
Result := a + b;
|
||||
end;
|
||||
|
||||
procedure PrintPascalABCNET;
|
||||
begin
|
||||
writeln('PascalABC.NET');
|
||||
end;
|
||||
|
||||
end.
|
10
Samples/LanguageFeatures/DllTest/main.pas
Normal file
@ -0,0 +1,10 @@
|
||||
// Это - главная программа
|
||||
// Именами из dll-библиотеки, написанной на PascalABC.NET, можно пользоваться,
|
||||
// не подключая пространства имен
|
||||
{$reference 'mydll.dll'}
|
||||
|
||||
begin
|
||||
PrintPascalABCNET;
|
||||
writeln(n);
|
||||
writeln(add(2,3));
|
||||
end.
|
@ -0,0 +1,6 @@
|
||||
// Ïîìåíÿòü äâå ïîëîâèíû ìàññèâà
|
||||
var a := Arr(1,3,5,7);
|
||||
|
||||
begin
|
||||
a.Skip(2).Concat(a.Take(2)).Print;
|
||||
end.
|
43
Samples/LanguageFeatures/ForeachExamples.pas
Normal file
@ -0,0 +1,43 @@
|
||||
// Пример иллюстрирует всевозможные типы контейнеров,
|
||||
// по которым можно перемещаться с помощью оператора foreach
|
||||
|
||||
const n = 10;
|
||||
|
||||
var
|
||||
a: array [1..n] of integer;
|
||||
b: array of integer;
|
||||
s: set of integer;
|
||||
l: List<integer>;
|
||||
|
||||
begin
|
||||
for var i:=1 to n do
|
||||
a[i] := Random(100);
|
||||
// Цикл foreach по статическому массиву
|
||||
foreach var x in a do
|
||||
Print(x);
|
||||
writeln;
|
||||
|
||||
SetLength(b,n);
|
||||
for var i:=0 to n-1 do
|
||||
b[i] := Random(100);
|
||||
|
||||
// Цикл foreach по динамическому массиву
|
||||
foreach var x in b do
|
||||
Print(x);
|
||||
writeln;
|
||||
|
||||
s := [2..5,10..14];
|
||||
// Цикл foreach по множеству
|
||||
foreach var x in s do
|
||||
Print(x);
|
||||
writeln;
|
||||
|
||||
l := new List<integer>;
|
||||
l.AddRange(b);
|
||||
l.Reverse;
|
||||
// Цикл foreach по списку
|
||||
foreach var x in l do
|
||||
Print(x);
|
||||
writeln;
|
||||
|
||||
end.
|
5
Samples/LanguageFeatures/ForeachForSet.pas
Normal file
@ -0,0 +1,5 @@
|
||||
// Цикл по множеству. Порядок - не по алфавиту, поскольку множества реализованы на базе хеш-таблиц
|
||||
begin
|
||||
foreach var c in ['a'..'z'] do
|
||||
Write(c);
|
||||
end.
|
46
Samples/LanguageFeatures/ForeachIEnumerable.pas
Normal file
@ -0,0 +1,46 @@
|
||||
// Пример иллюстрирует реализацию классом интерфейса IEnumerable
|
||||
// для использования его в операторе foreach
|
||||
type
|
||||
// Генератор чисел Фибоначчи
|
||||
FibGen = class(IEnumerable<integer>, IEnumerator<integer>)
|
||||
private
|
||||
a,b,n,i: integer;
|
||||
public
|
||||
constructor Create(n: integer);
|
||||
begin
|
||||
i := -1;
|
||||
a := 0;
|
||||
b := 1;
|
||||
Self.n := n;
|
||||
end;
|
||||
function Get_Current: integer;
|
||||
begin
|
||||
if i=0 then
|
||||
Result := 1
|
||||
else Result := b;
|
||||
end;
|
||||
function System.Collections.IEnumerator.Get_Current: object := Get_Current;
|
||||
function GetEnumerator: IEnumerator<integer> := Self;
|
||||
function System.Collections.IEnumerable.GetEnumerator: System.Collections.IEnumerator := Self;
|
||||
function MoveNext: boolean;
|
||||
begin
|
||||
i += 1;
|
||||
Result := i<n;
|
||||
if i=0 then exit;
|
||||
(a,b) := (b,a+b);
|
||||
end;
|
||||
property Current: integer read Get_Current;
|
||||
procedure Reset;
|
||||
begin
|
||||
end;
|
||||
procedure Dispose;
|
||||
begin
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
writeln('Числа Фибоначчи');
|
||||
var f := new FibGen(25);
|
||||
foreach var x in f do
|
||||
Print(x);
|
||||
end.
|
34
Samples/LanguageFeatures/FracOperatorOverload.pas
Normal file
@ -0,0 +1,34 @@
|
||||
// Перегрузка операций. Класс "Дробь"
|
||||
type
|
||||
Frac = record
|
||||
private
|
||||
n,m: integer;
|
||||
public
|
||||
constructor (n,m: integer);
|
||||
begin
|
||||
Self.n := n;
|
||||
Self.m := m;
|
||||
end;
|
||||
class function operator+(f1,f2: Frac): Frac; // операция перегружается как классовая функция
|
||||
begin
|
||||
Result.n := f1.n*f2.m+f1.m*f2.n;
|
||||
Result.m := f1.n*f1.m;
|
||||
end;
|
||||
class function operator-(f1,f2: Frac): Frac;
|
||||
begin
|
||||
Result.n := f1.n*f2.m-f1.m*f2.n;
|
||||
Result.m := f1.n*f1.m;
|
||||
end;
|
||||
function ToString: string; override; // Требуется переопределить эту функцию чтобы выводить переменные типа Frac в write
|
||||
begin
|
||||
Result := Format('{0}/{1}',n,m);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var f := new Frac(2,3);
|
||||
var f1 := new Frac(1,2);
|
||||
writelnFormat('{0} + {1} = {2} ',f,f1,f+f1);
|
||||
// f+f1 переводится компилятором в Frac.operator+(f,f1)
|
||||
writelnFormat('{0} - {1} = {2} ',f,f1,f-f1);
|
||||
end.
|
56
Samples/LanguageFeatures/Generics/GenericClasses/Stack.pas
Normal file
@ -0,0 +1,56 @@
|
||||
// Демонстрация создания простого класса стека на базе массива
|
||||
type
|
||||
Stack<T> = class
|
||||
private
|
||||
a: array of T;
|
||||
last: integer;
|
||||
public
|
||||
constructor Create(sz: integer);
|
||||
begin
|
||||
SetLength(a,sz);
|
||||
last := 0;
|
||||
end;
|
||||
constructor Create;
|
||||
begin
|
||||
Create(100);
|
||||
end;
|
||||
procedure push(i: T);
|
||||
begin
|
||||
a[last] := i;
|
||||
Inc(last);
|
||||
end;
|
||||
function pop: T;
|
||||
begin
|
||||
Dec(last);
|
||||
pop := a[last];
|
||||
end;
|
||||
function top: T;
|
||||
begin
|
||||
top := a[last-1];
|
||||
end;
|
||||
function empty: boolean;
|
||||
begin
|
||||
Result := (last=0);
|
||||
end;
|
||||
function ToString: string; override;
|
||||
begin
|
||||
Result := '';
|
||||
for var i:=0 to last-1 do
|
||||
Result += a[i]+' ';
|
||||
end;
|
||||
end;
|
||||
|
||||
var s: Stack<integer>;
|
||||
|
||||
begin
|
||||
s := new Stack<integer>;
|
||||
s.push(7);
|
||||
s.push(2);
|
||||
s.push(5);
|
||||
s.push(4);
|
||||
writeln(s);
|
||||
while not s.empty do
|
||||
write(s.pop,' ');
|
||||
end.
|
||||
|
||||
|
21
Samples/LanguageFeatures/Generics/GenericProcFun/FindT.pas
Normal file
@ -0,0 +1,21 @@
|
||||
// Обобщенные функции
|
||||
// Выведение типа T по типам параметров
|
||||
|
||||
function IndexOf<T>(a: array of T; val: T): integer;
|
||||
begin
|
||||
Result := -1;
|
||||
for var i:=0 to a.Length-1 do
|
||||
if a[i]=val then
|
||||
begin
|
||||
Result := i;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
var a := Arr('Ваня', 'Коля', 'Саша', 'Сережа');
|
||||
|
||||
begin
|
||||
var s := 'Сережа';
|
||||
writelnFormat('Индекс элемент со значением ''{0}'' равен {1}',s,IndexOf(a,s));
|
||||
end.
|
||||
|
17
Samples/LanguageFeatures/Generics/GenericProcFun/SwapT.pas
Normal file
@ -0,0 +1,17 @@
|
||||
// Обобщенные функции
|
||||
// Выведение типа T по типам параметров
|
||||
|
||||
procedure Swap<T>(var a,b: T);
|
||||
begin
|
||||
var v := a;
|
||||
a := b;
|
||||
b := v;
|
||||
end;
|
||||
|
||||
begin
|
||||
var a := 2;
|
||||
var b := 3;
|
||||
writelnFormat('До Swap a={0}, b={1}',a,b);
|
||||
Swap(a,b);
|
||||
writelnFormat('После Swap a={0}, b={1}',a,b);
|
||||
end.
|
74
Samples/LanguageFeatures/IndexProperties.pas
Normal file
@ -0,0 +1,74 @@
|
||||
// Индексные свойства. Массив цветных квадратов
|
||||
uses GraphABC;
|
||||
|
||||
const
|
||||
sz = 50;
|
||||
dim = 10;
|
||||
delay = 500;
|
||||
|
||||
type
|
||||
///
|
||||
VisualArray = class
|
||||
private
|
||||
a: array of Color;
|
||||
procedure SetItem(i: integer; x: Color); // Процедура, устанавливающая цвет i-того квадрата
|
||||
begin
|
||||
if (i<0) or (i>=a.Length) then
|
||||
raise new System.ArgumentException('Выход за границы изменения индекса: '+IntToStr(i));
|
||||
a[i] := x;
|
||||
Draw(i);
|
||||
end;
|
||||
function GetItem(i: integer): Color; // Функция, возвращающая цвет i-того квадрата
|
||||
begin
|
||||
if (i<0) or (i>=a.Length) then
|
||||
raise new System.ArgumentException('Выход за границы изменения индекса: '+IntToStr(i));
|
||||
Result := a[i];
|
||||
end;
|
||||
public
|
||||
constructor (n: integer);
|
||||
begin
|
||||
a := ArrFill(n,Color.White);
|
||||
Draw;
|
||||
end;
|
||||
/// Рисует i-тый квадрат
|
||||
procedure Draw(i: integer);
|
||||
begin
|
||||
Brush.Color := a[i];
|
||||
Rectangle(sz+sz*i,sz,sz+sz*(i+1)+1,sz+sz);
|
||||
end;
|
||||
/// Рисует массив цветных квадратов
|
||||
procedure Draw;
|
||||
begin
|
||||
for var i:=0 to a.Length-1 do
|
||||
Draw(i);
|
||||
end;
|
||||
/// Индексное свойство по умолчанию
|
||||
property Item[i: integer]: Color read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
var arr: VisualArray;
|
||||
|
||||
begin
|
||||
Window.Title := 'Иллюстрация индексных свойств';
|
||||
arr := new VisualArray(dim);
|
||||
Window.SetSize(sz*(dim+2),3*sz);
|
||||
arr[0] := clGreen; // arr.Items[0] = arr[0] поскольку свойство Items является свойством по умолчанию
|
||||
Sleep(delay);
|
||||
arr[1] := clBlack;
|
||||
Sleep(delay);
|
||||
arr[2] := clYellow;
|
||||
Sleep(delay);
|
||||
arr[3] := clGray;
|
||||
Sleep(delay);
|
||||
arr[4] := clRed;
|
||||
Sleep(delay);
|
||||
arr[5] := clMagenta;
|
||||
Sleep(delay);
|
||||
arr[6] := clBrown;
|
||||
Sleep(delay);
|
||||
arr[7] := clMoneyGreen;
|
||||
Sleep(delay);
|
||||
arr[8] := clOlive;
|
||||
Sleep(delay);
|
||||
arr[9] := clLinen;
|
||||
end.
|
13
Samples/LanguageFeatures/ParamsConcat.pas
Normal file
@ -0,0 +1,13 @@
|
||||
// Создание функции Concat с переменным числом параметров
|
||||
|
||||
function Concat(params strs: array of string): string;
|
||||
begin
|
||||
var sb := new StringBuilder;
|
||||
foreach var x in strs do
|
||||
sb.Append(x);
|
||||
Result := sb.ToString;
|
||||
end;
|
||||
|
||||
begin
|
||||
Writeln(Concat('Pascal','ABC','.NET'));
|
||||
end.
|
17
Samples/LanguageFeatures/ParamsWriteln.pas
Normal file
@ -0,0 +1,17 @@
|
||||
// Создание процедуры MyWriteln с переменным числом параметров
|
||||
|
||||
procedure MyWriteln(params args: array of object);
|
||||
begin
|
||||
foreach var x in args do
|
||||
Write(x);
|
||||
WriteLn;
|
||||
end;
|
||||
|
||||
var
|
||||
a: integer := 777;
|
||||
b: boolean := True;
|
||||
r: real := 3.1415;
|
||||
|
||||
begin
|
||||
MyWriteln(a,' ',b,' ',r);
|
||||
end.
|
38
Samples/LanguageFeatures/Pattern Matching/ArithmEval.pas
Normal file
@ -0,0 +1,38 @@
|
||||
type
|
||||
Expr = class
|
||||
end;
|
||||
Cons = auto class(Expr)
|
||||
r: real;
|
||||
end;
|
||||
Add = auto class(Expr)
|
||||
left,right: Expr;
|
||||
procedure Deconstruct(var l,r: Expr);
|
||||
begin
|
||||
l := left; r := right;
|
||||
end;
|
||||
end;
|
||||
Mult = auto class(Expr)
|
||||
left,right: Expr;
|
||||
procedure Deconstruct(var l,r: Expr);
|
||||
begin
|
||||
l := left; r := right;
|
||||
end;
|
||||
end;
|
||||
Neg = auto class(Expr)
|
||||
ex: Expr;
|
||||
end;
|
||||
|
||||
function Eval(e: Expr): real;
|
||||
begin
|
||||
match e with
|
||||
Cons(c): Result := c.r;
|
||||
Neg(n): Result := -Eval(n.Ex);
|
||||
Add(l,r): Result := Eval(l) + Eval(r);
|
||||
Mult(l,r): Result := Eval(l) * Eval(r);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
var r := new Add(new Neg(new Cons(2)),new Mult(new Cons(3),new Cons(4)));
|
||||
Eval(r).Print;
|
||||
end.
|