administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Правки некоторых примеров

Browse source
This commit is contained in:
Mikhalkovich Stanislav 2019-01-01 14:15:29 +03:00
parent fca2179c92
commit 43adc0a7c2
14 changed files with 96 additions and 100 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
InstallerSamples/Algorithms/FloodFillTuple.pas
View file

@ -39,8 +39,8 @@ end;
procedure ReadFromFile(fname: string; var a: array [,] of integer);
begin
var f := OpenRead(fname);
var dimx,dimy: integer;
readln(f,dimy,dimx);
var dimx,dimy: integer;
Readln(f,dimy,dimx);
SetLength(a,dimy,dimx);
for var y := 0 to dimy-1 do
begin

15
InstallerSamples/Algorithms/PrimeNumbers.pas
View file

@ -1,21 +1,22 @@
// Генерация больших простых чисел
// Генерация больших простых чисел
begin
writeln('Большие простые числа: ');
Println('Большие простые числа: ');
var count := 0;
var beg := Random(1000000000)+2;
for var i:=beg to beg+5000 do
begin
var f := True;
var j := 2;
var r := round(sqrt(i));
var r := Round(Sqrt(i));
while f and (j<=r) do
if i mod j = 0 then f := false
if i mod j = 0 then f := False
else j += 1;
if f then
begin
write(i,' ');
Inc(count);
if count mod 5 = 0 then writeln;
Print(i);
count += 1;
if count mod 8 = 0 then
Println;
end;
end;
end.

4
InstallerSamples/Algorithms/Recursion/Hanoi.pas
View file

@ -1,4 +1,4 @@
// Ханойские башни
// Ханойские башни
uses GraphABC;
type
@ -59,7 +59,7 @@ begin
DrawTower(Tower[2],DisksInTower[2],x2,y0);
DrawTower(Tower[3],DisksInTower[3],x3,y0);
Brush.Color := clWhite;
TextOut(20,20,'Число перемещений дисков = '+IntToStr(MoveNumber));
TextOut(20,20,'Число перемещений дисков = '+MoveNumber);
Redraw;
end;

6
InstallerSamples/Algorithms/Recursion/Knapsack.pas
View file

@ -1,4 +1,4 @@
// Задача о ранце. В массиве B заданы веса предметов.
// Задача о ранце. В массиве B заданы веса предметов.
// Выдать все варианты полной комплектации ранца частью этих предметов
const Sz=100;
@ -7,8 +7,8 @@ type IntArr = array [1..Sz] of integer;
procedure PrintArr(const A: IntArr; n: integer);
begin
for var i:=1 to n do
write(A[i],' ');
writeln;
Print(A[i]);
Println;
end;
procedure TrySolve(n: integer; const B: IntArr; nb: integer);

10
InstallerSamples/Algorithms/Recursion/Permutations.pas
View file

@ -1,21 +1,19 @@
// Все перестановки
const n = 4;
var a: array of integer;
procedure Perm(m: integer);
procedure Perm(a: array of integer; m: integer);
begin
if m=1 then
a.Println;
for var i:=0 to m-1 do
begin
Swap(a[i],a[m-1]); // ставим каждый на место последнего
Perm(m-1);
Perm(a,m-1);
Swap(a[i],a[m-1]);
end;
end;
begin
a := Range(1,n).ToArray; // заполнение массива a числами от 1 до n
Perm(n);
var a := Range(1,n).ToArray; // заполнение массива a числами от 1 до n
Perm(a,n);
end.

15
InstallerSamples/Algorithms/Recursion/TreeDraw.pas
View file

@ -1,27 +1,26 @@
// Рекурсивное рисование двоичного дерева
uses GraphABC;
// Рекурсивное рисование двоичного дерева
uses GraphWPF;
const
LevelHeight = 50;
Levels = 8;
delay = 10;
procedure DrawTree(x,y,dx,level: integer);
procedure DrawTree(x,y,dx: real; level: integer);
// обход: левое поддерево, корень, правое
begin
if level>0 then
begin
DrawTree(x-dx,y+LevelHeight,dx div 2,level-1);
DrawTree(x-dx,y+LevelHeight,dx / 2,level-1);
Line(x,y,x-dx,y+LevelHeight);
Line(x,y,x+dx,y+LevelHeight);
Sleep(delay);
DrawTree(x+dx,y+LevelHeight,dx div 2,level-1);
DrawTree(x+dx,y+LevelHeight,dx / 2,level-1);
end;
end;
begin
Window.Title := 'Рекурсивное рисование бинарного дерева';
SetSmoothingOff;
SetWindowSize(800,30+Levels*LevelHeight);
DrawTree(WindowWidth div 2,10,WindowWidth div 5,Levels);
Window.SetSize(800,30+Levels*LevelHeight);
DrawTree(Window.Width / 2,10,Window.Width / 5,Levels);
end.

