Pascal ABC uses Utils var s real i

Тест скорости Pascal ABC проводился на следующей программе: uses Utils; var s: real; i, j: integer; begin cls; i: =1; while i<=1000 do begin j: =1; while j<=1000 do begin s: =s+1/i/j; j: =j+1; end; i: =i+1; end; write(s, ' ', Milliseconds/1000); end.

Вид окна Pascal ABC

Переменная Result function Min. Element (var a: array [1. . 100] of real; n: integer): real; var i: integer; begin Result: =a[1]; for i: =1 to n do if a[i]<Result then Result: =a[i]; end; function f(r, i: integer): record r, i: integer end; begin Result. r: =r; Result. i: =i end;

Структурная эквивалентность типов var a: array [1. . 100] of integer; b: array [1. . 100] of integer; p 1: procedure (i: integer); p 2: procedure (x: integer); r 1: record i, j: integer end; r 2: record x, y: integer end; begin a: =b; // все в порядке p 1: =p 2; // все в порядке r 1: =r 2; // ошибка! . . . procedure foreach(var a: array [1. . 100] of real; n: integer; f: function(r: real); var i: integer; begin for i: =1 to n do a[i]: =f(a[i]); end;

Операции с указателями const n=20; type pinteger=^integer; Arr. N=^array [1. . Max. Int] of integer; var p, pi: ^integer; pa: Arr. N; i: integer; begin Get. Mem(p, n*sizeof(integer)); pi: =p; for i: =1 to n do begin pi^: =2*i; pi: =pi+1; end; pa: =Arr. N(p); for i: =1 to n do write(pa^[i]: 3); Free. Mem(p); end.

Тип complex const ci=(0, 1); var c: complex; begin c: =(3, 7); c. Re: =2*c. Im; c: =ci*c+(2*c. Im, c. Re); writeln(c: 10: 2); writeln(abs(c)); writeln(conj(c)); writeln(carg(c)); writeln(sin(c), ' ', cos(c), ' ', exp(c)); writeln(ln(c), ' ', sqrt(c)); end.

Перегрузка имен – нет overload procedure p(b: byte); begin end; procedure p(r: real); begin end; type A=class constructor Create; constructor Create(n: integer); end; . . . p(2); p(2. 0);

Задание Pointer 2

Решение задания Pointer 2 type uses PT 4; PNode = ^TNode; var P 1, P 2: PNode; TNode = record n: integer; Data: Integer; begin Next: PNode; Task('Pointer 2'); Prev: PNode; read(P 1); end; n: =0; while P 1<>nil do begin write(P 1^. Data); Inc(n); P 2: =P 1; // сохраняем адрес текущего элемента P 1: =P 1^. Next; // и переходим к следующему элементу end; write(n, P 2); end.

Модуль Graph. ABC (1) l Примитивы, перья и кисти function RGB(r, g, b: integer): integer; procedure Set. Pixel(x, y, color: integer); procedure Line(x 1, y 1, x 2, y 2: integer); procedure Circle(x, y, r: integer); procedure Ellipse(x 1, y 1, x 2, y 2: integer); procedure Rectangle(x 1, y 1, x 2, y 2: integer); procedure Flood. Fill(x, y, color: integer); procedure Pie(x, y, r, a 1, a 2: integer); procedure Polygon(var a; n: integer); procedure Polyline(var a; n: integer); procedure Set. Pen. Color(color: integer); function Pen. Color: integer; procedure Set. Pen. Width(w: integer); function Pen. Width: integer; procedure Set. Pen. Style(ps: integer); function Pen. Style: integer; procedure Set. Brush. Color(color: integer); function Brush. Color: integer; procedure Set. Brush. Style(bs: integer); function Brush. Style: integer;