6
InstallerSamples/Algorithms/SortArrays/QuickSort.pas
View file

@ -36,9 +36,9 @@ const n = 20;
begin
var a := ArrRandom(n);
writeln('До сортировки: ');
Println('До сортировки: ');
Writeln(a);
QuickSort(a,0,a.Length-1);
writeln('После сортировки: ');
Writeln(a);
Println('После сортировки: ');
Println(a);
end.

14
InstallerSamples/Algorithms/SortArrays/SelectionSort.pas
View file

@ -3,24 +3,20 @@ procedure SelectionSort(a: array of real);
begin
for var i:=0 to a.Length-2 do
begin
var min := a[i];
var ind := i;
var (min,ind) := (a[i],i);
for var j:=i+1 to a.Length-1 do
if a[j]<min then
begin
min := a[j];
ind := j;
end;
(min,ind) := (a[j],j);
a[ind] := a[i];
a[i] := min;
end;
end;
begin
var a := ArrRandomReal(20);
writeln('Содержимое массива: ');
var a := SeqRandomReal(20).Select(r->r.Round(2)).ToArray;
Println('Содержимое массива: ');
a.Println;
SelectionSort(a);
writeln('После сортировки выбором: ');
Println('После сортировки выбором: ');
a.Println;
end.

35
InstallerSamples/Applications/GraphApplications/FuncTransform.pas
View file

@ -1,5 +1,5 @@
uses
GraphABC;
uses
GraphWPF;
var
h := 0.01;
@ -20,32 +20,31 @@ end;
procedure DrawGraphic(f: real -> real);
begin
Draw(f, -boundx, boundx, -boundy, boundy);
Window.Clear;
DrawGraph(f, -boundx, boundx, -boundy, boundy);
Window.Title := Format('mx={0:f2} my={1:f2} dx={2:f2} dy={3:f2}', mx, my, dx, dy);
Redraw;
end;
procedure KeyDown(key: integer);
const
ArrowKeys: set of integer = [vk_Left, vk_Right, vk_Up, vk_Down, vk_Home, vk_End, vk_PageUp, vk_PageDown];
var ArrowKeys := HSet(Key.Left, Key.Right, Key.Up, Key.Down, Key.Home, Key.&End, Key.PageUp, Key.PageDown);
procedure KeyDown(k: Key);
begin
var g := Transform(f);
case key of
vk_Left: my -= h;
vk_Right: my += h;
vk_Up: mx -= h;
vk_Down: mx += h;
vk_Home: dx += h;
vk_PageUp: dx -= h;
vk_PageDown: dy += h;
vk_End: dy -= h;
case k of
Key.Left: my -= h;
Key.Right: my += h;
Key.Up: mx -= h;
Key.Down: mx += h;
Key.Home: dx += h;
Key.PageUp: dx -= h;
Key.PageDown: dy += h;
Key.End: dy -= h;
end;
if key in ArrowKeys then
if k in ArrowKeys then
DrawGraphic(g);
end;
begin
DrawGraphic(Transform(f));
LockDrawing;
OnKeyDown := KeyDown;
end.

31
InstallerSamples/Games/15.pas
View file