Модуль Graph. ABC (2) l Текст и графическое окно procedure Text. Out(x, y: integer; s: string); procedure Set. Font. Color(color: integer); function Font. Color: integer; procedure Set. Font. Size(sz: integer); function Font. Size: integer; procedure Set. Font. Name(name: string); function Font. Name: string; procedure Set. Font. Style(fs: integer); function Font. Style: integer; fs. Normal fs. Bold fs. Italic fs. Bold. Italic fs. Underline fs. Bold. Underline fs. Italic. Underline fs. Bold. Italic. Underline procedure Clear. Window; procedure Set. Window. Width(w: integer); function Window. Width: integer; procedure Set. Window. Height(h: integer); function Window. Height: integer; procedure Set. Window. Caption(s: string); function Window. Caption: string;

Модуль Graph. ABC (3) l Рисунки: дескрипторная модель. Каждый рисунок имеет описатель – целое число function Load. Picture(fname: string): integer; procedure Draw. Picture(n, x, y: integer); procedure Destroy. Picture(n: integer); function Picture. Width(n: integer): integer; function Picture. Height(n: integer): integer; function Create. Picture: integer; procedure Copy. To. Picture(n: integer; r: Rect); procedure Save. Picture(n: integer; fname: string); n: =Load. Picture('demo. bmp'); w: =Picture. Width(n); h: =Picture. Height(n); Set. Brush. Color(cl. White); for i: =0 to Window. Width-w do begin Draw. Picture(n, i, 0); Sleep(10); Fill. Rect(i, 0, i+1, 0+h); end; Destroy. Picture(n);

Модуль Sounds Звуки: дескрипторная модель Интерфейс модуля Пример n: =Load. Sound(fname); Play. Sound(n); Stop. Sound(n); Rewind. Sound(n); Destroy. Sound(n); b: =Sound. Is. Playing(n); t: =Sound. Time(n); uses Sounds; var snd: integer; begin snd: =Load. Sound('kuku. wav'); Play. Sound(snd); while Sound. Is. Playing(snd) do Sleep(100); Destroy. Sound(snd); end.

Модуль Events. Простейшие события On. Mouse. Down: procedure (x, y, mb: integer); On. Mouse. Up : procedure (x, y, mb: integer); On. Mouse. Move: procedure (x, y, mb: integer); On. Key. Down : procedure (key: integer); On. Key. Up : procedure (key: integer); On. Key. Press : procedure (ch: char); On. Resize : procedure; On. Close : procedure;

События On. Mouse. Down и On. Mouse. Move uses Graph. ABC, Events; procedure Mouse. Down(x, y, mb: integer); begin Move. To(x, y); end; procedure Mouse. Move(x, y, mb: integer); begin if mb=1 then Line. To(x, y); end; begin On. Mouse. Down: =Mouse. Down; On. Mouse. Move: =Mouse. Move end.

Событие On. Key. Down begin uses Graph. ABC, Events; x: =Window. Width div 2; var x, y: integer; y: =Window. Height div 2; procedure Key. Down(Key: Set. Pen. Style(ps. Clear); integer); On. Key. Down: =Key. Down; begin Set. Brush. Color(cl. Black); Set. Brush. Color(cl. White); Ellipse(x-9, y-9, x+9, y+9); end. case Key of VK_Left: x: =x-5; VK_Up: y: =y-5; VK_Right: x: =x+5; VK_Down: y: =y+5; end; Set. Brush. Color(cl. Black); Ellipse(x-9, y-9, x+9, y+9); end;

Модуль Timers Таймеры: дескрипторная модель uses Timers, Events; procedure p; begin write(1); end; var t: integer; begin t: =Create. Timer(500, p); readln; Stop. Timer(t); readln; Start. Timer(t); end.

Модуль Utils type Date. Time=record Day, Month, Year, Hour, Minute, Second, Milliseconds: integer; end; Long. Size=record Megabytes, Bytes: integer; end; function Create. Dir(name: string): boolean; function Delete. File(name: string): boolean; function Directory. Exists(name: string): boolean; function Get. Current. Dir: string; function Remove. Dir(name: string): boolean; function Rename. File(Old. Name, New. Name: string): boolean; function Set. Current. Dir(name: string): boolean; function Trim(s: string): string; function Trim. Left(s: string): string; function Trim. Right(s: string): string; function Milliseconds: integer; function Compile. Time: integer; function Current. Date. Time: Date. Time; procedure Show. Message(s: string); function Compare. Mem(p 1, p 2: pointer; len: integer): boolean; function Disk. Size(Drive: integer): Long. Size; function Disk. Free(Drive: integer): Long. Size;