@ -1,4 +1,4 @@
// Игра в 15
// Игра в 15
uses GraphABC,ABCObjects,ABCButtons;
const
@ -37,9 +37,9 @@ begin
end;
// Определить, являются ли клетки соседями
function Sosedi(x1,y1,x2,y2: integer): boolean;
function Neighbours(x1,y1,x2,y2: integer): boolean;
begin
Result := (abs(x1-x2)=1) and (y1=y2) or (abs(y1-y2)=1) and (x1=x2)
Result := (Abs(x1-x2)=1) and (y1=y2) or (Abs(y1-y2)=1) and (x1=x2)
end;
// Заполнить вспомогательный массив цифр
@ -50,7 +50,7 @@ begin
end;
// Перемешать вспомогательный массив цифр. Количество обменов должно быть четным
procedure MeshDigitsArr;
procedure MixDigitsArr;
var x: integer;
begin
for var i:=1 to n*n-1 do
@ -81,9 +81,9 @@ begin
end;
// Перемешать массив фишек
procedure Mesh15;
procedure Mix15;
begin
MeshDigitsArr;
MixDigitsArr;
Fill15ByDigitsArr;
MovesCount := 0;
EndOfGame := False;
@ -107,25 +107,24 @@ begin
p[EmptyCellY,EmptyCellX].Color := clWhite;
p[EmptyCellY,EmptyCellX].BorderColor := clWhite;
FillDigitsArr;
MeshDigitsArr;
MixDigitsArr;
Fill15ByDigitsArr;
end;
// Проверить, все ли фишки стоят на своих местах
function IsSolution: boolean;
var x,y,i: integer;
begin
Result:=True;
i:=1;
for y:=1 to n do
for x:=1 to n do
var i:=1;
for var y:=1 to n do
for var x:=1 to n do
begin
if p[y,x].Number<>i then
begin
Result:=False;
break;
end;
Inc(i);
i += 1;
if i=n*n then i:=0;
end;
end;
@ -140,16 +139,16 @@ begin
var fy := (y-y0) div (sz+zz) + 1;
if (fx>n) or (fy>n) then
exit;
if Sosedi(fx,fy,EmptyCellX,EmptyCellY) then // Если ячейка соседствует с пустой, то поменять их местами
if Neighbours(fx,fy,EmptyCellX,EmptyCellY) then // Если ячейка соседствует с пустой, то поменять их местами
begin
Swap(p[EmptyCellY,EmptyCellX],p[fy,fx]);
EmptyCellX := fx;
EmptyCellY := fy;
Inc(MovesCount);
StatusRect.Text := 'Количество ходов: ' + IntToStr(MovesCount);
StatusRect.Text := 'Количество ходов: ' + MovesCount;
if IsSolution then
begin
StatusRect.Text := 'Победа! Сделано ходов: ' + IntToStr(MovesCount);
StatusRect.Text := 'Победа! Сделано ходов: ' + MovesCount;
StatusRect.Color := RGB(255,200,200);
EndOfGame := True;
end
@ -166,7 +165,7 @@ begin
Create15;
MeshButton := ButtonABC.Create((WindowWidth-200) div 2,2*y0+(sz+zz)*n-zz,200,'Перемешать',clLightGray);
MeshButton.OnClick := Mesh15;
MeshButton.OnClick := Mix15;
StatusRect := new RectangleABC(0,WindowHeight-40,WindowWidth,40,RGB(200,200,255));
StatusRect.TextVisible := True;
StatusRect.Text := 'Количество ходов: '+IntToStr(MovesCount);

24
InstallerSamples/Games/DeleteByMouse.pas
View file

@ -1,4 +1,4 @@
uses ABCObjects,GraphABC;
uses WPFObjects;
const CountSquares = 20;
@ -8,21 +8,21 @@ var
/// Количество ошибок
Mistakes: integer;
/// Строка информации
StatusRect: RectangleABC;
StatusRect: RectangleWPF;
/// Вывод информационной строки
procedure DrawStatusText;
begin
if CurrentDigit<=CountSquares then
StatusRect.Text := 'Удалено квадратов: ' + IntToStr(CurrentDigit-1) + ' Ошибок: ' + IntToStr(Mistakes)
else StatusRect.Text := 'Игра окончена. Время: ' + IntToStr(Milliseconds div 1000) + ' с. Ошибок: ' + IntToStr(Mistakes);
StatusRect.Text := $'Удалено квадратов: {CurrentDigit-1} Ошибок: {Mistakes}'
else StatusRect.Text := $'Игра окончена. Время: {Milliseconds div 1000} с. Ошибок: {Mistakes}';
end;
/// Обработчик события мыши
procedure MyMouseDown(x,y,mb: integer);
procedure MyMouseDown(x,y: real; mb: integer);
begin
var ob := ObjectUnderPoint(x,y);
if (ob<>nil) and (ob is RectangleABC) then
if (ob<>nil) and (ob is RectangleWPF) then
if ob.Number=CurrentDigit then
begin
ob.Destroy;
@ -31,7 +31,7 @@ begin
end
else
begin
ob.Color := clRed;
ob.Color := Colors.Red;
Inc(Mistakes);
DrawStatusText;
end;
@ -39,15 +39,15 @@ end;
begin
Window.Title := 'Игра: удали все квадраты по порядку';
Window.IsFixedSize := True;
for var i:=1 to CountSquares do
begin
var x := Random(WindowWidth-50);
var y := Random(WindowHeight-100);
var ob := RectangleABC.Create(x,y,50,50,clMoneyGreen);
var x := Random(Window.Width-50);
var y := Random(Window.Height-100);
var ob := RectangleWPF.Create(x,y,50,50,Colors.LightGreen).WithBorder;
ob.FontSize := 25;
ob.Number := i;
end;
StatusRect := RectangleABC.Create(0,Window.Height-40,Window.Width,40,Color.LightSteelBlue);
StatusRect := RectangleWPF.Create(0,Window.Height-40,Window.Width,40,Colors.LightBlue);
CurrentDigit := 1;
Mistakes := 0;
DrawStatusText;