Структура модуля Pascal ABC unit Graph. Lib; uses Graph. ABC; const Dim=5; var Colors: array [1. . Dim] of integer; function Random. Color: integer; begin Result: =RGB(Random(255), Random(255)); end; procedure Fill. By. Random. Color; var i: integer; begin for i: =1 to Dim do Colors[i]: =Random. Color; end; begin Fill. By. Random. Color; end. Модули должны находиться либо в папке основной программы, либо в папке UNITS корневой папки Pascal ABC

Создание модулей во внешних DLL Library Test; procedure Register. Lib(s: string); begin s: ='unit Test; '+ 'procedure my. Inc(var i: integer; n: integer); external 1; '+ 'function Sum(a, b: integer): integer; external 2; '+ 'end. '; end; procedure Execute(n: integer; p: pointer); var pi: pinteger; a, b: pinteger; begin case n of 1: begin // my. Inc pi: =getpointer(p); pi^: =pi^+pinteger(p)^; end; 2: begin // Sum a: =getinteger(p); b: =getinteger(p); pinteger(p)^: =a+b; end;

Класс Object – неявный предок всех классов type Object=class constructor Create; destructor Destroy; function Type. Name: string; function To. String: string; end;

Определение методов внутри класса type Figure=class private x, y: integer; public constructor Create(xx, yy: integer); begin x: =xx; y: =yy; end; procedure Draw; begin end; procedure Show; begin Set. Pen. Color(cl. Black); Draw; end; procedure Hide; begin Set. Pen. Color(cl. White); Draw; end; procedure Move. To(xx, yy: integer); begin Hide; x: =xx; y: =yy; Show; end; function Clone: Figure; begin Clone: =Figure. Create(x, y); end; Rect. G=class(Figure) private w, h: integer; public constructor Create(x 1, y 1, x 2, y 2: integer); begin inherited Create(x 1, y 1); w: =x 2 -x 1; h: =y 2 -y 1; end; procedure Draw; begin Rectangle(x, y, x+w, y+h); end; function Clone: Figure; begin Clone: =Rect. G. Create(x, y, x+w, y+h); end;

Определение методов внутри и вне класса type Assoc. Array=class private words: String. Array; nums: Int. Array; procedure set. Prop(ind: string; value: integer); function get. Prop(ind: string): integer; public constructor Create; begin words: =String. Array. Create; nums: =Int. Array. Create; end; function get. Size: integer; begin Result: =words. Size; end; property Size: integer read get. Size; property Items[ind: string]: integer read get. Prop write set. Prop; property Keys: String. Array read words; property Values: Int. Array read nums; end; procedure Assoc. Array. set. Prop (ind: string; value: integer); var i: integer; begin i: =words. Index. Of(ind); if i<>0 then nums[i]: =value else begin words. add(ind); nums. add(value); end; function Assoc. Array. get. Prop (ind: string): integer; var i: integer; begin i: =words. Index. Of(ind); if i<>0 then Result: =nums[i] else begin words. add(ind); nums. add(0); Result: =0; end;

Модуль Containers Классы контейнеров: l Int. Array Real. Array String. Array Object. Array l Int. Stack Real. Stack String. Stack Object. Stack l Int. Queue Real. Queue String. Queue Object. Queue Int. Set Real. Set String. Set Object. Set l Int. Assoc. Array Real. Assoc. Array String. Assoc. Array Object. Assoc. Array l

Модуль Containers – интерфейсы классов Int. Array=class constructor Create; constructor Create(n: integer); destructor Destroy; procedure Put(ind, v: integer); function Get(ind: integer): integer; property Items[n: integer]: integer read get write put; function Size: integer; function Count: integer; procedure Resize(n: integer); procedure Add(v: integer); procedure Fill(v: integer); procedure Clear; procedure Insert(ind, v: integer); procedure Delete(ind: integer); procedure Remove(v: integer); procedure Exchange(i 1, i 2: integer); function Index. Of(v: integer): integer; function Last. Index. Of(v: integer): integer; function Find(v: integer): boolean; function Min. Element: integer; function Max. Element: integer; function Min. Ind: integer; function Max. Ind: integer; procedure Sort; procedure Reverse; function Sum: integer; function Average: real; procedure Println; end; String. Stack=class constructor Create; destructor Destroy; procedure Push(s: string); function Pop: string; function Top: string; function Is. Empty: boolean; end; Real. Queue=class constructor Create; destructor Destroy; procedure Push(r: real); function Pop: real; function First: real; function Last: real; function Is. Empty: boolean; end;

Модуль Containers – интерфейсы классов Object. Set=class Owns. Objects: boolean; constructor Create; destructor Destroy; procedure Include(o: Object); procedure Exclude(o: Object); function Find(o: Object): boolean; procedure Delete(o: Object); procedure Reset; procedure Move. First; procedure Move. Last; procedure Next; procedure Prev; function Current: Object; function Eos: boolean; function First: Object; function Last: Object; procedure Clear; procedure Union(s 1, s 2: Object. Set); procedure Intersect(s 1, s 2: Object. Set); procedure Difference(s 1, s 2: Object. Set); function Embed(s: Object. Set): boolean; function Count: integer; function Is. Empty: boolean; procedure Println; procedure Print(delim: string); procedure Println(delim: string); end; Int. Assoc. Array=class constructor Create; destructor Destroy; procedure Clear; procedure Add(key: string; value: integer); function Find(key: string): boolean; procedure Delete(key: string); procedure Reset; procedure Move. First; procedure Move. Last; procedure Next; procedure Prev; function Current. Key: string; function Current. Value: integer; function Eo. A: boolean; procedure Put(key: string; value: integer); function Get(key: string): integer; property Items[key: string]: integer read get write put; function Count: integer; function Is. Empty: boolean; procedure Println; procedure Print(delim: string); procedure Println(delim: string); end;

Пример 1: сортировка по критерию в динамических массивах объектов uses Containers; type Pupil=class age: integer; name: string; constructor Create(name: string; age: integer); begin Self. age: =age; Self. name: =name; end; function To. String: string; begin Result: =name+' '+Int. To. Str(age); end; function Less. Age(o 1, o 2: Object): boolean; begin Result: =Pupil(o 1). age<Pupil(o 2). age end; function Less. Name(o 1, o 2: Object): boolean; begin Result: =Pupil(o 1). name<Pupil(o 2). name end; var d: Object. Array; begin cls; d: =Object. Array. Create; d. Add(Pupil. Create('Иванов', 15)); d. Add(Pupil. Create('Попов', 14)); d. Add(Pupil. Create('Петров', 12)); d. Add(Pupil. Create('Козлова', 16)); d. Add(Pupil. Create('Кротова', 12)); d. Add(Pupil. Create('Дурова', 13)); d. Sort(Less. Name); writeln('Сортировка по имени: '); d. Println(#10); d. Sort(Less. Age); writeln('Сортировка по возрасту: '); d. Println(#10); d. Destroy; end.

Пример 2: ассоциативные массивы uses Containers; var Zoo: Int. Assoc. Array; begin Zoo: =Int. Assoc. Array. Create; Zoo['бегемоты']: =8; Zoo['крокодилы']: =6; Zoo['жирафы']: =1; Zoo['страусы']: =Zoo['страусы']+1; Zoo. Println; Zoo. Reset; while not Zoo. Eo. A do begin writeln(Zoo. Current. Key, ' ', Zoo. Current. Value); Zoo. Next; end; Zoo. Destroy; end.

Пример 1 программы PABC Forms uses VCL; var Main. Form: Form; Label 1: Label; Edit 1: Edit; procedure Set. Form. Caption; begin Main. Form. Caption: =Edit 1. Text; end; begin Main. Form: =Form. Create(200, 300, 100); Label 1: =Label. Create(5, 20, 'Заголовок формы: '); Edit 1: =Edit. Create(140, 20); Edit 1. On. Change: =Set. Form. Caption; end.