14
InstallerSamples/Games/Matches.pas
View file

@ -1,4 +1,4 @@
// Игра "Спички"
// Игра "Спички"
const InitialCount=15;
var
@ -18,9 +18,9 @@ begin
begin
var Correct: boolean;
repeat
write('Ваш ход. На столе ',Count,' спичек. ');
write('Сколько спичек Вы берете? ');
readln(Num);
Write('Ваш ход. На столе ',Count,' спичек. ');
Write('Сколько спичек Вы берете? ');
Readln(Num);
Correct := (Num>=1) and (Num<=3) and (Num<=Count);
if not Correct then
writeln('Неверно! Повторите ввод!');
@ -31,7 +31,7 @@ begin
Num := Random(1,3);
if Num>Count then
Num := Count;
writeln('Мой ход. Я взял ',Num,' спичек');
Writeln('Мой ход. Я взял ',Num,' спичек');
end;
Count -= Num;
if Player=1 then
@ -40,6 +40,6 @@ begin
until Count=0;
if Player=1 then
writeln('Вы победили!')
else writeln('Вы проиграли!');
Writeln('Вы победили!')
else Writeln('Вы проиграли!');
end.

5
TreeConverter/TreeRealization/generics.cs
View file

@ -1431,14 +1431,13 @@ namespace PascalABCCompiler.TreeRealization
protected void AddMember(object original, object converted)
{
if (!_members.ContainsValue(original))
if (!_members.ContainsValue(original)) // SSM 30.12.18 bug fix #907
{
_members.Add(original, converted);
_member_definitions.Add(converted, original);
}
else
else // SSM 30.12.18 bug fix #907
{
//_member_definitions[original] = converted;
object kk = null;
foreach (System.Collections.DictionaryEntry x in _members)
{

13
bin/Lib/WPFObjects.pas
View file

@ -146,15 +146,14 @@ type
gr: Grid; // Grid связан только с текстом
t: TextBlock;
r: RotateTransform;
_dx,_dy: real;
ChildrenWPF := new List<ObjectWPF>;
procedure InitOb(x,y,w,h: real; o: FrameworkElement; SetWH: boolean := True);
public
/// Направление движения по оси X. Используется методом Move
property Dx: real read _dx write _dx;
auto property Dx: real;
/// Направление движения по оси Y. Используется методом Move
property Dy: real read _dy write _dy;
auto property Dy: real;
/// Отступ графического объекта от левого края
property Left: real read InvokeReal(()->Canvas.GetLeft(can)) write Invoke(procedure->Canvas.SetLeft(can,value));
/// Отступ графического объекта от верхнего края
@ -163,6 +162,8 @@ type
property Width: real read InvokeReal(()->gr.Width) write Invoke(procedure->begin gr.Width := value; ob.Width := value end); virtual;
/// Высота графического объекта
property Height: real read InvokeReal(()->gr.Height) write Invoke(procedure->begin gr.Height := value; ob.Height := value end); virtual;
/// Прямоугольник графического объекта
property Bounds: GRect read Invoke&<GRect>(()->begin Result := new GRect(Canvas.GetLeft(can),Canvas.GetTop(can),gr.Width,gr.Height); end);
/// Текст внутри графического объекта
property Text: string read InvokeString(()->t.Text) write Invoke(procedure->t.Text := value);
/// Целое число, выводимое в центре графического объекта. Используется свойство Text
@ -193,6 +194,10 @@ type
Result.Transform := g; // версия
end;
public
/// Видимость графического объекта
property Visible: boolean
read InvokeBoolean(()->ob.Visibility = Visibility.Visible)
write Invoke(procedure -> if value then ob.Visibility := Visibility.Visible else ob.Visibility := Visibility.Hidden);
/// Выравнивание текста внутри графического объекта
property TextAlignment: Alignment write Invoke(WTA,Value);
/// Размер текста внутри графического объекта
@ -237,7 +242,7 @@ type
/// Перемещает графический объект на вектор (a,b)
procedure MoveOn(a,b: real) := MoveTo(Left+a,Top+b);
/// Перемещает графический объект на вектор (dx,dy)
procedure Move := MoveOn(dx,dy);
procedure Move; virtual := MoveOn(dx,dy);
/// Поворачивает графический объект по часовой стрелке на угол da
procedure Rotate(da: real) := RotateAngle += da;
/// Добавляет к графическому объекту дочерний