From 00cfe5ffeec2fc10cb7b12b43da443f7e3f18d38 Mon Sep 17 00:00:00 2001 From: RedGuy Date: Tue, 20 Jun 2023 21:52:24 +0300 Subject: [PATCH] Samples --- .../Sprites/SpriteFrames/multi1.bmp | Bin 0 -> 30054 bytes .../Sprites/SpriteFrames/multi2.bmp | Bin 0 -> 30054 bytes .../Sprites/SpriteFrames/multi3.bmp | Bin 0 -> 30054 bytes .../Sprites/SpriteFrames/multi4.bmp | Bin 0 -> 30054 bytes .../Sprites/SpriteFrames/multi5.bmp | Bin 0 -> 30054 bytes .../ABCObjects/Sprites/gr_SpriteCreation.pas | 29 + .../ABCObjects/Sprites/gr_SpriteUsing.pas | 27 + Samples/Graphics/ABCObjects/Sprites/spr.png | Bin 0 -> 2406 bytes Samples/Graphics/ABCObjects/Sprites/spr.spinf | 7 + Samples/Graphics/ABCObjects/demo.bmp | Bin 0 -> 11754 bytes Samples/Graphics/ABCObjects/gr_All_Brown.pas | 43 + .../Graphics/ABCObjects/gr_Clone_Recur.pas | 31 + .../Graphics/ABCObjects/gr_DragPicture.pas | 40 + Samples/Graphics/ABCObjects/gr_Intersect.pas | 28 + Samples/Graphics/ABCObjects/gr_Move_Param.pas | 70 ++ Samples/Graphics/GraphABC/DigitalClock.pas | 14 + Samples/Graphics/GraphABC/Flame.pas | 67 ++ Samples/Graphics/GraphABC/Fractals/Dragon.pas | 70 ++ .../Graphics/GraphABC/Fractals/Mandelbrot.pas | 40 + .../GraphABC/Fractals/Paporotnik/Main.pas | 22 + .../Fractals/Paporotnik/Paporotnik.pas | 51 + .../Fractals/Paporotnik/PaporotnikData.pas | 41 + .../GraphABC/Fractals/Paporotnik1.pas | 42 + .../Graphics/GraphABC/Graphics/DrawFunc.pas | 9 + .../Graphics/GraphABC/Graphics/DrawFunc2.pas | 27 + Samples/Graphics/GraphABC/Hypno.pas | 11 + Samples/Graphics/GraphABC/Mosaic.pas | 51 + Samples/Graphics/GraphABC/MouseDownEvent.pas | 5 + Samples/Graphics/GraphABC/MouseDraw.pas | 7 + Samples/Graphics/GraphABC/SetPixel.pas | 7 + Samples/Graphics/GraphABC/Stamps/Stamp1.pas | 24 + Samples/Graphics/GraphABC/Stamps/Stamp2.pas | 37 + Samples/Graphics/GraphABC/Stamps/Stamp3.pas | 28 + Samples/Graphics/GraphABC/Stamps/Stamp4.pas | 39 + Samples/Graphics/GraphABC/Stamps/Stamp5.pas | 36 + .../GraphABC/Stamps/StampCompound.pas | 77 ++ .../Graphics/GraphABC/Stamps/StampCross.pas | 51 + .../Graphics/GraphABC/Stamps/StampFunc.pas | 79 ++ .../Graphics/GraphABC/Stamps/StampPoly.pas | 49 + .../Graphics/GraphABC/Stamps/StampText.pas | 25 + Samples/Graphics/GraphABC/Star.pas | 17 + Samples/Graphics/GraphABC/Tentacles.pas | 82 ++ .../Graphics/GraphABC/ThroughTheUniverse.pas | 85 ++ Samples/Graphics/GraphABC/graph3d.pas | 64 ++ Samples/Graphics/GraphABC/graphic.pas | 68 ++ Samples/Graphics/GraphABC/rain.pas | 27 + Samples/Graphics/GraphWPF/ArcSector.pas | 15 + Samples/Graphics/GraphWPF/Clock.pas | 12 + Samples/Graphics/GraphWPF/CurjaMurja.pas | 36 + .../Graphics/GraphWPF/DrawCircleByMouse.pas | 16 + Samples/Graphics/GraphWPF/DrawGraphic.pas | 11 + Samples/Graphics/GraphWPF/EllRectInWindow.pas | 7 + Samples/Graphics/GraphWPF/Ellipses.pas | 14 + Samples/Graphics/GraphWPF/anim1.pas | 16 + Samples/Graphics/GraphWPF/anim2.pas | 25 + Samples/Graphics/GraphWPF/anim4.pas | 45 + Samples/Graphics/GraphWPF/mouse1.pas | 6 + Samples/Graphics/GraphWPF/mouse2.pas | 10 + ...ТочкиМногоугольника.pas | 12 + .../ВыравниваниеТекста1.pas | 30 + .../ВыравниваниеТекста2.pas | 34 + .../GraphWPF/Многоугольник.pas | 20 + .../Graphics/GraphWPF/Светофор.pas | 19 + .../Система координат.pas | 18 + .../ТаблицаУмножения.pas | 16 + Samples/LINQ/Consonants.pas | 7 + Samples/LINQ/Delimiters.pas | 4 + Samples/LINQ/First3Min.pas | 4 + Samples/LINQ/FunTable.pas | 6 + Samples/LINQ/Linq1.pas | 6 + Samples/LINQ/Linq2.pas | 13 + Samples/LINQ/Linq3.pas | 18 + Samples/LINQ/MonteCarlo.pas | 7 + Samples/LINQ/Palindroms.pas | 6 + Samples/LINQ/QuickSortLinq.pas | 19 + Samples/LINQ/Seq.pas | 3 + Samples/LINQ/SumInv.pas | 13 + Samples/LINQ/TextFileCount.pas | 7 + Samples/LINQ/TextFileCount1.pas | 8 + Samples/LINQ/Zip.pas | 5 + Samples/LINQ/Zip2.pas | 4 + Samples/LanguageFeatures/AutoClassPoint.pas | 13 + Samples/LanguageFeatures/Boxing.pas | 22 + Samples/LanguageFeatures/ClassConstructor.pas | 36 + Samples/LanguageFeatures/DllTest/MyDll.dll | Bin 0 -> 16384 bytes Samples/LanguageFeatures/DllTest/MyDll.pas | 16 + Samples/LanguageFeatures/DllTest/main.pas | 10 + .../ExtensionMethods/SwapHalfArrays.pas | 6 + Samples/LanguageFeatures/ForeachExamples.pas | 43 + Samples/LanguageFeatures/ForeachForSet.pas | 5 + .../LanguageFeatures/ForeachIEnumerable.pas | 46 + .../LanguageFeatures/FracOperatorOverload.pas | 34 + .../Generics/GenericClasses/Stack.pas | 56 + .../Generics/GenericProcFun/FindT.pas | 21 + .../Generics/GenericProcFun/SwapT.pas | 17 + Samples/LanguageFeatures/IndexProperties.pas | 74 ++ Samples/LanguageFeatures/ParamsConcat.pas | 13 + Samples/LanguageFeatures/ParamsWriteln.pas | 17 + .../Pattern Matching/ArithmEval.pas | 38 + .../Pattern Matching/ArithmSimplify.exe | Bin 0 -> 34304 bytes .../Pattern Matching/ArithmSimplify.pas | 96 ++ .../Pattern Matching/Squares.pas | 22 + Samples/LanguageFeatures/ProcParam.pas | 20 + Samples/LanguageFeatures/ProcVars.pas | 36 + .../ShortTypesInTemplateParams.pas | 19 + Samples/LanguageFeatures/Students.pas | 22 + Samples/LanguageFeatures/Tuples/MySqrt.pas | 14 + .../WriteCycledLinkedList.pas | 19 + Samples/LanguageFeatures/WriteRecord.pas | 26 + .../Yields/InfixTraverseTree.pas | 20 + .../NETLibraries/NET4.0/BigIntegerExample.pas | 12 + .../NETLibraries/NET4.0/ComplexExample.pas | 17 + Samples/NETLibraries/NET4.0/StopWatch.pas | 11 + Samples/NETLibraries/NET4.0/TupleCreate.pas | 10 + .../System.Array/SystemArray1.pas | 37 + .../System.DateTime/DateTime1.pas | 32 + .../System.DateTime/DateTime2.pas | 34 + .../System.DateTime/DateTimeInterval.pas | 16 + .../NETLibraries/System.Net/DownloadFile.pas | 12 + Samples/NETLibraries/System.Net/MailSend.pas | 17 + Samples/NETLibraries/System.Net/Ping.pas | 16 + Samples/NETLibraries/System.Net/WebClient.pas | 10 + .../System.Parallel/Parallel1.pas | 8 + .../System.Parallel/Parallel2.pas | 46 + .../System.Parallel/Parallel3.pas | 57 + .../System.String/StringConvert.pas | 25 + .../System.String/StringMethods1.pas | 30 + .../System.String/StringMethods2.pas | 37 + .../System.String/StringSplit.pas | 26 + .../System.Timers.Timer/SystemTimer.pas | 31 + .../System.Windows.Forms/FormWebBrowser.pas | 17 + .../System.Windows.Forms/MouseDraw.pas | 52 + .../WinFormWithButton.pas | 29 + Samples/NumLibABC/ApproxCheb1.pas | 14 + Samples/NumLibABC/Decomp1.pas | 11 + Samples/NumLibABC/DiffEqu1.pas | 29 + Samples/NumLibABC/Economi1.pas | 12 + Samples/NumLibABC/FMinN_1.pas | 13 + Samples/NumLibABC/FMinN_2.pas | 14 + Samples/NumLibABC/FMinN_3.pas | 14 + Samples/NumLibABC/FMinN_4.pas | 23 + Samples/NumLibABC/FMinN_5.pas | 13 + Samples/NumLibABC/FMinN_6.pas | 27 + Samples/NumLibABC/FMin_1.pas | 9 + Samples/NumLibABC/Factors1.pas | 10 + Samples/NumLibABC/Fraction1.pas | 8 + Samples/NumLibABC/Matrix1.pas | 11 + Samples/NumLibABC/NumLibABCTest.pas | 981 ++++++++++++++++++ Samples/NumLibABC/PolRT1.pas | 10 + Samples/NumLibABC/Polynom1.pas | 11 + Samples/NumLibABC/Polynom2.pas | 16 + Samples/NumLibABC/Quanc8_1.pas | 9 + Samples/NumLibABC/RootsIsolation1.pas | 10 + Samples/NumLibABC/SLAU1.pas | 11 + Samples/NumLibABC/Spline1.pas | 12 + Samples/NumLibABC/Vector1.pas | 20 + Samples/NumLibABC/Zeroin1.pas | 9 + Samples/OMPSamples/Hanoi.pas | 35 + Samples/OMPSamples/MultMatrix.pas | 37 + Samples/OMPSamples/Mutual Lock.pas | 33 + Samples/OMPSamples/QuickSort.pas | 96 ++ Samples/OMPSamples/SqrSinArrays.pas | 47 + Samples/OMPSamples/SumOfPrime.pas | 44 + Samples/OMPSamples/Write Critical.pas | 27 + .../CalculationsGlobalLocal/BlockVars.pas | 15 + .../CalculationsGlobalLocal/GlobalVars.pas | 17 + Samples/Other/SpeedTests/Milli.pas | 13 + .../Other/UnmanagedGraphics/MessageBox.pas | 6 + Samples/StandardUnits/CRT/Bill.pas | 145 +++ Samples/StandardUnits/CRT/CPaint.pas | 70 ++ Samples/StandardUnits/CRT/CRTColors.pas | 20 + .../StandardUnits/CRT/SimpleTextEditor.pas | 17 + .../StandardUnits/FormsABC/CalcIntegral.pas | 64 ++ .../StandardUnits/FormsABC/PaintBoxDraw.pas | 76 ++ Samples/StandardUnits/FormsABC/f0.pas | 24 + Samples/StandardUnits/FormsABC/f0_MV.pas | 40 + Samples/StandardUnits/FormsABC/f0_class.pas | 30 + Samples/StandardUnits/Timers/Timer1.pas | 21 + Samples/StandardUnits/Timers/Timer2.pas | 59 ++ 179 files changed, 5595 insertions(+) create mode 100644 Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi1.bmp create mode 100644 Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi2.bmp create mode 100644 Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi3.bmp create mode 100644 Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi4.bmp create mode 100644 Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi5.bmp create mode 100644 Samples/Graphics/ABCObjects/Sprites/gr_SpriteCreation.pas create mode 100644 Samples/Graphics/ABCObjects/Sprites/gr_SpriteUsing.pas create mode 100644 Samples/Graphics/ABCObjects/Sprites/spr.png create mode 100644 Samples/Graphics/ABCObjects/Sprites/spr.spinf create mode 100644 Samples/Graphics/ABCObjects/demo.bmp create mode 100644 Samples/Graphics/ABCObjects/gr_All_Brown.pas create mode 100644 Samples/Graphics/ABCObjects/gr_Clone_Recur.pas create mode 100644 Samples/Graphics/ABCObjects/gr_DragPicture.pas create mode 100644 Samples/Graphics/ABCObjects/gr_Intersect.pas create mode 100644 Samples/Graphics/ABCObjects/gr_Move_Param.pas create mode 100644 Samples/Graphics/GraphABC/DigitalClock.pas create mode 100644 Samples/Graphics/GraphABC/Flame.pas create mode 100644 Samples/Graphics/GraphABC/Fractals/Dragon.pas create mode 100644 Samples/Graphics/GraphABC/Fractals/Mandelbrot.pas create mode 100644 Samples/Graphics/GraphABC/Fractals/Paporotnik/Main.pas create mode 100644 Samples/Graphics/GraphABC/Fractals/Paporotnik/Paporotnik.pas create mode 100644 Samples/Graphics/GraphABC/Fractals/Paporotnik/PaporotnikData.pas create mode 100644 Samples/Graphics/GraphABC/Fractals/Paporotnik1.pas create mode 100644 Samples/Graphics/GraphABC/Graphics/DrawFunc.pas create mode 100644 Samples/Graphics/GraphABC/Graphics/DrawFunc2.pas create mode 100644 Samples/Graphics/GraphABC/Hypno.pas create mode 100644 Samples/Graphics/GraphABC/Mosaic.pas create mode 100644 Samples/Graphics/GraphABC/MouseDownEvent.pas create mode 100644 Samples/Graphics/GraphABC/MouseDraw.pas create mode 100644 Samples/Graphics/GraphABC/SetPixel.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/Stamp1.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/Stamp2.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/Stamp3.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/Stamp4.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/Stamp5.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/StampCompound.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/StampCross.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/StampFunc.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/StampPoly.pas create mode 100644 Samples/Graphics/GraphABC/Stamps/StampText.pas create mode 100644 Samples/Graphics/GraphABC/Star.pas create mode 100644 Samples/Graphics/GraphABC/Tentacles.pas create mode 100644 Samples/Graphics/GraphABC/ThroughTheUniverse.pas create mode 100644 Samples/Graphics/GraphABC/graph3d.pas create mode 100644 Samples/Graphics/GraphABC/graphic.pas create mode 100644 Samples/Graphics/GraphABC/rain.pas create mode 100644 Samples/Graphics/GraphWPF/ArcSector.pas create mode 100644 Samples/Graphics/GraphWPF/Clock.pas create mode 100644 Samples/Graphics/GraphWPF/CurjaMurja.pas create mode 100644 Samples/Graphics/GraphWPF/DrawCircleByMouse.pas create mode 100644 Samples/Graphics/GraphWPF/DrawGraphic.pas create mode 100644 Samples/Graphics/GraphWPF/EllRectInWindow.pas create mode 100644 Samples/Graphics/GraphWPF/Ellipses.pas create mode 100644 Samples/Graphics/GraphWPF/anim1.pas create mode 100644 Samples/Graphics/GraphWPF/anim2.pas create mode 100644 Samples/Graphics/GraphWPF/anim4.pas create mode 100644 Samples/Graphics/GraphWPF/mouse1.pas create mode 100644 Samples/Graphics/GraphWPF/mouse2.pas create mode 100644 Samples/Graphics/GraphWPF/ВсеТочкиМногоугольника.pas create mode 100644 Samples/Graphics/GraphWPF/ВыравниваниеТекста1.pas create mode 100644 Samples/Graphics/GraphWPF/ВыравниваниеТекста2.pas create mode 100644 Samples/Graphics/GraphWPF/Многоугольник.pas create mode 100644 Samples/Graphics/GraphWPF/Светофор.pas create mode 100644 Samples/Graphics/GraphWPF/Система координат.pas create mode 100644 Samples/Graphics/GraphWPF/ТаблицаУмножения.pas create mode 100644 Samples/LINQ/Consonants.pas create mode 100644 Samples/LINQ/Delimiters.pas create mode 100644 Samples/LINQ/First3Min.pas create mode 100644 Samples/LINQ/FunTable.pas create mode 100644 Samples/LINQ/Linq1.pas create mode 100644 Samples/LINQ/Linq2.pas create mode 100644 Samples/LINQ/Linq3.pas create mode 100644 Samples/LINQ/MonteCarlo.pas create mode 100644 Samples/LINQ/Palindroms.pas create mode 100644 Samples/LINQ/QuickSortLinq.pas create mode 100644 Samples/LINQ/Seq.pas create mode 100644 Samples/LINQ/SumInv.pas create mode 100644 Samples/LINQ/TextFileCount.pas create mode 100644 Samples/LINQ/TextFileCount1.pas create mode 100644 Samples/LINQ/Zip.pas create mode 100644 Samples/LINQ/Zip2.pas create mode 100644 Samples/LanguageFeatures/AutoClassPoint.pas create mode 100644 Samples/LanguageFeatures/Boxing.pas create mode 100644 Samples/LanguageFeatures/ClassConstructor.pas create mode 100644 Samples/LanguageFeatures/DllTest/MyDll.dll create mode 100644 Samples/LanguageFeatures/DllTest/MyDll.pas create mode 100644 Samples/LanguageFeatures/DllTest/main.pas create mode 100644 Samples/LanguageFeatures/ExtensionMethods/SwapHalfArrays.pas create mode 100644 Samples/LanguageFeatures/ForeachExamples.pas create mode 100644 Samples/LanguageFeatures/ForeachForSet.pas create mode 100644 Samples/LanguageFeatures/ForeachIEnumerable.pas create mode 100644 Samples/LanguageFeatures/FracOperatorOverload.pas create mode 100644 Samples/LanguageFeatures/Generics/GenericClasses/Stack.pas create mode 100644 Samples/LanguageFeatures/Generics/GenericProcFun/FindT.pas create mode 100644 Samples/LanguageFeatures/Generics/GenericProcFun/SwapT.pas create mode 100644 Samples/LanguageFeatures/IndexProperties.pas create mode 100644 Samples/LanguageFeatures/ParamsConcat.pas create mode 100644 Samples/LanguageFeatures/ParamsWriteln.pas create mode 100644 Samples/LanguageFeatures/Pattern Matching/ArithmEval.pas create mode 100644 Samples/LanguageFeatures/Pattern Matching/ArithmSimplify.exe create mode 100644 Samples/LanguageFeatures/Pattern Matching/ArithmSimplify.pas create mode 100644 Samples/LanguageFeatures/Pattern Matching/Squares.pas create mode 100644 Samples/LanguageFeatures/ProcParam.pas create mode 100644 Samples/LanguageFeatures/ProcVars.pas create mode 100644 Samples/LanguageFeatures/ShortTypesInTemplateParams.pas create mode 100644 Samples/LanguageFeatures/Students.pas create mode 100644 Samples/LanguageFeatures/Tuples/MySqrt.pas create mode 100644 Samples/LanguageFeatures/WriteCycledLinkedList.pas create mode 100644 Samples/LanguageFeatures/WriteRecord.pas create mode 100644 Samples/LanguageFeatures/Yields/InfixTraverseTree.pas create mode 100644 Samples/NETLibraries/NET4.0/BigIntegerExample.pas create mode 100644 Samples/NETLibraries/NET4.0/ComplexExample.pas create mode 100644 Samples/NETLibraries/NET4.0/StopWatch.pas create mode 100644 Samples/NETLibraries/NET4.0/TupleCreate.pas create mode 100644 Samples/NETLibraries/System.Array/SystemArray1.pas create mode 100644 Samples/NETLibraries/System.DateTime/DateTime1.pas create mode 100644 Samples/NETLibraries/System.DateTime/DateTime2.pas create mode 100644 Samples/NETLibraries/System.DateTime/DateTimeInterval.pas create mode 100644 Samples/NETLibraries/System.Net/DownloadFile.pas create mode 100644 Samples/NETLibraries/System.Net/MailSend.pas create mode 100644 Samples/NETLibraries/System.Net/Ping.pas create mode 100644 Samples/NETLibraries/System.Net/WebClient.pas create mode 100644 Samples/NETLibraries/System.Parallel/Parallel1.pas create mode 100644 Samples/NETLibraries/System.Parallel/Parallel2.pas create mode 100644 Samples/NETLibraries/System.Parallel/Parallel3.pas create mode 100644 Samples/NETLibraries/System.String/StringConvert.pas create mode 100644 Samples/NETLibraries/System.String/StringMethods1.pas create mode 100644 Samples/NETLibraries/System.String/StringMethods2.pas create mode 100644 Samples/NETLibraries/System.String/StringSplit.pas create mode 100644 Samples/NETLibraries/System.Timers.Timer/SystemTimer.pas create mode 100644 Samples/NETLibraries/System.Windows.Forms/FormWebBrowser.pas create mode 100644 Samples/NETLibraries/System.Windows.Forms/MouseDraw.pas create mode 100644 Samples/NETLibraries/System.Windows.Forms/WinFormWithButton.pas create mode 100644 Samples/NumLibABC/ApproxCheb1.pas create mode 100644 Samples/NumLibABC/Decomp1.pas create mode 100644 Samples/NumLibABC/DiffEqu1.pas create mode 100644 Samples/NumLibABC/Economi1.pas create mode 100644 Samples/NumLibABC/FMinN_1.pas create mode 100644 Samples/NumLibABC/FMinN_2.pas create mode 100644 Samples/NumLibABC/FMinN_3.pas create mode 100644 Samples/NumLibABC/FMinN_4.pas create mode 100644 Samples/NumLibABC/FMinN_5.pas create mode 100644 Samples/NumLibABC/FMinN_6.pas create mode 100644 Samples/NumLibABC/FMin_1.pas create mode 100644 Samples/NumLibABC/Factors1.pas create mode 100644 Samples/NumLibABC/Fraction1.pas create mode 100644 Samples/NumLibABC/Matrix1.pas create mode 100644 Samples/NumLibABC/NumLibABCTest.pas create mode 100644 Samples/NumLibABC/PolRT1.pas create mode 100644 Samples/NumLibABC/Polynom1.pas create mode 100644 Samples/NumLibABC/Polynom2.pas create mode 100644 Samples/NumLibABC/Quanc8_1.pas create mode 100644 Samples/NumLibABC/RootsIsolation1.pas create mode 100644 Samples/NumLibABC/SLAU1.pas create mode 100644 Samples/NumLibABC/Spline1.pas create mode 100644 Samples/NumLibABC/Vector1.pas create mode 100644 Samples/NumLibABC/Zeroin1.pas create mode 100644 Samples/OMPSamples/Hanoi.pas create mode 100644 Samples/OMPSamples/MultMatrix.pas create mode 100644 Samples/OMPSamples/Mutual Lock.pas create mode 100644 Samples/OMPSamples/QuickSort.pas create mode 100644 Samples/OMPSamples/SqrSinArrays.pas create mode 100644 Samples/OMPSamples/SumOfPrime.pas create mode 100644 Samples/OMPSamples/Write Critical.pas create mode 100644 Samples/Other/SpeedTests/CalculationsGlobalLocal/BlockVars.pas create mode 100644 Samples/Other/SpeedTests/CalculationsGlobalLocal/GlobalVars.pas create mode 100644 Samples/Other/SpeedTests/Milli.pas create mode 100644 Samples/Other/UnmanagedGraphics/MessageBox.pas create mode 100644 Samples/StandardUnits/CRT/Bill.pas create mode 100644 Samples/StandardUnits/CRT/CPaint.pas create mode 100644 Samples/StandardUnits/CRT/CRTColors.pas create mode 100644 Samples/StandardUnits/CRT/SimpleTextEditor.pas create mode 100644 Samples/StandardUnits/FormsABC/CalcIntegral.pas create mode 100644 Samples/StandardUnits/FormsABC/PaintBoxDraw.pas create mode 100644 Samples/StandardUnits/FormsABC/f0.pas create mode 100644 Samples/StandardUnits/FormsABC/f0_MV.pas create mode 100644 Samples/StandardUnits/FormsABC/f0_class.pas create mode 100644 Samples/StandardUnits/Timers/Timer1.pas create mode 100644 Samples/StandardUnits/Timers/Timer2.pas diff --git a/Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi1.bmp b/Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi1.bmp new file mode 100644 index 0000000000000000000000000000000000000000..72ae1e4c9fdea2f122289302692fa54459c13299 GIT binary patch literal 30054 zcmeI)TTa6;5CzaubrCFqPrg_H|Lg*>19o3kICbi_*YVBxQPJ2Jg(~B*9nY!5OA()6 zKfk;4$A^1;bD!Vy=gaQ(-2Oi2&%yk1JRNmNKmrnwfCMBU0SQPz0uqowuE1e`2uJQ% z-#-j@CuK8iZd7rl#RE4-bi3e!stbnPUU9qU1%($3*{%<)JgfGs&Tyd)!mRSMI(L8* zmtYhyc8lllsl|w3?ADV^T#E(4(kGs|%a&D&)ec>Ab;?XHzf(gp&)qUySu9$T@#e1w`gSmHqi(>y}!O>y4;Md zR`TTY)IyEKB`f=8mX*<}4b&L7p{$IX%5{^Ktn32zp4wM-E7!9P*LHsJ&ccDtvH}ni z%8KB`samcvZouGH&NUd66O&cgHkOl#%lHT6%P%#qzh&lL`&hZgRtoR_yulXtnBRMX iik?!qqKPQN30q4i5|DrdBp?9^NI(J-kbndl3j6`;>4l>J literal 0 HcmV?d00001 diff --git a/Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi2.bmp b/Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi2.bmp new file mode 100644 index 0000000000000000000000000000000000000000..b6e9bae3b59f375ac6a2471fdb8080a592334041 GIT binary patch literal 30054 zcmeI)L2kk@5QSliI7E-oWmi2w_q|2c8}#-F)sPU-v-6mkbP@Zn49a+HgFlS{6^YNU zpWof(?<3v6rQ7#-d)d8S`rpU=B^d9Hry~sk1Q0*~0R#|0009ILKwzoBVSkv~(z(O< zX?nV-TVZpvs&`sFadSlXPq<>&6;tjXal6+Q8?TtMT_1Voi}t=~usl!$;iBy?8r%R* zzJ;Jba9F;6OFcn^;INit^1Vb5B4hHEo9uZ=@o+$sEX7TE3ZE@5*mkD@F{!pq=5{v+ zGS@%1PAC0EmSSfoAZD96OWtFq_m&bI347C++izkqZEjYd{pS+eAB&CZl9IqmKun00 z!I2bJ0%Ag}434C*5)cz&WpE^gm4KKKD}y5`tOUe_SQ#8iVI?3Y#LD1E3M&CIAyx)Q zQdkLy39&LblEO+rOo)}ikrY+}VnVD8j-;>>5EEi$a3qD5fS3>~gCi-d1jK|5Tcxe7 z-ilw)r_S{sXyZSy&~ROu(^QwjD(;3AR&jy&Na_l!xIla)b%j-2AU-nHm1*&Hnjd*n zIvozuu7=GcL^gPa5}#t&%`XfT(Z+Hr$`m^lcwq8^N={lu_6)#rV zcjC{MRv$$*y|UGFbq4j+D|~-eBUkVr$kz{_sT!xs?C>Ib82eV53ggT*wETVWnwkc4 fF$mnyAj&>GP$UQ-fB*srAbxBmeC_n)UP=Epypa2CZKmiJD6`0ObJhsja z@o~C4saxT2v#K+#o_IK-#|>9xT`}eHipM>#NW5aoaec(jH|4%5SX^j;=BD&F1rLCe zrl1s1hNbI|)T2aDhK(eX=AuE+#H1?^*|SQq8ZabFHYrSjN3#o#-3dUz(AXxW>`EY| z{?a-|`m-$AP9q>7&6FkW0n@Dw2^`V1rcuh*v4EpA%VxhXq4Onsu)0J^&`N-SCanOD z7^0N`0Zm!~95F;I0Roz|0ytubRssYxX$5e^5Um6VXwnMch#^`D5YVI*z!5{V5+I;S zD}W=0XeB^E(}IJK5E$ac^CG(nYFwwTD&Mj9E|A{kigDM*=@B7 z>wpW5G$fK$T7_9Yc*H`&Nky?$s~CwF9Da0hD1S!pCG8bbDdp9=Dor%lPb>YCPAgjJ z1@w`uD_ZFV^pUJ9TImJ!k*==5pYn#6H493DZFpobDZ*{1DZbCz<-%49ox zd|;$``kpODTTUsOy#k|^vU=;GLYbK&DT}Jx4am9* z0{X|%-#PFe)Zc^MZo|=wDv^a^j!YT;7;0r~dk z(^X@vOoJ!do6)vXEDX;Tj`Zi?Z72rwBnaHmNR+&JV3AOO0u-PC1t>rP3Q&Lo6xc)H E4_cF#D*ylh literal 0 HcmV?d00001 diff --git a/Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi4.bmp b/Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi4.bmp new file mode 100644 index 0000000000000000000000000000000000000000..e097634893495527cc8c9f4602e6d42413f69fe7 GIT binary patch literal 30054 zcmeI&L2kk@5QSlia)=(G%dUEW?t6=>H|XsnR0jw1ltkkvl5UtEnP|dHBjsb9I>6`G z&+qB__$b@A^8B8kFQ?b*>+f^^x-)Oa%g8_g0R#|0009ILKmY**5ZEuEw^}9E0|qHA z%Neh&aymF?jg_NRYp}w~7w{|TE3AA0zmmSf$`|k}=_{;!0l$*I!pax$E9on&d;!0b zzH+RF^AHT@2zhD>)Oa2@$CTpd79xO^-w#+}esL#4%Q}k7lt_jX1_C_R%a>su9On#XgH{<8tl? zTk+x`Np{=mW7U1fvFZ}F0<0QEH^8b()C#a_6x{%;E>SDMs!?OT&ljuMN3&R|MjT@m`)C#`)re!PVjs<7r5bUJRqUhLVigRnOdj8r zF2k@GH^bya_4FsGh0o@0?q4I%?X)Sg`C`3o%y(Dlw$mCdUxQ&~UV$Hns%@60we~_~ z;=;-r@VC#ta$pYnbMUZf`0PzpNsnnQthiXMK1JEv zS~;4kUD+PzN(Qy-3ZKtv<}yD(zAZjWH@4197`T%$w^D12iK~wF|G`_T6%$l}I~qi* Y#RE-(00IagfB*srAbge@A6jCL0RR91 literal 0 HcmV?d00001 diff --git a/Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi5.bmp b/Samples/Graphics/ABCObjects/Sprites/SpriteFrames/multi5.bmp new file mode 100644 index 0000000000000000000000000000000000000000..727d8217091d012c13c0903891becbff469b0134 GIT binary patch literal 30054 zcmeI&L2iRU429t|;t)MTmtFM$-S-w%Z_wMLsFMtFo&b3qK&mwUD}oF*Nb|)*AnE7V z&+qB>_fghw<@G(iUQVyK{qIx$wlS^7%gBNN0tg_000IagfB*srAh2IRAGJ!XCv;L; zmN2d|I`HKl&8CfK9i-iibZ_-k&pcJ!8Qq4lZ#bkIv@-VK@Z*);;H(bB zckr{TC+vRb(qy@(dxXdUhx6bpku&6}DNy5iTwSgyemW5Wtm6HE6;^S9cqM)1Ta{Y^ zD+pTYA$DwrKnISM|Bhqj`)C#`)$n7id>_qXr5b*WmG7fjtW?8~vGRR1i2h zX0cKYKgP=UnPrVD@;qq8vy&v*wBcjbe8;hB5?KLOM$rtgY7$uiRz}ebuxb)n0aixQ z46tevX+hyCH&_1s)l?wAQ|lSB#lBTG4S&2?`97M(N;Ui#E8j=6SgD2|W99p37Aw{8 zW2}51%@!+X(aPlUL+LUMv*m7>oTv`}3N`at-OT;p$WuG5%B=3JkB#}B3Zw0`M9bG; zSOu@Z+o5WkrD?6bP?@-}3eLV#hE>q&7^oc65UXHQ9X0{!t11v*_kQQV9E{Jw!=_>H zO;t&cX)Ua{SS`Lq+1pwh48AAPo&*#H0l literal 0 HcmV?d00001 diff --git a/Samples/Graphics/ABCObjects/Sprites/gr_SpriteCreation.pas b/Samples/Graphics/ABCObjects/Sprites/gr_SpriteCreation.pas new file mode 100644 index 0000000..efe2a13 --- /dev/null +++ b/Samples/Graphics/ABCObjects/Sprites/gr_SpriteCreation.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/ABCObjects/Sprites/gr_SpriteUsing.pas b/Samples/Graphics/ABCObjects/Sprites/gr_SpriteUsing.pas new file mode 100644 index 0000000..df48901 --- /dev/null +++ b/Samples/Graphics/ABCObjects/Sprites/gr_SpriteUsing.pas @@ -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.StateWJ9)2s46thlKm`OMtn`SmqGX^t_9LqFIn=&>0#!yMq9I?Wnw8iOT7K=JN zYnhpwR+bu~sFNnL=%|$nngVLZjFDepGL9hmh5N#b9nYRK`v)KQ-rxP*=lR{|KKK4~ zJ0Ic#o;1vJ>%L(BBn3bmBcc|xKJMd>&YJksPfGtFgf(;Y0r@tovl(P_X z(J-)W_QQdYQ~BtMA(fR(epUY>zzkstd8C~v*jUOsw!n`+@#b_|vv@UHZC z1cYm-*CyqGD6>nCbl=7tFR=Akn3>)Q0P_S60Jw39%YZX+g5|(S8v_P(#~H-Kb!tWE4pWIw&{>G3w?w!__aoESSoc2`#H=hi%? znWAt_42}B8?)Nt>3Vo3HijiCUSF_jhhz@Xh+W_I>yC{6FT>Y}ZFeDJ4uqwT6*-W*3 z)w2*Zm(x(>@Rk1VCKX?zL)Zh~K_izc+%VA=t`SCJqJ2(xGwB zH;YW{THnzLoV0@mTKY`mvPMSJvCnCpE1R~}`Svr!7H0Av?tNxvvCr*-mFz2uAfdL| zdc%MtJUJUpePBSB!eg&OnGI4f3gp9y{xE}ft!I(1U?Z)iAGc@Tg~vF{0%VWZbfl?smb+P zomFYUZGx=S7q0Vw1cpb50FMJsv7k z7xERdLfRhXu_Ut2@2t~&5VtH)`z8uEdvLKq5$@I zGF=3oFZ*7513gv*mEpQe7sZp-v?WhAb!fcxW)$i*B_rjVYN2iuzP|p2b#JCoZtSk1 zP{)I0zwVJFge1XQeOoap!f4lBJ)u;mGFg-TPtf-u!KUQ7NGTz1qyq2cC{A_u1KSM} zN)njy#vav6&0LrYUFQvzCp4*=nGoM6H>k!jf)h-K{}O%-^^a#fQE%!dkw)QZ3+=CU zUsfwjk>mTq3qvT0{UZu}vEFT6m}u{Ax=RbMFS8!nHcI8Lg#d>@Lw&K=LOIpN0>_0& zFx@t94JMLW4JR4J6wj3v)>4t>APx5qgZWJldiqRzWrs3+=-aa){b#$YuSIc!lRD^` zbG6lJ!lJk73#ucyp5k%qM|WEy=I(lS5|!iJQ2qk->Bht$ZB{_L+%kRc(*)ggf2PAE zEuV)krjtPn5ch9>>8E}knX7V>+u^IV&ds;bS)JJ>8j%k@QT2%Les47bSv0CInTm_= zB3%?}S(CL`{75U~UrNhiP~!2ly5qTniq7E@(=ZXu$XFV}p}ZToK;XFgv$Q9%{n(aB zyo8@Ds@g3nfe$YkEbkk;(U$DRDvVmezdj;xMwW(CU2Tz=!(F5-7cMr{rk6B-S18Ny zv7>WXFnj4H;Z+#3OFdH59v^fuoki88X_R$Ls^)iRMDTqVsmm}ApB@pm+dfYpl@^iv zeVH}yMaxW;_QKHD=c%i8w_*0J?`Q^GlYQYd(a>wOU44FUL~rIo1u?dq2y@@~W4YRu z-A?NETT9ED)5ZO>LoTf6Z_Xc$ex+z-tRHJz7L9^TWGRL^7A<)H?dO#%2%LsIvn5kN@R!}cSi0~DfjM>SO1aSszzu6+tRMGV zx-JuD-=DLH9<*eTQNyk;^)3t@J&=zpd<*2uU=KT1U_N|l(I^Y_Tn11#^*(N}PCb)w zn<=!Ir#{|ZAMox_hIq{We;Rc{2JR=t8rKa{qumDZd__~ucsqo|1kKxiUQl}lQaD)0 zD}xs64v8gW!yib<(q^V)cGPfdd?+Wz64G_dM+v8vIYF!SF7I(Xg5>&6@LW2eoG zmgOvz!4gzw!TVD_r`14lAX$DSZPPg{SZ}6oaqGrgC(%t<}aTdfB80Hr|afzC4NoOzY0*@;M)lB M-GA7Ny_d-NFFO0S8vp$vI6S#2Y0o?b>OL-Na04GX>#&$d1ot{8yQk5yUtd?x;WWRs>`np{| z-|YFtzCY}Hfj(`Y?YV6~Z~g1x_V|7J&$d|vmd2TbxMzTu;+#oH26!P(_)gq^1zi1v zFGR@Tgm1$=1FX*f2NQ1tuJC=L)c;>JGC(9l3xSLzioHSLvtYig)y`lv2Hl=3riCt- z5(p~uxO$&~nLDe9I0BBGT8os~4=$9dP4`R3jWI}}!AT3w^Q}W&9%W$T7cmsA=l6~Z zOu~xTokoIKDxdC}GN%XWyogEk*?F;`^<`iJ8iUq__VSkbI!%V*@S$TvHPyff|1f}< z0p?^9bF+mEOtrR3<2f1}T8@!)PBoH2rzB~dr4=ff4~tQSA?qvyn`qQCU4kNIY0I^a50-XRBPH~JFptb3@s>!G1ybNNbij1s>gx&!DwL&%9VmXHWNwYo#;=)xFH1HNJ}V)M}{w z9(~7wRD7yzXHDgH2Bt(-r)ojt)XM46@8PKCPz~`{WiT|Fk`KzjWbrYtb_Pb#Sx~27 zq%A~_aOC#)rP6sF>&^w7WRr?40T0SRXUqQB)=!-QrY)6RTQ9dWL8sZBfnIeQYnOIv z>g!q)$5buLph5im6G#aY6LnrOyG~|JYmJ@BN6!?AU_HWgw`F9werkO%Q_gG#5G#aJ zw>dDn#MKQc#G`_e!__Djk-fmhK#?Qri-)+NzG63AyKVr`9H>VT1{}pAq5@XK!nX}e0hr9-2hq9w8r4;d`feix~I2JbTU+BqeIwZdnil 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. \ No newline at end of file diff --git a/Samples/Graphics/ABCObjects/gr_Intersect.pas b/Samples/Graphics/ABCObjects/gr_Intersect.pas new file mode 100644 index 0000000..243b5bb --- /dev/null +++ b/Samples/Graphics/ABCObjects/gr_Intersect.pas @@ -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. diff --git a/Samples/Graphics/ABCObjects/gr_Move_Param.pas b/Samples/Graphics/ABCObjects/gr_Move_Param.pas new file mode 100644 index 0000000..1b2c1f8 --- /dev/null +++ b/Samples/Graphics/ABCObjects/gr_Move_Param.pas @@ -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. diff --git a/Samples/Graphics/GraphABC/DigitalClock.pas b/Samples/Graphics/GraphABC/DigitalClock.pas new file mode 100644 index 0000000..5fcaca2 --- /dev/null +++ b/Samples/Graphics/GraphABC/DigitalClock.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Flame.pas b/Samples/Graphics/GraphABC/Flame.pas new file mode 100644 index 0000000..eaaaea7 --- /dev/null +++ b/Samples/Graphics/GraphABC/Flame.pas @@ -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. diff --git a/Samples/Graphics/GraphABC/Fractals/Dragon.pas b/Samples/Graphics/GraphABC/Fractals/Dragon.pas new file mode 100644 index 0000000..27570e5 --- /dev/null +++ b/Samples/Graphics/GraphABC/Fractals/Dragon.pas @@ -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. diff --git a/Samples/Graphics/GraphABC/Fractals/Mandelbrot.pas b/Samples/Graphics/GraphABC/Fractals/Mandelbrot.pas new file mode 100644 index 0000000..ea950e7 --- /dev/null +++ b/Samples/Graphics/GraphABC/Fractals/Mandelbrot.pas @@ -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. + diff --git a/Samples/Graphics/GraphABC/Fractals/Paporotnik/Main.pas b/Samples/Graphics/GraphABC/Fractals/Paporotnik/Main.pas new file mode 100644 index 0000000..3946450 --- /dev/null +++ b/Samples/Graphics/GraphABC/Fractals/Paporotnik/Main.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Fractals/Paporotnik/Paporotnik.pas b/Samples/Graphics/GraphABC/Fractals/Paporotnik/Paporotnik.pas new file mode 100644 index 0000000..3d689e7 --- /dev/null +++ b/Samples/Graphics/GraphABC/Fractals/Paporotnik/Paporotnik.pas @@ -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 := Pmax и |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. diff --git a/Samples/Graphics/GraphABC/Graphics/DrawFunc.pas b/Samples/Graphics/GraphABC/Graphics/DrawFunc.pas new file mode 100644 index 0000000..f71ee1b --- /dev/null +++ b/Samples/Graphics/GraphABC/Graphics/DrawFunc.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Graphics/DrawFunc2.pas b/Samples/Graphics/GraphABC/Graphics/DrawFunc2.pas new file mode 100644 index 0000000..5012ab2 --- /dev/null +++ b/Samples/Graphics/GraphABC/Graphics/DrawFunc2.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Hypno.pas b/Samples/Graphics/GraphABC/Hypno.pas new file mode 100644 index 0000000..f9d4ab0 --- /dev/null +++ b/Samples/Graphics/GraphABC/Hypno.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Mosaic.pas b/Samples/Graphics/GraphABC/Mosaic.pas new file mode 100644 index 0000000..4aee71d --- /dev/null +++ b/Samples/Graphics/GraphABC/Mosaic.pas @@ -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. diff --git a/Samples/Graphics/GraphABC/MouseDownEvent.pas b/Samples/Graphics/GraphABC/MouseDownEvent.pas new file mode 100644 index 0000000..5dceee1 --- /dev/null +++ b/Samples/Graphics/GraphABC/MouseDownEvent.pas @@ -0,0 +1,5 @@ +uses GraphABC; + +begin + OnMouseDown := (x,y,mb) -> Circle(x,y,5); +end. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/MouseDraw.pas b/Samples/Graphics/GraphABC/MouseDraw.pas new file mode 100644 index 0000000..85ccdfb --- /dev/null +++ b/Samples/Graphics/GraphABC/MouseDraw.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/SetPixel.pas b/Samples/Graphics/GraphABC/SetPixel.pas new file mode 100644 index 0000000..498bb4a --- /dev/null +++ b/Samples/Graphics/GraphABC/SetPixel.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/Stamp1.pas b/Samples/Graphics/GraphABC/Stamps/Stamp1.pas new file mode 100644 index 0000000..be42fe3 --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/Stamp1.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/Stamp2.pas b/Samples/Graphics/GraphABC/Stamps/Stamp2.pas new file mode 100644 index 0000000..9b9427d --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/Stamp2.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/Stamp3.pas b/Samples/Graphics/GraphABC/Stamps/Stamp3.pas new file mode 100644 index 0000000..e985dad --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/Stamp3.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/Stamp4.pas b/Samples/Graphics/GraphABC/Stamps/Stamp4.pas new file mode 100644 index 0000000..0775030 --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/Stamp4.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/Stamp5.pas b/Samples/Graphics/GraphABC/Stamps/Stamp5.pas new file mode 100644 index 0000000..abc6ca3 --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/Stamp5.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/StampCompound.pas b/Samples/Graphics/GraphABC/Stamps/StampCompound.pas new file mode 100644 index 0000000..f8f44be --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/StampCompound.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/StampCross.pas b/Samples/Graphics/GraphABC/Stamps/StampCross.pas new file mode 100644 index 0000000..43dbada --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/StampCross.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/StampFunc.pas b/Samples/Graphics/GraphABC/Stamps/StampFunc.pas new file mode 100644 index 0000000..9357dc6 --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/StampFunc.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/StampPoly.pas b/Samples/Graphics/GraphABC/Stamps/StampPoly.pas new file mode 100644 index 0000000..ced69f1 --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/StampPoly.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Stamps/StampText.pas b/Samples/Graphics/GraphABC/Stamps/StampText.pas new file mode 100644 index 0000000..71b1742 --- /dev/null +++ b/Samples/Graphics/GraphABC/Stamps/StampText.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Star.pas b/Samples/Graphics/GraphABC/Star.pas new file mode 100644 index 0000000..76054f2 --- /dev/null +++ b/Samples/Graphics/GraphABC/Star.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/Tentacles.pas b/Samples/Graphics/GraphABC/Tentacles.pas new file mode 100644 index 0000000..1de368e --- /dev/null +++ b/Samples/Graphics/GraphABC/Tentacles.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/ThroughTheUniverse.pas b/Samples/Graphics/GraphABC/ThroughTheUniverse.pas new file mode 100644 index 0000000..a6840cd --- /dev/null +++ b/Samples/Graphics/GraphABC/ThroughTheUniverse.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphABC/graph3d.pas b/Samples/Graphics/GraphABC/graph3d.pas new file mode 100644 index 0000000..ea0587a --- /dev/null +++ b/Samples/Graphics/GraphABC/graph3d.pas @@ -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 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]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. diff --git a/Samples/Graphics/GraphABC/rain.pas b/Samples/Graphics/GraphABC/rain.pas new file mode 100644 index 0000000..17f971f --- /dev/null +++ b/Samples/Graphics/GraphABC/rain.pas @@ -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. diff --git a/Samples/Graphics/GraphWPF/ArcSector.pas b/Samples/Graphics/GraphWPF/ArcSector.pas new file mode 100644 index 0000000..b67e15e --- /dev/null +++ b/Samples/Graphics/GraphWPF/ArcSector.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/Clock.pas b/Samples/Graphics/GraphWPF/Clock.pas new file mode 100644 index 0000000..7fd909e --- /dev/null +++ b/Samples/Graphics/GraphWPF/Clock.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/CurjaMurja.pas b/Samples/Graphics/GraphWPF/CurjaMurja.pas new file mode 100644 index 0000000..91574aa --- /dev/null +++ b/Samples/Graphics/GraphWPF/CurjaMurja.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/DrawCircleByMouse.pas b/Samples/Graphics/GraphWPF/DrawCircleByMouse.pas new file mode 100644 index 0000000..75b1057 --- /dev/null +++ b/Samples/Graphics/GraphWPF/DrawCircleByMouse.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/DrawGraphic.pas b/Samples/Graphics/GraphWPF/DrawGraphic.pas new file mode 100644 index 0000000..8632364 --- /dev/null +++ b/Samples/Graphics/GraphWPF/DrawGraphic.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/EllRectInWindow.pas b/Samples/Graphics/GraphWPF/EllRectInWindow.pas new file mode 100644 index 0000000..12386e2 --- /dev/null +++ b/Samples/Graphics/GraphWPF/EllRectInWindow.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/Ellipses.pas b/Samples/Graphics/GraphWPF/Ellipses.pas new file mode 100644 index 0000000..dbaf68a --- /dev/null +++ b/Samples/Graphics/GraphWPF/Ellipses.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/anim1.pas b/Samples/Graphics/GraphWPF/anim1.pas new file mode 100644 index 0000000..0160433 --- /dev/null +++ b/Samples/Graphics/GraphWPF/anim1.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/anim2.pas b/Samples/Graphics/GraphWPF/anim2.pas new file mode 100644 index 0000000..d9a0a6d --- /dev/null +++ b/Samples/Graphics/GraphWPF/anim2.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/anim4.pas b/Samples/Graphics/GraphWPF/anim4.pas new file mode 100644 index 0000000..4d2d5a6 --- /dev/null +++ b/Samples/Graphics/GraphWPF/anim4.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/mouse1.pas b/Samples/Graphics/GraphWPF/mouse1.pas new file mode 100644 index 0000000..8349d01 --- /dev/null +++ b/Samples/Graphics/GraphWPF/mouse1.pas @@ -0,0 +1,6 @@ +uses GraphWPF; + +begin + OnMouseDown := (x,y,mb) -> if mb=1 then Circle(x,y,5); + OnKeyDown := k -> Print(k); +end. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/mouse2.pas b/Samples/Graphics/GraphWPF/mouse2.pas new file mode 100644 index 0000000..af3d6a8 --- /dev/null +++ b/Samples/Graphics/GraphWPF/mouse2.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/ВсеТочкиМногоугольника.pas b/Samples/Graphics/GraphWPF/ВсеТочкиМногоугольника.pas new file mode 100644 index 0000000..0779979 --- /dev/null +++ b/Samples/Graphics/GraphWPF/ВсеТочкиМногоугольника.pas @@ -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. diff --git a/Samples/Graphics/GraphWPF/ВыравниваниеТекста1.pas b/Samples/Graphics/GraphWPF/ВыравниваниеТекста1.pas new file mode 100644 index 0000000..de8e67e --- /dev/null +++ b/Samples/Graphics/GraphWPF/ВыравниваниеТекста1.pas @@ -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. diff --git a/Samples/Graphics/GraphWPF/ВыравниваниеТекста2.pas b/Samples/Graphics/GraphWPF/ВыравниваниеТекста2.pas new file mode 100644 index 0000000..f8e6229 --- /dev/null +++ b/Samples/Graphics/GraphWPF/ВыравниваниеТекста2.pas @@ -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. diff --git a/Samples/Graphics/GraphWPF/Многоугольник.pas b/Samples/Graphics/GraphWPF/Многоугольник.pas new file mode 100644 index 0000000..2d6e3c8 --- /dev/null +++ b/Samples/Graphics/GraphWPF/Многоугольник.pas @@ -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. diff --git a/Samples/Graphics/GraphWPF/Светофор.pas b/Samples/Graphics/GraphWPF/Светофор.pas new file mode 100644 index 0000000..26176c9 --- /dev/null +++ b/Samples/Graphics/GraphWPF/Светофор.pas @@ -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. \ No newline at end of file diff --git a/Samples/Graphics/GraphWPF/Система координат.pas b/Samples/Graphics/GraphWPF/Система координат.pas new file mode 100644 index 0000000..343c23e --- /dev/null +++ b/Samples/Graphics/GraphWPF/Система координат.pas @@ -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. diff --git a/Samples/Graphics/GraphWPF/ТаблицаУмножения.pas b/Samples/Graphics/GraphWPF/ТаблицаУмножения.pas new file mode 100644 index 0000000..5565ca7 --- /dev/null +++ b/Samples/Graphics/GraphWPF/ТаблицаУмножения.pas @@ -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. diff --git a/Samples/LINQ/Consonants.pas b/Samples/LINQ/Consonants.pas new file mode 100644 index 0000000..c73dfef --- /dev/null +++ b/Samples/LINQ/Consonants.pas @@ -0,0 +1,7 @@ +// Вывод английских согласных +var vowel: string := 'aeiouy'; + +begin + var all := Range('a','z').JoinIntoString(''); + all.Except(vowel).Println; +end. \ No newline at end of file diff --git a/Samples/LINQ/Delimiters.pas b/Samples/LINQ/Delimiters.pas new file mode 100644 index 0000000..60a7298 --- /dev/null +++ b/Samples/LINQ/Delimiters.pas @@ -0,0 +1,4 @@ +begin + Range(#0,#127).Where(c->char.IsLetterOrDigit(c)).Println; + Range(#0,#127).Where(c->char.IsPunctuation(c)).Println; +end. \ No newline at end of file diff --git a/Samples/LINQ/First3Min.pas b/Samples/LINQ/First3Min.pas new file mode 100644 index 0000000..0c24541 --- /dev/null +++ b/Samples/LINQ/First3Min.pas @@ -0,0 +1,4 @@ +// Первые 3 минимума +begin + SeqRandom(20).Println.Sorted.Distinct.Take(3).Println; +end. \ No newline at end of file diff --git a/Samples/LINQ/FunTable.pas b/Samples/LINQ/FunTable.pas new file mode 100644 index 0000000..33273e8 --- /dev/null +++ b/Samples/LINQ/FunTable.pas @@ -0,0 +1,6 @@ +// Вывод таблицы значений функции sin + +begin + Range(0,Pi,20).Select(x->Format('({0:f4}, {1:f7})',x,sin(x))).Println(NewLine); +end. + diff --git a/Samples/LINQ/Linq1.pas b/Samples/LINQ/Linq1.pas new file mode 100644 index 0000000..91e0001 --- /dev/null +++ b/Samples/LINQ/Linq1.pas @@ -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. + diff --git a/Samples/LINQ/Linq2.pas b/Samples/LINQ/Linq2.pas new file mode 100644 index 0000000..1a5df0a --- /dev/null +++ b/Samples/LINQ/Linq2.pas @@ -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. + diff --git a/Samples/LINQ/Linq3.pas b/Samples/LINQ/Linq3.pas new file mode 100644 index 0000000..3b3cda4 --- /dev/null +++ b/Samples/LINQ/Linq3.pas @@ -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. + diff --git a/Samples/LINQ/MonteCarlo.pas b/Samples/LINQ/MonteCarlo.pas new file mode 100644 index 0000000..67f11a4 --- /dev/null +++ b/Samples/LINQ/MonteCarlo.pas @@ -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. \ No newline at end of file diff --git a/Samples/LINQ/Palindroms.pas b/Samples/LINQ/Palindroms.pas new file mode 100644 index 0000000..03f4a42 --- /dev/null +++ b/Samples/LINQ/Palindroms.pas @@ -0,0 +1,6 @@ +// Вывести все палиндромы в строке, упорядоченные по длине + +begin + var s := ' hello aha paap zz '; + s.ToWords.Where(w -> w.Inverse = w).OrderBy(s->s.Length).Println(','); +end. \ No newline at end of file diff --git a/Samples/LINQ/QuickSortLinq.pas b/Samples/LINQ/QuickSortLinq.pas new file mode 100644 index 0000000..c1f7cf9 --- /dev/null +++ b/Samples/LINQ/QuickSortLinq.pas @@ -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. \ No newline at end of file diff --git a/Samples/LINQ/Seq.pas b/Samples/LINQ/Seq.pas new file mode 100644 index 0000000..c7eb39c --- /dev/null +++ b/Samples/LINQ/Seq.pas @@ -0,0 +1,3 @@ +begin + Seq(1,5,3,2,4).Print; +end. \ No newline at end of file diff --git a/Samples/LINQ/SumInv.pas b/Samples/LINQ/SumInv.pas new file mode 100644 index 0000000..c17199d --- /dev/null +++ b/Samples/LINQ/SumInv.pas @@ -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. \ No newline at end of file diff --git a/Samples/LINQ/TextFileCount.pas b/Samples/LINQ/TextFileCount.pas new file mode 100644 index 0000000..0f9d80b --- /dev/null +++ b/Samples/LINQ/TextFileCount.pas @@ -0,0 +1,7 @@ +begin + var d := new Dictionary; + 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. \ No newline at end of file diff --git a/Samples/LINQ/TextFileCount1.pas b/Samples/LINQ/TextFileCount1.pas new file mode 100644 index 0000000..087d9a2 --- /dev/null +++ b/Samples/LINQ/TextFileCount1.pas @@ -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. \ No newline at end of file diff --git a/Samples/LINQ/Zip.pas b/Samples/LINQ/Zip.pas new file mode 100644 index 0000000..add9cd1 --- /dev/null +++ b/Samples/LINQ/Zip.pas @@ -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. \ No newline at end of file diff --git a/Samples/LINQ/Zip2.pas b/Samples/LINQ/Zip2.pas new file mode 100644 index 0000000..54eb378 --- /dev/null +++ b/Samples/LINQ/Zip2.pas @@ -0,0 +1,4 @@ +begin + var a := Seq(1,5,3,2,4); + a.Zip(a.Skip(1),(x,y)->y-x).Print; +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/AutoClassPoint.pas b/Samples/LanguageFeatures/AutoClassPoint.pas new file mode 100644 index 0000000..1ca23b8 --- /dev/null +++ b/Samples/LanguageFeatures/AutoClassPoint.pas @@ -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. \ No newline at end of file diff --git a/Samples/LanguageFeatures/Boxing.pas b/Samples/LanguageFeatures/Boxing.pas new file mode 100644 index 0000000..8f7eec8 --- /dev/null +++ b/Samples/LanguageFeatures/Boxing.pas @@ -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. \ No newline at end of file diff --git a/Samples/LanguageFeatures/ClassConstructor.pas b/Samples/LanguageFeatures/ClassConstructor.pas new file mode 100644 index 0000000..c9f9d8d --- /dev/null +++ b/Samples/LanguageFeatures/ClassConstructor.pas @@ -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. \ No newline at end of file diff --git a/Samples/LanguageFeatures/DllTest/MyDll.dll b/Samples/LanguageFeatures/DllTest/MyDll.dll new file mode 100644 index 0000000000000000000000000000000000000000..9a9c8f82715d6198e732ca50e3316357d55290ce GIT binary patch literal 16384 zcmeHNeQaCTbwBrgk$SRdQIaJ&reZ3R8^*O6S+Qq1u@`+&wi3xwOu4b@G&Ds$%Uno4 z<&ko%G;@@7OOdU`Hq01`bOV~SKoazic3ajt!-AnjGPp(ZM}Q680%yp_uyyMObivSN zLuT)H&U>V&*v??=zk*MC=iT#h?>+Z-&bjaLk<*|59ny)&zPsUBab~Sj;coQuJwy*m>jq?)XwwZ;pDKOphfe*t_vGW5s>yBZf(K@!#Y#`7;pn*UGfd&E%1R4l55NIIKK%jv@1Aztt*C6mS zeE#KwKbvY~(#1Q7K8_M8k={IMAJ8a-Zs;G?5}@`@Y7aiIYLHditpBvO6^xPiERnU7 zWDNF+`+*hy|F+SnrRs}|mZc@&13cpXikfg`pAvWhV!vhcG>}{L46YDG^^Pm*z^!0B zaLWn2VzB)d-YVEbr=b|aNxBP1>;zVAZ*Q4T!Il7E?W|MVLp#JCF9z(yZulc(>h3x( zBlG(PJpu1*Jz<0Te$}l-PxPX*i&p`G&q`hkFgA&1bnwtxPGA^&Cu4kbICY>yJx({< zzw7_m{}$;V0rl4%qBQUT_|fx#)#yY_017332^NCCme`DD^Z7Ptx3@se_;rQ0+gDU( z2uM)p0f0iCYusIWgx1(L#1X$fK8m;p<9Qx)87?@n)u^*xuDJ-3Rd0gvG}^Yo#*ft} z4ciAy+6OxXJSyR`HO@AkR&vZ9+R9Dv%UW}r^035ZPGLI%WbA6LYSg=7u62L(^=9Bb z=e8*si+qS`E=IJw=9@e1AIuer(^hJ?Wx4CHmV2TIoaRk)F}> zShT^}^F0U>m=G2|1Xr{JdB_58zB%+&Xw|09mZs1_j(WIBa_{-3t`jXoKLH})H6E*K z-)?rb8$+0qWQwTKHE%_YXP-yoM7t3+qNb1K-=pWyUYK>ZTTx5qXb*L^hoj-Bb&vsw zhN5AArf3*l!$a?*M>Hgp2^jD29`%`bK&T7|tTiq>ugtMP#o22}R-=ra#a=_UF+d7e zJ}zA%3wfouj)A*i@8h?T-!>4XP8a}XA1?u@699FiSC_1>^I7jn%$R`0uI?OfvsPkL zMmqX_B~Y4n#}#W3f-<%%+l7h+`&fV%x^|)mVA?FB59rflPl-$5FJn4*;N$`YC8cXt&VYgx)FikeW~y%?dp!^o-CIp}!{d zw_$11x7BN~{2TQi=+C9^|A^ewnl+1V)p(XZp}T|*3Oyk7UX5qDPuiaodJ5F0C$-m9 zgubqQi1rII&UZxneeFG7Qh++6&#SSi4R{NO@3Fe6k5<8H^c-|aaBLqI%l+WkvPHNf z0oOqa!<-b(q%P5&q7~{uuUmxc6J3~Y74B(z8l!Bc-NLQF(nQ7%2=^RjWp0mfZQ@xw z?)m(D_ycfF81){}y+LolvI8;Gsi+?UUDiiH%X$j*tUd|4s!xOZ+9&h}5b{^`KLCAG z{|4y$`Zqy8ly=y70qvy0^8G?f#&^+v!gv|fHd)?dz6CmAzD?gkJt7CXm2ShA7vsWF zNH}im^j9jPN5oI&o`z+IWRtJ!(r>Bb_UZjt$we6@+C8D~lp5r5Cd_F)S;x)mgB!U0 zQdPdCgW1D$p>C8gy&)WORdknqPP`7&N5V}go*_)Fy@X>z@eE;lvBvEO;;#i9&tTKL z!ufvM^dG|cGuUL@#-sSS*c2D8YPr|fi7z&dZ?HVI!LqW!^4B+5enYqkVy|r!IL}v| zp+mS%a)6*syK3BVaI-b;^VrSK1>BePQ@9`eMNM}anfF+ z7U=FXz75^QfO{B^4?T1V_YQ1nV%bA~yMg<(>2q=If&Y;r#jfXe!X{GXEO7QvtWv+(|p=T%F|(nvL`9 zeopM53mbI2vux3;RHHt$b=oD8dxd6%=5Ek_vQGPZXlwK}k^G_1=WA4>Z{48%>6YJ> zUJn`U;RR5Qe0$&LA73NKBRp&dO%u5iCEgvHgg!+_%y;N1nl@j@XLF`als4a^-=&l0 zKcc;4{+nozi}pC$%RurO(ATjaE}8#MFVW-X&*_ioDf44`1#+7nz&NB{0Ue~Rn1$3! z^cB-o-=_;^vwBn{*vH|+OZ0--s(wg+Vs@&xAnBkV((C3n^>@;Kk1m_N==(GCc9o_7 zGI9137jC2M zr`M73=L$IvPP>aM1?QJ(*8fQdO|Om@3e>;o6r81O#TlU4kw-0QOTAT zv)*DL7+EM+ylk#AnlEL&)row;p*jBbLnd>~$u6ezOQmdKW->5l;bPu%a+S#$Oz+f9 zk;xaA3r^7~RkD@5Tk4kq>TRzv=s%1nn2}1w^F6;tUo7WbuaIA$U~>PGd@x^HbRR1x zCtR;srkRCbfj7j%4VHSG*0bF-X}${&7K-j$snFNMmlP>>^U*&ce!4brIwF>{7`sSMoVbxw?!v zf{byLCQFsO2HAO@W5n~as}kd29jVgUyyuoUbTqQOJnj~=`4Zh=K}Tej-gVbh)nSlA zKIc1(^W(b*8>@Vb8Mwl$rqiZZ|-<$$2*(H zkd(|-T#x!EOZiGaR(RHZ#36@9ouzy!;BwV)-|kA5+)k;|VxaT5r}K2WObZ?@JVs^wd$f$SoptjiWW}5tAd5bGxZ@yYIqawDY_>oG zGKN6AO#K;lH^XZ$0?4U+$&n11EC&&-hi+`e^AM9->8_XFWJv-q6_`5b$`((~!L)O2QgX8ib6inx%nm5G9ztsGq`E+Ea} zDEpaT&%4yo`qcDFi!{ElR7>@0;LA>lOD2s=O*iKTPNh80^@0i$P_CxDm{Xr z21N$PGS?OwvG|kg_M;?Y)UciLH$V1dvRn;1*El=kXHT{M?$6`iz=qSP#_W{*_93|rKz29IJ>U+Z_b}-F(8p;U+yUbr(1V6*b}+_n zI*xbEs`n%vqZEzPq+G{n4y_rQ#yJl87l^i{nTrJ_+sw^eLJR zdLD(`*Pp~FDa?@$da-;D`kjPi4ze-2Uu*|OmZGDW5o7lF9*uyTf-DVx4&yokj=h;h z=9MW2T7Ya6qa>kCVMHS5H$MK+kB>Y&`kVjqgFo(h_COr%kMc!P~@z(z!ym2S0d#o2?i7v~O~ci`M@;3I4dk5g*1 z0*x@mh$86`+7`1QX^X`|atVapBJB2s-90hg>WOF;-qyCY;@pH$BM~$X;5@{pv9>)t zNm~og7x5+gG)u>9;c!^9!f-i^$hJ*dq@vSplW;!*_ahNlL@-vI)#!=^M|2&}pFOOB z3e7f0mYtUwiqav54t#2?UI~#AiNs6)wD4GAEkt@q={UniNW-WhEyAsE*bW&z zG5>E<$O`ww@XvoRjYL9CJ&`c}ae!_Lg?b`vzyc$LC0ZekZP5nd2fHx8MevWy_XG`G zu5dfP&eyl9-|f}QP)cL2ho`t{z5~nikK+VohhG5ip!o1c^9I*Ipn; + +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; + l.AddRange(b); + l.Reverse; + // Цикл foreach по списку + foreach var x in l do + Print(x); + writeln; + +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/ForeachForSet.pas b/Samples/LanguageFeatures/ForeachForSet.pas new file mode 100644 index 0000000..08b831e --- /dev/null +++ b/Samples/LanguageFeatures/ForeachForSet.pas @@ -0,0 +1,5 @@ +// Цикл по множеству. Порядок - не по алфавиту, поскольку множества реализованы на базе хеш-таблиц +begin + foreach var c in ['a'..'z'] do + Write(c); +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/ForeachIEnumerable.pas b/Samples/LanguageFeatures/ForeachIEnumerable.pas new file mode 100644 index 0000000..77d0b75 --- /dev/null +++ b/Samples/LanguageFeatures/ForeachIEnumerable.pas @@ -0,0 +1,46 @@ +// Пример иллюстрирует реализацию классом интерфейса IEnumerable +// для использования его в операторе foreach +type + // Генератор чисел Фибоначчи + FibGen = class(IEnumerable, IEnumerator) + 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 := Self; + function System.Collections.IEnumerable.GetEnumerator: System.Collections.IEnumerator := Self; + function MoveNext: boolean; + begin + i += 1; + Result := i = 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; + +begin + s := new Stack; + s.push(7); + s.push(2); + s.push(5); + s.push(4); + writeln(s); + while not s.empty do + write(s.pop,' '); +end. + + diff --git a/Samples/LanguageFeatures/Generics/GenericProcFun/FindT.pas b/Samples/LanguageFeatures/Generics/GenericProcFun/FindT.pas new file mode 100644 index 0000000..c275256 --- /dev/null +++ b/Samples/LanguageFeatures/Generics/GenericProcFun/FindT.pas @@ -0,0 +1,21 @@ +// Обобщенные функции +// Выведение типа T по типам параметров + +function IndexOf(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. + diff --git a/Samples/LanguageFeatures/Generics/GenericProcFun/SwapT.pas b/Samples/LanguageFeatures/Generics/GenericProcFun/SwapT.pas new file mode 100644 index 0000000..f8b0bca --- /dev/null +++ b/Samples/LanguageFeatures/Generics/GenericProcFun/SwapT.pas @@ -0,0 +1,17 @@ +// Обобщенные функции +// Выведение типа T по типам параметров + +procedure Swap(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. \ No newline at end of file diff --git a/Samples/LanguageFeatures/IndexProperties.pas b/Samples/LanguageFeatures/IndexProperties.pas new file mode 100644 index 0000000..649f9c6 --- /dev/null +++ b/Samples/LanguageFeatures/IndexProperties.pas @@ -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. \ No newline at end of file diff --git a/Samples/LanguageFeatures/ParamsConcat.pas b/Samples/LanguageFeatures/ParamsConcat.pas new file mode 100644 index 0000000..b36c1ed --- /dev/null +++ b/Samples/LanguageFeatures/ParamsConcat.pas @@ -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. \ No newline at end of file diff --git a/Samples/LanguageFeatures/ParamsWriteln.pas b/Samples/LanguageFeatures/ParamsWriteln.pas new file mode 100644 index 0000000..ee15d78 --- /dev/null +++ b/Samples/LanguageFeatures/ParamsWriteln.pas @@ -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. \ No newline at end of file diff --git a/Samples/LanguageFeatures/Pattern Matching/ArithmEval.pas b/Samples/LanguageFeatures/Pattern Matching/ArithmEval.pas new file mode 100644 index 0000000..47ac7f0 --- /dev/null +++ b/Samples/LanguageFeatures/Pattern Matching/ArithmEval.pas @@ -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. \ No newline at end of file diff --git a/Samples/LanguageFeatures/Pattern Matching/ArithmSimplify.exe b/Samples/LanguageFeatures/Pattern Matching/ArithmSimplify.exe new file mode 100644 index 0000000000000000000000000000000000000000..a1dbdc838236aaee4a9a13683ff773f82946609d GIT binary patch literal 34304 zcmeHwdw3khmG9}Ep6Qt$%}Cu68b4%vjEx!dFcugX`GGAtKptCTdq7f) znUV1W8yN_J;3R|%2?3HdYj%l!0wlO|G0N$Pj#JBr_QTRovNdK=sI9@g?;TPu1S0z$A`5`;(|8Tn}7T(y$HbT6QE`9 zBdU}C<*NsBC;S{eN_3IbCMX^!szKA{qeM*;kc^8?5``-o!hly*!1IdPy+y#kA3>4C z=Q?~my-|~&B+<5c`E0+tL+K#4GtCXE-7l9BE%)pH(d+S}st4<)Q;_=mh+bVpqyfe! zq*~v5SwCMVQ}wm=6gXI?(f=Ks(h=^l>*uRF;<{8veEdIA_r}FO4JNXk)v!(p;NgGU zq0~YiK0R;{prIQF5sii#i*aZoipKJ2R4B5~2!dD+hg})gCAJ~k)*BC^$vCZket_aW zjh;f>SbAzEG?4xwT8B0s8#;74$Q$3%S}?yU^;fK88a2`nFrNe(c)IBaFnETQo+3>N zk)fwxiFJ@0yk;=3pC6>vAmXup54>dxdpav7&sq9O!ZXcbD z+i$-e2)S^%wLX22DMgVQk02JQ(j+oUllC&}ccEmR!;uP|eF5n^S%a|BK>Rb-@91o8 zn4k@Qp0Ewxvy{)r@~nG@HXChfoX7Ta(6(^`T@Vvq+XV5^0D?^%A0b%_U>9P5L(4r0 zEmkOx5FAQ1qTYg7qd;Oq8skKvJT$7rH*QGt?8#$jhYFa@)_%mRA&Y>_gG3AFK2bUH ztPqdfLJp_KP?FdAx3p~%PKg!-9;Kz=KIz9X9%7$CrvjE3pJ>ho8dHx#z0@SAfJDJ_ zhDAspJ&^i5TXqf#X$#Qle%nO+Qj?ic9$`L|!pv7ZC2v&Zp3ymPoV;^BWQq;%*4H3N zWSwpDbJjBS)eBQ0{UCgdjLG>=C$Lm>g;o$)A^iZix)=d#7^9{MF|e3P#z8Jn$M_lt zxsW^+rUT%Ck+dn`PDej?28tF|0O^jo1>7Vs4KmrS^g3<`q#l8|I-dAG%}mf(A7V8Te$}upT zo`brWClmU#5eY8&meKM>&{4qrNOA<%-ke-u7WDNDFsEN~WHzkxubj0kwOpXvjAgyK z8OzY&l*$f?&3+fJHmXw+osy$FO)7QrYNI;Up;O)HPLoTWyjpdq>Akt>qq|Hgb@6J| zU8eNrri|_~wbaF{Rd<=xo0~McOH-+fSF7%l=*{smTjjNBr7m8rqKlc>98F*NmZSxm zIzLML;cp}aSLV5vdjT&lB=plbnY6yNEvv-p#w=Y`#{0rzV1M@-R zPNt!nNG-flC)8wA7=NO8(+65sPM=L+;!V&LCchOmr)=q9y@L4kAY%Us*GF)jg8j;F z)Om06B0g={PEB%NP!Se#Mp7Q_}4sECO-yE+R&gO)O&f7!mVX1cv@yM2sezSVVA)h-Man$aohKqsb-~ zaW4Y0+EHh-2!!0bh!{;av52K(L||#Rjv!v%MZ{>biA9`%5!F^KU=fIycM&m~Y+@1n zL`22<+bal}9W{>bO!>Tg!REs51W{Q{$FU z_7SmCZcVd#A=9i#^Ip1rVBB7nAv2`pS;W+k@yq#fjx=ge^Dk@z~e0VMBsci?jH=A{S$7&GG8I4UEYkdxD+;;aEX3sJ0;+zEFM_Z;zRGnwKOIHCnz%kdbD#QxfUt#`p0_5hrf@Q4A#PnQ5QrN|v2xgJqayx4ib{7GpM19bfb&%(k7!YoB z7o%ld52ksYX{-;TH#19YsWmzLjv7eLWxsoryTa7hl!y+Ca^FuX`mWW08%LQ zIj%q1ztFMjoaz50{0`%%?A-=+#a@kb4#g_$y#@BNCGQ>=?-n5V3OMinfPZVBH?ST|MwU^6)>L~gev;tS;Z$Izn z&(mp0aT$ha?5s687|Fk;(U2Urs7Cj5oTbi3kza@&QWGcm=bxU9Wx1X|bYCYAt{!h4 zNwI9pB-nyuM47*1Y&oQCVH%JK%|+wd!W2iA!&!wWyF+&D((|Aaqq11$c44<`1<2b4dU7XDz;ckl;OO=uW5Rv1>{59T^yH*T!x z_FnwKI=@GMSpN89?&1)w%TDLv!*hEHJ{$09$7c&Z7(v++BVs9?LxCHN>mU=C1L{)5OQ4-3#P&E4>+)NmhD2E>o=Zg$miGkc$=aT!oy63wWNYkV#x%5%#iHi-{^aqoi~g zc-?JfG$tL_k#wwBqeT(74K?i7!j0InnRZxh*VvqhZQkj^9&8P@mPQ~#g6RN8_B@*v zbLr%5+i(n3Z>FE%ZQJcE<~UNmXCDGW>4Y1uebNR6b!EG>MS!FkNh`gTD|#LbhWIwi z!bUXMkXpt4Ir8#f;|<_LP^Zud+r*JB+#;1d(2Gd!%Dmp`A0QbNgPjGF>3aDF|)uMphpzwL# zsgN3y7IPSpqw$@LRZ(@<0w&q_f-&D$Wzj?Usxxix4rvryNW>X!nIl^odauIJm(mYn z$k-H-$+tq7Kd{9+o{IyK2Bba9|HAX8QqkIqCO>eJ$vGgksn$Nj0 zHi~y(Lf(nkDBh8%*eyFS_7xHkVRvRHYAS7rn#u-scUiV!w71GO)Qpl7mY7yPLPBBw z)o~&|8pVH1yu1VdN*`5t-`Bh`Hj1}Cq3&aSR3koO6C|E0eDvqFL40J>ATlA&(<*$l z9s%ST#Z`6drh>&vw}M;+Z#gtz_FNG1NDWKWjJ7s5#<%rGMD5q*mfGL1Dz0u#M3~NH$87^g)De*c+0+1ooYSX)jZZ8IbzmSRJv*c}fPseYAW8E~V$7 zu;say(lR)js;uRHXjvXwjIDZ3tMW=9buVTsN2>MXmBq9<2eB<&C84$!t_j3)#99nSSldsLzdi*7BW%= zQnsn^SD5YuApRONcDxuS%2*c>={;xmCmHX4DhROjdJkF;K?mbN2!$8#idPBiUN%0j zGQs5~UU2VJthciv3x4tAl;q_Z9Cr1B(0U<^)|&AC7jS`TeD2JI#PM?#ykGpcS z-a2~SFw3Th+@mCak7A^r(2R`^h0d1La00!r5iyA2EJcYUx%cq zjss}h_#lkd>Vu7PY-%j#(YAwjNVwkXorwMtYU5xPJN3qVBck(ORQT0HD`w`K_^^W` zU%hnT?d;#u{qW(G9ZB42r4fHvYVIuMlV-rn$~qn5(aE0-ZjR>mF+Wb3<}j;gr4eP6 zM>3aFHqHS7LO$d9!+T%eb(eSUQL`bHWd=M5rta=Uy@Q4WgP}xd9j)?SlwpaCN*$8oPBx9p;{^w|^91jhv<-OT- zKH&0$1rS^@9zpqRB)z^QPTl)g+QdO#HrLmfCx9**Tj_f4JQI=)&UsL#)pbYW0!IvHj~3 z+Ooq9sjEOBo=wwAe1MlI}9Fkq>rv1_SNF}sW$y2h82t*JMJ^K@#84QoKWq! zZQtqcL2n`8!9T;3$1Qq;do|i75-2N(F!ZF_kZPwt&%qRRu??~6qv_Z129;goVzY?b zJ6#UFY&cROwz&I&S4$C`J6Aautr#u5?WgWvc?W(GboKM@j5B7;a}Owj`uVoJnY5#F?t^p1&qk2z{0>3 zM`r9$oIf7Kk z&k;!8-xoQlVU?=dDkxqZ=&MuQ0PLbF_RHm`1@)#_u&G&QKn+!$QcL^ zHTSW|f(PQW^ezPGDxRUMvDzdup7O>@+N)^B>$6$>2PqXD$4PO>Y>6#io|`Deg(P34KE@h-oHbX~ zJGd$)zrgFt9Fijv1W#)d8>C|4F}VA$@L>u>IOceW`cU7>;~j860UkxhTLJe@)Me+E zICKh(RmVI2SRyz`&>=Tla!M%mH(d9+)`292Tw%F)mo&rLV({~NUdL?8e-1v@-A^*j zr%>qbUrKotW$GR-#NjIb)g0O^v3jqNeHtb4X|CmdhO3HBW4lP`0`6ylS4yFg*H%u9 z(w2~yRq}6g7<*FuwHNNe{6q3H8s#+>#TO?*=*w-CLYfFss)kESSps~QOWud6cQr0& zI=z5UQ!h99_-zV5QpN}PyI!kLl=6z`X@Myv4w1IT@rB<}bB{B2uP;sPY%taAyqnDneOL zbtlM;r^~rB-p~u%K_}#x?)%F8!Y#9zpB)lbwy8Km2cP5mN{&(8iSWBVr^{jmj!`?} zST1I$uV1ufn((s}BfZQB3VN!kbF>@jX>hvYz1xll&S4k?!%O1v(x4M^uPuqkz9Hg> zZ%QQCMmUiQ61;L5fhGyt^rwXaOZQT|IKUrvr2ZUJ`R7fW8zRNeFp}# zq|HgX<5X#LlI=M4PD7P8lk9q@u}YgscB7N1)aE2ln@QE$Bs^{St7U$R+;Nofo{IvN zN;T=ur%b5LOi!EN1S+&S zO?OVM(&jY#R43)ktCPDy+BD+UaIQ12ie|n&&pE4t#y-u{_)K48 z73lMQPzCxK_F0>~QCw1~=>pwpuF`aY-Rzw0oKvOg`S#h)xm8-6Z=dU&SES`ZU*|*(ZWnZL*)pKwL zi(tvYUAnWT%E4Xs8fUGuuFAnZ_F89s6;+SD-r3-ES5aMTcRL%aEV$U-=xnO6pt1fE zd!4hnislk~v$Lgw#_sa0?D4F;cw8$lskU;1y~*C9vNVqd#_|9%Wy#9RbZ2YTVs)9l z)w#4{v1+W}W?$-DUZvSK`*NqZQnSlEjkfu+ISY~9oAoA5^|FSVRVzP=JP-o4g) zUfEA&&SCz>c_=^0z#fP1o+1LPmr~QyD@QT>o|gByqHaiWP5NB1(6bni?e{@ba@%`e z#&sSSV`gI(t55| z(tS`~NwRJEUbS7P-Y!$m%?$bqSoLEJ$ji^KFO~7ChVo~yKd`)qBz~$JW#UL-g}fGQ z90MTsp=AQ)u{-vd$hL_iaa1=&=pmKA;QiC*s7;rp28Z#d&r$o<09^+CQ>_0X47r>c ztp$b>BMc@+pn_3;?k3OI+%NEcx_km6Cn5@&dYs*rdRofkT*@H%dt}(8WO;jG?673d ztX}I@`(wTjglHSDT%QBkczyM3Tu!6q-4`y`xCKAhThpEe^XAVxXZ|_OEsVkM9znSZ zoA6l(jfZf(!9l&dn9mLFDlkQQ9?=5$ZPvza>IX}{0hzUOV`n?A*8m=ZS7t5mcegV! zevqu|E}o$`MOfIIr<}uIT4m|%uOvQDj-JN{TT;3AegIdDhp#E=ClFs#*&aDY4X9;GWl#8TXr89>$Qf8#QQp&wj z-l%_657B?qzl-vhg88lfFQ^9tH)s~k3@i+U=pxiZv>~t+^<4p`F9zO+`kjLRw3H7> z`86q@5X$FJx9Fw7Z$SB`lnI0RG)Z}~!8*^A`a&t&q+BKCS}A*^+$!aEDR)chO5c43 z>v_FkZjthn#%GNXJt_5{Ncp!y`Fn%CL_sd2LGINci3{+Ch<(;=dT=H=K=}>nn@bK6#^OfT?7#v;_Q#1D}>Aa^c~Ex1PuvvT=Y!Pus}Zrlt$ZL zfqpK~BswI}34tc#*A%f0FA6l3J|NJq1)2s)+;$rN1@Zl-j{&NqR{+IudhnpM{gM8N zwzdZkmNFJTfx3e-KpzQ5wE&$X^(9iC1scEaN5i#f{dl+@<(=UKV)2vV(@=jnJP+lU z!_6qaEA-vw<)|+*ccPpXIe;=HWo7+r^MJN#==c&V4#6dnX}-_`5ttpc`Be)9(1lb4^h6&gO->J;FG-`bfLKf zV|J?tb(t%0w)F)M+H9`IlZ?+?q9p796rpP}3K}rGvBuF31ziQ{QF`2it`_KwKGk-u zK#K(mO}f?GA}2H4wj%hK=C%sxGiF}}^q{%B3L2DEP4#=wEFxmm&x+uK=6*S~^4mt_ zyJbFfqpV~;bVLq#eCRgJ7xlwj?vV2>zwJ}&*uy@pEAenMuL?e`l&X82+Wx)JO0QzhsKCFxfs=r)=uUx~wrLEas7 zGBuszbNLj_Qg6UY+h=Gt^_1G~$M@)pCFnt#Lr-}Sd+Ah~G)Hk^FP%!OOVGEl2iomH z?4`MMR3LlO^N1y6FoBfM=F;N|5}(bb6IGO7gyOz;=hC-5=wF2AGYUe#y4FH}5@-e86gB}h@m7tLeJyl`K+3xqlse+DFL3dX{U#x<@T?IW;1)ZpZ zUKL2$w}k$rAhB-=O*)tL^fg-`kgr+0Kz=`_3*cGL55nhaOBeujBe*QmF7Tl5X~)B@ z70_$pi?mkiso=Ss`YL!XFZKHYlDZEmo<77p*K1{ndA3urf@cTaP{FfG zXa#Xb>7W-qh%-tDwV%fdC~G^YM<8Ww2lXk)<1$i3d21ErHv|gM+u{A-dA!_DTS31U zNO^Z9t-?LE9}_F7Paq|IB^3oy(pSnXjk%yT{U2&8zfr#^uc&-GLkhXx75v`lLJZO33c5NedN%%I>hR9voCfe&knaI7`W;*IYg~)x{ zCG-d^dz4q0JzFo3v)dHqN!AawA=*}gexzMRPkGP` z>t|YlYTA9u6Izij^`I7O7VV)sO3*L0J@iKpYPEi=T}{h6RKJbZtAL*JpkegeM?))A z+fCL#Yy0Ryf$C&+IzU}XZc{s*1M~}zvNw8?et<4rsrn58I!M=)pgH=r^ppqfjh?5E z(50&s<%gq-^uu(w2OW(r1$4rL9*%bC*HOcTit>r*54G!Qz6bqH^g{gx`ocQZ_Bwdp zNKbi?Uel$&pPuScZBuKu=pUe=^$I$(W)|H-M?7e$K-@AyA4{&T>D6zc-+OJ_q%FKb z^&1lCPu&VSC{SIGf^MnVfqvicpxbK}=|`x2qiQ=^^IPo*^$Vmtc!c_r+@?Hugl_UE zS;7&zql$8G73CK^O4jTMeY=YCNEPKXRc%MB+D=q)dEJAQ^cOFNVu<8l)C|FfuFVSi zW6jn2hv+5`ni4yxf0!QhpqAKm`mOYg2W^baqTA?Ift0nk(L)u|Z=7FgQkE(4s9G?eM5)t#DEY3Bc``<$viEd4A+5g_{2!%cj82spP_#6SK~WRXqE}R(x*!>hR6+z4wdzNLV1nQRMy#(Iw=oS;{RNA z#lO~KtJSC}ou>*$#l~5v>$E^H+^W$o!SoB}!&1Ln>e(n$UV&1h(RGd9FZi!Ysbs10 z)o5LvPOk}GSz3!TNFA?o@t96VsnM$yy!1oviqcbb#( zBT_y}x5aMLYos2L@+CSN`?&rJeKvL%$}h!^>Td}C4SG2CdDMAF{R%x6`x088jC~d5 zGqFcd{v`HolrO}Np?o>^J(RD-o<{j^vE%xqc$vi19>rI1ey(d8bkJU+ldOaKOVkjb zh0~~p_(8ozq}bd_Ei^s;f*zsS@t5=roe_T-t>?#ohjLl`S2*XnDZB&q6ZA7su8#ks zZWHhNTWKSDJxZDQHhPr$xZ>OEn6A}w+x+9 zyEAZD3&#fn_lU3V)8^G)4g3<&w7}AXfv;$*YhOUUr*X zhqq`mwVT4%2adtRTj&Sc6}2}7exO}j`=P*d+HJL__Plmq?Rk*Vb@&2oCnN3;QZS_v))?A zqeiu_qjg=~o1na`&M;c^zPc#N-_<%shOVxA3DL+te1mSNdj%u@;kwDjC+K&zGf;lK z?p*Y}r|uMEi_Q_1(I2Qw8#(>ax(keb`uFPEQU0RtLgN^{Shvo|=&#moG!E-;*Ii=V ztlRcB)RXou<2i}R=jdE}i}pONwFixl=$q_&NsN&gYF| zdb6{IuJR(E=h{_tp2OvGl+5Q#=)2zex^Yb7@ja$(1^rhj<9v&yfZo=*tikMf+;|Q; zJY~Fu@<+xiC|^Mi*-QTeY4#yHf$|&l63TB&{UrUT#yr{@+!>ii7X=rh><;!u+USR& zABV5kuM0jKenOv$_4)~YVd&X#Ag}>tTi^QI}6?iuMvhj-XkH#O2 zH}Sf+9y~@j>ycnAc)2zyI6ZiB@G_bkJS!N*oIO9dD7Z4%72F!!9z0Fk72F%VCU|}D z{lSj}Zx7xX{8aGM!TW<>34T5J&EVs~?*)Gt{88{%!G8$;TM$otLy6Fg(45ejq4Psa zL#sloL%T!6p^?xV+6|%GLwAQh7n-Nt7y4r88=)scPlcWd{W$byh)lz*GpCv-o2Qyf z%!|w(^AhuNbBDRh>^BdZhs~SJkC?ZccbiAe&zldJUo{^#A2W~P-1RA(%>L56HheTZ zs98AAYrvV8u3f7w#rMsO5zg$DKYYSxR3J3sU*jdJ9-z;Mw`&iC`|w$%J&4cO@%bh`-@)g}@J^f?a9>)y#_b#K&t5=X>d!h*Yd%-p zJ`^G7mE4Jj^gs%U?#tBMXo=q+N4&2oZXl0&+f_;v-7D`Z5DwYdyCn@Le3p5P;c*s zY^JX}w`(xdzpm30%*ei6KD(pXxekV8sblX@o;Fb%_h{|wqcy|*MOvHPh1<3MOrfxG zFjs6X7V{O>^s=Sdf$U&0Q-q*i`57gAe45e1$ETXTv5@UsTM(&NX7hvD{&UWr*Vo@q z1BD%KzCX8}JX_Rd-rC`TY(BT6;GySToEz+OuP)46;pPVlv~K$qFqS$y2AM3g9WM3y zwYmNMXcAwsu-x|HA{vYNY-ZqMjA=ISQ+BQ+9)Zrmovzo;o<;krOksCXc>4T{_-YZ; zDmJ9X%%fI-$C}5Sx-$5?Ag%d)W?xx>j=ejwL#!2bwifmc?%0qm@Q_HoEz{q>J+tG= zN^`a~`)XDgG;d{gke!0z_2Qu{z%zft@L(}Fke%1&4h%uze0Mg#C$}SuC}4ePO}4n( z?NcU8JkQ&Z-Rb#@HV*DaIQM7!O3HTZK|HkP@m#uRHyk)#gC|$D;}JHyk}n;DJKR2j zl^kzw$jD$8Y&)AU!rQZX9?wj%Qlpi4w4LeC?Uy*DcFcz!SR}FRVw@4vd$M_qz3Pei zx+lk@rsOUk&h;~-8cT*ydv^OUbW^%uitZY83q=kuY1jov6|+My!X4hVyX@4q-I+Xf z4i?Wjn>x$m!1aM43^Iouk9ZqTx#jyf&ZI<-=JRM{`NI7Ni{~v694;~#t8;}SqAJ_3 z#-lyEBR7!gCvOCq?A zy4)OVO6~5j%v11@VdQ+X7ZJ%(Amgusb9ttKDFnkX$om8@^C=4!)e!W{?aYDkrcD2E zR%TvzcE>R0_`dGU&TJbhxgDAQ@@RVg^NA3mdvbYqkaHfbgE$1-;4Vc(UHzHjPJ|}j zx@a95YIg@RIb?L11k{F^JDgXEqX&r{LBJ)CC(qA{KxxnJ%z(J6d7^2i20K6QO!M2I zN_16L@vd#eZe25!KDCJEQefu3_1&C8OCd=BEWi&WYW0UNUYnY~i0 z;IW3?fOVveFm$}Sv{9ZH7>1kiIa}0eqfKozn8Bnit)Jzp#0bq6PP2PEu@d!?x^Bwk zbF5CGm*(x@2%ViP^yWZ7L)q+=#0jXkuy0^HzGKUEY!Ug=KS)<|UMF|^6?ld(b>L<* z=hdy``dGB_2c(9L#hY&noeNU#pKyCfGA?hr24wm);m{eG?;q?`Hd@;E|Y?Xv9 zt;`lH=46lSrO(|(+F79OdD?z8b*Ob&BHY~xG#A-o!Efl!?T7V(Lz>y+UWsIs-IW{k z>X-v+c{vpx!qRvu0v{7W2bcQ+LY1?abpnC9DiPfyl!%;pQSqO+5zdw9F- zm=I!|Xn6!y3cvhVOvhEj$c<&f)jTPx!OZh>M z=)jT99B*eU8iZTNUd*myR+4A`zRp5Bb~aun=RnNyf|jK#kvYLog*mozE3hNv29;`i zd%b0gIP+wR7!Y1S;Q-$Db$0i5Z|UyoSkt>^UHit>9c<$O7Kqik!K^IN?r?EvxQNi= zvTZn@M_wy!TRRIpTd{strjYWc5uwTpq_=kzQ3@(6qFnATA*^#|{%Ugk7nUgZ{kuG{YKVTvuoRO#d5OoNx^5D^+=jRpu zZl{@OAl)fuZ6) z=}0{;wmjHM^|;Z%ru zs8=!p_7KW)o?Xc2SOp|jd3(PrTkP#DaMD&)zAMDo%kpqhcAp?|El9-+W2vvs4(`HU z3dzlz*=yWA*|mJn$kV{zNA|d~>+~{MkITHVgYY8~29#qZ+Qd=aE;hrso#6bU zRKw&NK+4%uQkfSWZ!hWPXGK`vI6(o~i7KT#3y3moo`j#^W$p2ayxiW26(ci<-4F1U zOBC~FKVXUK?PTX{$PU0z))C{)#F8uF_|jIByR69!=5``Tyh*{R6^MX+>)B%L^ZM5E zhC;e~H$UEDr*@E{E9VCS6XjXW#iy>eBqtNApH83>jpAdHgR{N z(3!z2r6Pj81;STLa55JQ7vrEnbuVnn<%_%;L7KON%^`=tQGCM!WG82p(soukn{^iV zvcJ3#*^nLT=Y1u*co@{w_E;pX>)wR*k~8Kmbn^GA0(b%E?O4$bH&7XIn}0(F+~}o) zxp*DDJuVYfY;##Rk6>e`*B}F|vgbh_E3EFcf|!E=Mm2rH|9D9 zd85}S6xfRJiipLE@5GVmc4If!J;e5NVvre_>FetqdwWWZ9-Vbq=*FHEX_2>1*2K~x zB_YY{V+q65r39!J3Z)b_0&2x$_!t$>KWVVaJuS*_S3sqqL%b zxS-;rBxls&(mbSiK7-OIki=`(*nZ&cQ(&SyDT7@Y_MAkWj?rOUU@S0}81s#FMv_{M z<;F5#76MLE+E{FyYb=ub64cJdXBlWOGFs5u4!UKan2$bM;0!#R*^19)cz1p$7Px-! zPm+s0ToQk~Yd-%j>WGi0X=|ZNKmIL;F04r(wL-rRup8a- zN89k)8lBQD8WcsJ390H=iC3^Zfv$+2%?OXmo)!4W8F+Dy|Iy@bNGX6mi-Dep0Uw6# zqTS?+fZK;NNY<9axeK)%v|>xW-gXZ(>qc+(410yn>P6`Ah%jYV?CC_<^n!}RYX|Vm zk3(=5VmA5z^cAz>)r}zGuk^~k?Oe?eN_8aaOr@q-Ci%oH)BF=1*QkMHoVTxxU&V< zfnVd&&hn-yjamV%2Cf_Wti-hy5L(S7UKmGW!1Z*#2F@fcuou@1(S6T;^qNQJw|0E+ z!ja4N|NZ{!Dg4O(OE*nk@Z!y(lboy`Z_=j|Y8~2iGEZ_w{vFo<5>1FSXSIVrtfD!~ zVqwzpO}(^}=E^FrFn)2Ii4+ib(#TAjj=wID#N)&y1%gRUs|!mRlTu;gQV&XLNEwpS zlrkcvC1q5~8Yy)H+?u#r3mM@+$g%M`37^Tqq^^Y_N7tH~^iUHfp@TxxxzI%ZG?C^s znaKcXxRsolP%)0~)9^V3pSk#)83uvV9G)hfU^YOtZWs1 zoF!&b2iz+1;(92~a$|Z3zxz(t>YOzGgF^fShUpMmfnrm{od9M#%|X(_PBVTRqCF`b zmP=C;`x@FhO@MV=Ok5ZY*J*(3rsGKoe1b;JX=nn2crD)AXD^@*6b4ZT+!SPzczjwD z>|l!<@TtM)416-C7Xx+RsbWBt@!C2~t3*InJPwv|Fn8880c1Id9=z@lh&yYhVF=K& zz6mrDCWbgC7YNw{tYDL~QIu+7l@T?J*`kLK5g5BTkUH}YqY~!USlrncOlr=-05Cyr zH@JXnF-5tEaA9!~W%?SXhj*Z165rUt@HV5uF#{z5joc1F@o?BA%^vxr(~N!rkZEDI zLy92R3@#8s5W+=-3yX`W5W_%7h|4fEg9*5YBk-G6H*Gq8qYA8Vwnu&tO42lEhs=pS*E3ss-DQ=JalQZ&%rfE%rdqe!X591a|lFZ9` zf@SrDu$mU17Ps+SJ*n&UR9BB-$FyjI$uV%&<3V;WNP19D9V?Bw85J)j6Sf*f>P#JBJ@IT=`^aS3sF1H_2On>f_q zte1==IV~n)rk?6G?r$F+;1JT8EpnD-^xY(H1)94g)-oD8K&lRAsQzkD!W1^ zrWu3ILCXvx%J@GM#s%4gcFZ$I=uVeu1~BEMVP@1s!f0}4#z7c1gL*iO24=xX^x%#& zAuQyKJXU8$;s8b-LkvzZr0)eK^6nE@KMv3}c78RE)N$PA!?FM)tF1az3u zVbL%g4DoORxrXH&YcMTjjwZ%AYfy-+Fe}ZfKnjeQ2|L0jeoqEh7=;RIH733ciyD5! zPAmj$Lm&>NaAB(>rU5OH?7BEp@EQ@uRV@-BXY*7u>?aAqO+y%|f6nF_Goaegf3szJ z>BZR$;{)uR__V;Zcv${Bn^`KzBG8+Sa5n3qh#rbYO%szQ9I>Lz!thz+FJ&I){J)-k zad_IPW&@^!jh+W#PMG_zhe^%OLG}t$z$sy8v-pqY;}_tD;%K!P3%<^J5U*z~bXJy~ zz4;^)ldMS;L}#eU{@ffx$Fhm=X&k{LoOQO$+0A`-qq3JPdtv9axKoF51_KD&i^XJ(Pso$$zA z=Js;avKaW`<57;P%Brpi#;-DcMN0)24_nb#!MlQvv7#7P!b!6}?(5=pEj2F2m!HFI zUK*BKT9aWR;7~ZLxM=5MH5bdcSPY7Qp<%A?(g^v1E)S^(GgG{WIOT^d1^=n2Gqx$> zp*q)1_iFz0Q5*zSJv^h?8Wt|<(WiD_nH$30HI5wAgO<)gK8EPY4;PAB2;XIdQutdS z>a77NM)cJ;P25iLdvEx*GFR|ZypCu?cYF8gBbQwK<&!&Bj@J$00Osh__+ifdBUN0-Ns`WT%4; + l.Add(new Line); + l.Add(new Circle(10,10,5)); + l.Add(new Rectangle(10,10,20,10)); + foreach var x in l do + match x with + Line(var ll): Println('Line S =',0); + Circle(var c): Println('Circle S =',c.Radius*c.Radius*Pi); + Rectangle(var r): Println('Rectangle S =',r.Width*r.Height); + end; +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/ProcParam.pas b/Samples/LanguageFeatures/ProcParam.pas new file mode 100644 index 0000000..3555e1b --- /dev/null +++ b/Samples/LanguageFeatures/ProcParam.pas @@ -0,0 +1,20 @@ +// Иллюстрация процедурных переменных как параметров подпрограмм +// Для процедурного типа в PascalABC.NET реализована структурная эквивалентность типов +// Процедурный тип реализован через делегаты .NET +procedure for_each(a: array of real; p: procedure(var r: real)); +begin + for var i := 0 to a.Length-1 do + p(a[i]); +end; + +procedure mult2(var r: real) := r := 2*r; + +procedure print(var r: real) := write(r,' '); + +var a: array of real := (1,2,3,6,7); + +begin + for_each(a,print); writeln; + for_each(a,mult2); + for_each(a,print); +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/ProcVars.pas b/Samples/LanguageFeatures/ProcVars.pas new file mode 100644 index 0000000..6a4e88d --- /dev/null +++ b/Samples/LanguageFeatures/ProcVars.pas @@ -0,0 +1,36 @@ +// Все возможные способы инициализации поцедурной переменной +// Процедурный тип реализован через делегаты .NET, для него доступны операции +=, -= + +procedure pp; +begin + writeln('Вызов обычной процедуры'); +end; + +type + A = class + private + x: integer; + public + constructor Create(xx: integer); + begin + x := xx; + end; + procedure pp; + begin + writeln('Вызов метода класса, значение поля равно ',x); + end; + class procedure ppstatic; + begin + writeln('Вызов классового метода класса'); + end; + end; + +var p: procedure; + +begin + p := pp; + var a1: A := new A(5); + p += a1.pp; + p += A.ppstatic; + p; +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/ShortTypesInTemplateParams.pas b/Samples/LanguageFeatures/ShortTypesInTemplateParams.pas new file mode 100644 index 0000000..3410bd2 --- /dev/null +++ b/Samples/LanguageFeatures/ShortTypesInTemplateParams.pas @@ -0,0 +1,19 @@ +begin + var q := new Queue<(integer,integer)>; + q.Enqueue((1,2)); + q.Enqueue((2,5)); + q.Println; + Println(q); + + var l := new Listinteger>; + l.Add(x->x); + l.Add(x->x*x); + l.ForEach(f->Print(f(5))); + Println; + + var l1 := new List<(integer,integer)->integer>; + l1.Add((x,y)->x+y); + l1.Add((x,y)->x-y); + l1.Add((x,y)->x*y); + l1.ForEach(f->Print(f(2,3))); +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/Students.pas b/Samples/LanguageFeatures/Students.pas new file mode 100644 index 0000000..a90af77 --- /dev/null +++ b/Samples/LanguageFeatures/Students.pas @@ -0,0 +1,22 @@ +// Перегрузка операторов +type + Student = auto class + Name: string; + Height: integer; + public + // Сравнение по росту + class function operator<(left,right: Student): boolean := left.Height < right.Height; + class function operator>(left,right: Student): boolean := left.Height > right.Height; + function ToString: string; override := string.Format('{0} ({1})', Name, Height); + end; + +begin + var s1 := new Student('Stepa Morkovkin',188); + var s2 := new Student('Petya Pomidorov',180); + Writeln('s1: ',s1); + Writeln('s2: ',s2); + Writeln; + Writeln('s1(s1,s2): ',Student.operator>(s1,s2)); +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/Tuples/MySqrt.pas b/Samples/LanguageFeatures/Tuples/MySqrt.pas new file mode 100644 index 0000000..a976c51 --- /dev/null +++ b/Samples/LanguageFeatures/Tuples/MySqrt.pas @@ -0,0 +1,14 @@ +function MySqrt(x: real): real; +begin + var eps := 1e-15; + (var a, var b) := (x, real.MaxValue); + while abs(b-a) >= eps do + (a,b) := (b,(a + x / a) / 2); + Result := b; +end; + +begin + Println(MySqrt(2)); + Println(MySqrt(3)); + Println(MySqrt(4)); +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/WriteCycledLinkedList.pas b/Samples/LanguageFeatures/WriteCycledLinkedList.pas new file mode 100644 index 0000000..2a2d42e --- /dev/null +++ b/Samples/LanguageFeatures/WriteCycledLinkedList.pas @@ -0,0 +1,19 @@ +type + Node = class + public + data: T; + next: Node; + constructor (d: T; n: Node); + begin + data := d; + next := n; + end; + end; + +begin + var n1 := new Node(5,nil); + var n2 := new Node(6,n1); + writeln(n2); + n1.next := n2; + writeln(n2); +end. \ No newline at end of file diff --git a/Samples/LanguageFeatures/WriteRecord.pas b/Samples/LanguageFeatures/WriteRecord.pas new file mode 100644 index 0000000..d35db74 --- /dev/null +++ b/Samples/LanguageFeatures/WriteRecord.pas @@ -0,0 +1,26 @@ +// Иллюстрация конструкторов и методов в записях +// Если переопределен метод ToString, то он вызывается при выводе объекта этого типа процедурой writeln +type + SexType = (Male, Female); + Person = record + Name: string; + Age, Weight: integer; + Sex: SexType; + constructor (Name: string; Age, Weight: integer; Sex: SexType); + begin + Self.Name := Name; + Self.Age := Age; + Self.Sex := Sex; + Self.Weight := Weight; + end; + function ToString: string; override; + begin + Result := string.Format('Имя: {0} Возраст: {1} Вес: {2} Пол: {3}', Name, Age, Weight, Sex); + end; + end; + +var p: Person := new Person('Иванов',20,70,SexType.Male); + +begin + writeln(p); +end. diff --git a/Samples/LanguageFeatures/Yields/InfixTraverseTree.pas b/Samples/LanguageFeatures/Yields/InfixTraverseTree.pas new file mode 100644 index 0000000..e56cb7f --- /dev/null +++ b/Samples/LanguageFeatures/Yields/InfixTraverseTree.pas @@ -0,0 +1,20 @@ +type Node = auto class + data: T; + left,right: Node; +end; + +function CNode(x: T; l: Node := nil; + r: Node := nil): Node := new Node(x,l,r); + +function Infix(root: Node): sequence of T; +begin + if root = nil then exit; + yield sequence Infix(root.left); + yield root.data; + yield sequence Infix(root.right); +end; + +begin + var root := CNode(1,CNode(2,CNode(3),CNode(4)),CNode(5)); + Infix(root).Print; +end. \ No newline at end of file diff --git a/Samples/NETLibraries/NET4.0/BigIntegerExample.pas b/Samples/NETLibraries/NET4.0/BigIntegerExample.pas new file mode 100644 index 0000000..fb473bc --- /dev/null +++ b/Samples/NETLibraries/NET4.0/BigIntegerExample.pas @@ -0,0 +1,12 @@ +// Использование длинных целых. Вычисление 100! +{$reference 'System.Numerics.dll'} +uses System.Numerics; + +var n := 100; + +begin + var f := new BigInteger(1); + for var i:=2 to n do + f := f * i; + writelnFormat('{0}! = {1}',n,f); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/NET4.0/ComplexExample.pas b/Samples/NETLibraries/NET4.0/ComplexExample.pas new file mode 100644 index 0000000..818b4fe --- /dev/null +++ b/Samples/NETLibraries/NET4.0/ComplexExample.pas @@ -0,0 +1,17 @@ +// Использование комплексных чисел +{$reference 'System.Numerics.dll'} +uses System.Numerics; + +begin + var a := new Complex(0,1); + writeln('Мнимая единица: ', a); + + var b := Complex.Sqrt(a); + writeln('Главный корень из мнимой единицы: ', b); + + var c := a*a; + writeln('Квадрат мнимой единицы: ', c); + + var d := new Complex(1,2); + writelnFormat('Модуль {0} равен {1}', d,d.Magnitude); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/NET4.0/StopWatch.pas b/Samples/NETLibraries/NET4.0/StopWatch.pas new file mode 100644 index 0000000..98c6be5 --- /dev/null +++ b/Samples/NETLibraries/NET4.0/StopWatch.pas @@ -0,0 +1,11 @@ +// Stopwatch - класс высокоточного таймера (с точностью до 0.001 с) +begin + var stopWatch := new System.Diagnostics.Stopwatch; + stopWatch.Start; + + Sleep(123); + + stopWatch.Stop; + var ts := stopWatch.Elapsed; + writelnFormat('Время работы: {0:00}:{1:00}:{2:00}.{3:000}',ts.Hours, ts.Minutes, ts.Seconds, ts.Milliseconds); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/NET4.0/TupleCreate.pas b/Samples/NETLibraries/NET4.0/TupleCreate.pas new file mode 100644 index 0000000..9d07269 --- /dev/null +++ b/Samples/NETLibraries/NET4.0/TupleCreate.pas @@ -0,0 +1,10 @@ +// Создание кортежей +uses System; + +begin + var a := Tuple.Create('Иванов',24); + writeln(a.Item1,' ',a.Item2); + + var b := Tuple.Create('Петров',17,1,11); + writeln(b.Item1,' ',b.Item2,' ',b.Item3,' ',b.Item4); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Array/SystemArray1.pas b/Samples/NETLibraries/System.Array/SystemArray1.pas new file mode 100644 index 0000000..2bce694 --- /dev/null +++ b/Samples/NETLibraries/System.Array/SystemArray1.pas @@ -0,0 +1,37 @@ +Uses System, PABCSystem; + +const Size = 10; + +procedure PrintArray(a: array of T); +begin + foreach v: T in a do + Write(v, ' '); + Writeln; +end; + +var a: array of integer; + +begin + SetLength(a, Size); + // Заполнение массива + for var i:=0 to a.Length-1 do + a[i] := Random(100); + + // Вывод всех элементов массива + PrintArray(a); + + // Сортировка массива (знак & используется для того, + // чтобы воспользоваться ключевым словом array при обозначении класса Array) + &Array.Sort(a); + + PrintArray(a); + + // Обращение массива + &Array.Reverse(a); + + PrintArray(a); + + // Поиск вхождения элемента в массив + var i := &Array.IndexOf(a, 99); + Writeln(i); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.DateTime/DateTime1.pas b/Samples/NETLibraries/System.DateTime/DateTime1.pas new file mode 100644 index 0000000..9832b1c --- /dev/null +++ b/Samples/NETLibraries/System.DateTime/DateTime1.pas @@ -0,0 +1,32 @@ +Uses System; + +var + d1, d2, d3: DateTime; // Объекты для хранения даты и времени + ts: TimeSpan; // Объект для хранения промежутков времени + +begin + // Получение текущей даты - вызов статического метода + d1 := DateTime.Now; + Writeln(d1); + + // Дата и время через один месяц + d2 := d1.AddMonths(1); + Writeln(d2); + + // Дата и время на 12 часов раньше + d2 := d1.AddHours(-12); + Writeln(d2); + + // Формирование даты - вызов конструктора объекта (год, месяц,число) + d3 := new DateTime(2001, 1, 1); + Writeln(d3); + + // Определение времени, прошедшего с начала тысячелетия (разность дат) + ts := d1.Subtract(d3); + + // Промежуток времени в днях (результат - вещественное число) + Writeln(ts.TotalDays); + + // Промежуток времени в днях, часах, минутах и секундах + WritelnFormat('{0} {1}:{2}:{3}',ts.Days,ts.Hours,ts.Minutes,ts.Seconds); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.DateTime/DateTime2.pas b/Samples/NETLibraries/System.DateTime/DateTime2.pas new file mode 100644 index 0000000..f444870 --- /dev/null +++ b/Samples/NETLibraries/System.DateTime/DateTime2.pas @@ -0,0 +1,34 @@ +Uses System; + +var + d: DateTime; + s: string; + +begin + s := '27.03.2008 9:58:17'; + //Попытка преобразования строки в объект DateTime + if not DateTime.TryParse(s, d) then + begin + Writeln('Строка не содержит значение даты и времени'); + Exit; + end; + + // Проверка високосности заданного года с помощью статического метода + if DateTime.IsLeapYear(d.Year) then + Writeln('Год високосный') + else + Writeln('Год невисокосный'); + + // Преобразование даты и времени в строковое представление + s := d.ToString; + Writeln(s); + + // Преобразование даты в строковое представление + s := d.ToShortDateString; + Writeln(s); + + // Преобразование времени в строковое представление + s := d.ToShortTimeString; + Writeln(s); + +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.DateTime/DateTimeInterval.pas b/Samples/NETLibraries/System.DateTime/DateTimeInterval.pas new file mode 100644 index 0000000..b7afdf9 --- /dev/null +++ b/Samples/NETLibraries/System.DateTime/DateTimeInterval.pas @@ -0,0 +1,16 @@ +// Работа с классом System.DateTime +// Вычисление времени выполнения фрагмента кода + +uses System, PABCSystem; + +var dt: DateTime := DateTime.Now; + +begin + // Делаем случайную паузу + var ms := Random(1000); + Writeln('Sleep','(',ms,')'); + Sleep(ms); + + // Сравниваем с показаниями DateTime.Now + Writeln((DateTime.Now-dt).TotalMilliseconds,'ms'); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Net/DownloadFile.pas b/Samples/NETLibraries/System.Net/DownloadFile.pas new file mode 100644 index 0000000..3d6f11c --- /dev/null +++ b/Samples/NETLibraries/System.Net/DownloadFile.pas @@ -0,0 +1,12 @@ +// Скачивание файла +uses System.Net; + +const + address = 'www.yandex.ru'; + filename = 'LogoPABCNET2010_Rus.png'; + +begin + var w := new WebClient(); + w.DownloadFile('http://pascalabc.net/images/logo/'+filename,filename); + Exec(filename); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Net/MailSend.pas b/Samples/NETLibraries/System.Net/MailSend.pas new file mode 100644 index 0000000..666b6e7 --- /dev/null +++ b/Samples/NETLibraries/System.Net/MailSend.pas @@ -0,0 +1,17 @@ +// Исправьте имя SMTP-сервера SMTPServerName и адрес получателя toReceiver! +uses System.Net.Mail; + +const + SMTPServerName = 'mail.spark-mail.ru'; + +begin + var fromSender := 'ivanov@mail.ru'; + var toReceiver := 'petrov@yandex.ru'; + var subject := 'Proba'; + var body := 'Hello!' + NewLine + 'I am robot!'; + var message := new MailMessage(fromSender, toReceiver, subject, body); + + var mailClient := new SmtpClient(SMTPServerName); + + mailClient.Send(message); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Net/Ping.pas b/Samples/NETLibraries/System.Net/Ping.pas new file mode 100644 index 0000000..269017b --- /dev/null +++ b/Samples/NETLibraries/System.Net/Ping.pas @@ -0,0 +1,16 @@ +// Использование Ping +uses System.Net.NetworkInformation; + +const address = 'www.yandex.ru'; + +begin + var p := new Ping(); + try + var res := p.Send(address); + writeln('IP адрес сервера: ',res.Address); + writeln('Время отклика: ',res.RoundtripTime,' мс'); + except + on e: Exception do + write(e.Message); + end; +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Net/WebClient.pas b/Samples/NETLibraries/System.Net/WebClient.pas new file mode 100644 index 0000000..0e5b12e --- /dev/null +++ b/Samples/NETLibraries/System.Net/WebClient.pas @@ -0,0 +1,10 @@ +// Использование WebClient +uses System.Net; + +begin + var w := new WebClient(); + w.Encoding := System.Text.Encoding.UTF8; + var s := w.DownloadString('http://pascalabc.net'); + writeln(s); + w.DownloadFile('http://pascalabc.net/images/logo/LogoPABCNET2010_Rus.png','LogoPABCNET2010_Rus.png'); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Parallel/Parallel1.pas b/Samples/NETLibraries/System.Parallel/Parallel1.pas new file mode 100644 index 0000000..5cdfcd0 --- /dev/null +++ b/Samples/NETLibraries/System.Parallel/Parallel1.pas @@ -0,0 +1,8 @@ +Uses System,System.Net,System.Threading.Tasks; + +begin + Parallel.Invoke ( + procedure -> begin (new WebClient()).DownloadFile ('http://yandex.ru', 'yandex.html') end, + procedure -> begin (new WebClient()).DownloadFile ('http://pascalabc.net', 'pabc.html') end + ); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Parallel/Parallel2.pas b/Samples/NETLibraries/System.Parallel/Parallel2.pas new file mode 100644 index 0000000..8b4fd3e --- /dev/null +++ b/Samples/NETLibraries/System.Parallel/Parallel2.pas @@ -0,0 +1,46 @@ +uses + System, System.Net, System.Threading.Tasks; + +type + Int = class + N: int64; + constructor(NN: int64); + begin + N := NN; + end; + + function IsPrime: boolean; + begin + Result := True; + for var i: int64 := 2 to round(sqrt(N)) do + if N mod i = 0 then + begin + Result := False; + exit; + end; + end; + end; + +type + BTask = Task; + +begin + var ss: array of int64 := (1265713689122381, 1265713689122461, 1265713689142451, 1265713689542501); // Все числа - простые + var tb := new BTask[4]; + // Запуск 4 потоков из пула потоков + // У каждого tb[i] свой Result! + for var i := 0 to ss.Length - 1 do + tb[i] := Task.Factory.StartNew((new Int(ss[i])).IsPrime); + + // Если поток не закончился, то обращение к tb[i].Result приостанавливает основную программу + for var i := 0 to tb.Length - 1 do + writeln(tb[i].Result); + // В эту точку мы попадем только после окончания всех четырех потоков + writeln(Milliseconds); + + // Последовательное выполнение + var t := Milliseconds; + for var i := 0 to ss.Length - 1 do + writeln((new Int(ss[i])).IsPrime); + writeln(Milliseconds - t); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Parallel/Parallel3.pas b/Samples/NETLibraries/System.Parallel/Parallel3.pas new file mode 100644 index 0000000..c058cad --- /dev/null +++ b/Samples/NETLibraries/System.Parallel/Parallel3.pas @@ -0,0 +1,57 @@ +uses + System, System.Net, System.Threading.Tasks, System.Collections.Generic; + +type + ListSimple = class + l := new List(); + procedure AddSimple(N: int64); + begin + var Result := True; + for var i: int64 := 2 to round(sqrt(N)) do + if N mod i = 0 then + begin + Result := False; + break; + end; + // lock не позволяет нескольким потокам одновременно выполнять эту секцию. + // Это обязательно, иначе если несколько потоков одновременно будут пытаться добавить значение в список, список может оказаться испорченным + // Секция, охраняемая lock, называется критической + lock l do + if Result then + l.Add(N); + end; + end; + +var hh := 1000; + +begin + var ls := new ListSimple; + + var ii: int64 := 1265713689181; + + Parallel.For(ii,ii+hh,ls.AddSimple); + + writeln(ls.l.Count); + // ls.l := ls.l.OrderBy(x->x).ToList(); - это можно включить для проверки того, что в обоих списках - одинаковые простые числа + for var i:=0 to ls.l.Count-1 do + write(ls.l[i],' '); + // Надо обратить внимание, что выводится неупорядоченная последовательность простых чисел ! + + writeln; + writeln('Время выполнения = ',Milliseconds); + + // То же, но непараллельно + var ls1 := new ListSimple; + + var t := Milliseconds; + for var i:=ii to ii+hh-1 do + ls1.AddSimple(i); + writeln(ls1.l.Count); + for var i:=0 to ls1.l.Count-1 do + write(ls1.l[i],' '); + writeln; + writeln('Время выполнения = ',Milliseconds-t); + + // Проверка того, что списки простых как множества совпадают + writeln('Количество элементов в разности множеств = ',ls.l.Except(ls1.l).Count()); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.String/StringConvert.pas b/Samples/NETLibraries/System.String/StringConvert.pas new file mode 100644 index 0000000..fe2a5b8 --- /dev/null +++ b/Samples/NETLibraries/System.String/StringConvert.pas @@ -0,0 +1,25 @@ +var + s: string; + i: integer; + r: real; + +begin + // Преобразование строки в число + s := '123,3443'; // Дробная часть отделяется запятой - настройки Windows + if not real.TryParse(s, r) then + Writeln('Строка s не является строковым представлением вещественного числа') + else Writeln(r); + + if not integer.TryParse(s, i) then + Writeln('Строка s не является строковым представлением целого числа'); + + // Преобразование числа в строку + i := 10; + s := i.ToString; + Writeln(s); + + s := ''; + for i:=1 to 9 do + s += i.ToString; + Writeln(s); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.String/StringMethods1.pas b/Samples/NETLibraries/System.String/StringMethods1.pas new file mode 100644 index 0000000..b0db02e --- /dev/null +++ b/Samples/NETLibraries/System.String/StringMethods1.pas @@ -0,0 +1,30 @@ +var s1,s2: string; + +begin + // Определение длины строки + s1 := 'ABCDEFGH'; + Writeln(s1.Length); + + // Сравнение строк без учета регистра символов + s1 := 'AAA'; + s2 := 'aaa'; + if String.Compare(s1, s2, {ignoreCase - без учета регистра} true) = 0 then + Writeln('Строки совпадают с точностью до регистра букв'); + + // Определение вхождений подстрок + s1 := 'Long string'; + s2 := 'string'; + if s1.EndsWith(s2) then + Writeln('В конце строки s1 содержится подстрока, совпадающая с s2'); + + // Поиск индекса вхождения подстроки в строку + Writeln(s1.IndexOf(s2)); + + // Извлечение подстрок + s1 := 'ABCDEFGH'; + s2 := s1.Substring( {начальная_позиция = } 3); + Writeln(s2); + + s2 := s1.Substring(3, {длина_подстроки = } 2); + Writeln(s2); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.String/StringMethods2.pas b/Samples/NETLibraries/System.String/StringMethods2.pas new file mode 100644 index 0000000..13cc3e5 --- /dev/null +++ b/Samples/NETLibraries/System.String/StringMethods2.pas @@ -0,0 +1,37 @@ +var s1,s2: string; + +begin + // Извлечение подстрок + s1 := 'ABCDEFGH'; + s2 := s1.Substring( {начальная_позиция = } 3); + Writeln(s2); + + s2 := s1.Substring(3, {длина_подстроки = } 2); + Writeln(s2); + + // Вставка, удаление и замена подстрок + s1 := 'ABCDEFGH'; + s2 := s1.Insert(2, 'xxx'); + Writeln(s2); + + s2 := s2.Replace('x', '!'); + Writeln(s2); + + s2 := s2.Remove(2, 3); + Writeln(s2); + + s1 := 'слово слово слово'; + s2 := s1.Replace('слов', 'молок'); + Writeln(s2); + + // Удаление пробельных символов в концах строки + s1 := ' xxx xxx '; + Writeln('|', s1, '|'); + s1 := s1.Trim; + Writeln('|', s1, '|'); + + // Смена регистра символов + s1 := 'абвгд'; + s1 := s1.ToUpper; + Writeln(s1); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.String/StringSplit.pas b/Samples/NETLibraries/System.String/StringSplit.pas new file mode 100644 index 0000000..184c12c --- /dev/null +++ b/Samples/NETLibraries/System.String/StringSplit.pas @@ -0,0 +1,26 @@ +uses System; + +var + str_arr: array of string; + int_arr: array of integer; + s: string := '12 765 765 76'; + +begin + // Разбиение строки на массив подстрок с заданным разелителем + str_arr := s.Split(' '); + + // Соединение массива подстрок с новым разделителем + s := string.Join('+', str_arr); + Write(s, '='); + + // Формирование целочисленного массива по массиву подстрок + SetLength(int_arr, str_arr.Length); + for var i:=0 to int_arr.Length-1 do + integer.TryParse(str_arr[i], int_arr[i]); + + // Вычисление суммы элементов целочисленного массива + var sum := 0; + foreach v: integer in int_arr do + sum += v; + Writeln(sum); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Timers.Timer/SystemTimer.pas b/Samples/NETLibraries/System.Timers.Timer/SystemTimer.pas new file mode 100644 index 0000000..8223bd8 --- /dev/null +++ b/Samples/NETLibraries/System.Timers.Timer/SystemTimer.pas @@ -0,0 +1,31 @@ +//События, +=, -=, демонстрация работы таймера System.Timers.Timer +uses System; + +var Timer:System.Timers.Timer; + x:integer; + exit:boolean; + +procedure OnTimer2(sender:object; e:System.Timers.ElapsedEventArgs); +begin + Writeln(x); + x:=x+1; + exit:=x>=10; +end; +procedure OnTimer1(sender:object; e:System.Timers.ElapsedEventArgs); +begin + Writeln(e.SignalTime); + x:=x+1; + if x>=5 then begin + Timer.Elapsed-=OnTimer1; + Timer.Elapsed+=OnTimer2; + end; +end; + +begin + Exit:=false; + Timer:=System.Timers.Timer.Create(1000); + Timer.Elapsed+=OnTimer1; + Timer.Start; + while not exit do + Sleep(Round(Timer.Interval)); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Windows.Forms/FormWebBrowser.pas b/Samples/NETLibraries/System.Windows.Forms/FormWebBrowser.pas new file mode 100644 index 0000000..51a1936 --- /dev/null +++ b/Samples/NETLibraries/System.Windows.Forms/FormWebBrowser.pas @@ -0,0 +1,17 @@ +// Иллюстрация использования компонента WebBrowser +{$apptype windows} +{$reference 'System.Windows.Forms.dll'} + +uses + System.Windows.Forms, + System.Net; + +begin + var myForm := new Form; + var w := new WebBrowser; + w.Url := new System.Uri('http://pascalabc.net'); + w.Dock := Dockstyle.Fill; + myForm.Controls.Add(w); + myForm.WindowState := FormWindowState.Maximized; + Application.Run(myForm); +end. diff --git a/Samples/NETLibraries/System.Windows.Forms/MouseDraw.pas b/Samples/NETLibraries/System.Windows.Forms/MouseDraw.pas new file mode 100644 index 0000000..db17bcf --- /dev/null +++ b/Samples/NETLibraries/System.Windows.Forms/MouseDraw.pas @@ -0,0 +1,52 @@ +// Рисование мышью на форме. Иллюстрация Windows.Forms, событий +{$apptype windows} +{$reference 'System.Windows.Forms.dll'} +{$reference 'System.Drawing.dll'} + +uses + System, + System.Drawing, + System.Windows.Forms; + +type + MyForm = class(Form) + private + g: Graphics; + // Предыдущие координаты мыши + x,y: integer; + public + constructor; + begin + Size := new System.Drawing.Size(640,480); + StartPosition := FormStartPosition.CenterScreen; + Text := 'Рисование мышью на форме'; + // Привязка обработчиков к событиям + MouseDown += OnMouseDown; + MouseMove += OnMouseMove; + Resize += OnResize; + g := Graphics.FromHwnd(Handle); + end; + procedure OnMouseDown(sender: object; e: MouseEventArgs); + begin + x := e.x; + y := e.y; + end; + procedure OnMouseMove(sender: object; e: MouseEventArgs); + begin + if e.Button = System.Windows.Forms.MouseButtons.Left then + begin + g.DrawLine(new Pen(Color.FromARGB(PABCSystem.Random(255),PABCSystem.Random(255),PABCSystem.Random(255))),x,y,e.x,e.y); + x := e.x; + y := e.y; + writeln(e.x,' ',e.y); + end; + end; + procedure OnResize(sender: object; e: EventArgs); + begin + g := Graphics.FromHwnd(Handle); + end; + end; + +begin + Application.Run(new MyForm); +end. \ No newline at end of file diff --git a/Samples/NETLibraries/System.Windows.Forms/WinFormWithButton.pas b/Samples/NETLibraries/System.Windows.Forms/WinFormWithButton.pas new file mode 100644 index 0000000..ecfa4db --- /dev/null +++ b/Samples/NETLibraries/System.Windows.Forms/WinFormWithButton.pas @@ -0,0 +1,29 @@ +// Создание оконного приложения +{$apptype windows} +{$reference 'System.Windows.Forms.dll'} + +uses + System, + System.Windows.Forms; + +var + myForm: Form; + myButton: Button; + +procedure MyButtonClick(sender: Object; e: EventArgs); +begin + myForm.Close; +end; + +begin + myForm := new Form; + myForm.Text := 'Оконное приложение'; + myButton := new Button; + myButton.Text := ' Закрыть окно '; + myButton.AutoSize := True; + myButton.Left := 90; + myButton.Top := 110; + myForm.Controls.Add(myButton); + myButton.Click += MyButtonClick; + Application.Run(myForm); +end. diff --git a/Samples/NumLibABC/ApproxCheb1.pas b/Samples/NumLibABC/ApproxCheb1.pas new file mode 100644 index 0000000..915dbf8 --- /dev/null +++ b/Samples/NumLibABC/ApproxCheb1.pas @@ -0,0 +1,14 @@ +uses NumLibABC; + +// +// +begin + var e:=0.1; + var x:=ArrGen(12,i->0.25*i-2); x.Println; + var y:=x.Select(z->2*z-5*Sqr(z)+8*z*Sqr(z)).ToArray; y.Println; + var oL:=new ApproxCheb(x,y,e); + oL.f.Println; // + Println(oL.r,oL.tol); // + oL.MakeCoef; // + oL.c.Println; +end. diff --git a/Samples/NumLibABC/Decomp1.pas b/Samples/NumLibABC/Decomp1.pas new file mode 100644 index 0000000..120f4d0 --- /dev/null +++ b/Samples/NumLibABC/Decomp1.pas @@ -0,0 +1,11 @@ +uses NumLibABC; + +// +begin + var A:=new real[3,3] ((2,3,-1),(1,-2,1),(1,0,2)); + var B:=new real[3] (9,3,2); + var oL:=new Decomp(A); + oL.Solve(B); + B.Println; + Writeln('cond=',oL.cond) +end. diff --git a/Samples/NumLibABC/DiffEqu1.pas b/Samples/NumLibABC/DiffEqu1.pas new file mode 100644 index 0000000..133b8a2 --- /dev/null +++ b/Samples/NumLibABC/DiffEqu1.pas @@ -0,0 +1,29 @@ +uses NumLibABC; + +// + +procedure Orbit(t:real; y,yp:array of real); +// +// y[] yp[] +begin + var alpha:=Sqr(ArcTan(1.0)); + var r:=y[0]*y[0]+y[1]*y[1]; r:=r*Sqrt(r)/alpha; + yp[0]:=y[2]; yp[1]:=y[3]; yp[2]:=-y[0]/r; yp[3]:=-y[1]/r +end; + +begin + var e:=0.25; + var y:=Arr(1.0-e,0.0,0.0,ArcTan(1)*Sqrt((1.0+e)/(1.0-e))); + var (abserr,relerr):=(0.0,0.3e-6); + var oL:=new RKF45(Orbit, y, abserr, relerr); + var (t,tb,th):=(0.0,12.0,0.5); + var t_out:=t; + repeat + oL.Solve(t,t_out); + Writeln(t:5:1,oL.y[0]:15:9,oL.y[1]:15:9); + case oL.flag of + -3,-2,-1,1,8:begin Writeln('Flag=',oL.flag); Exit end; + 2:t_out:=t+th; + end + until t>=tb +end. diff --git a/Samples/NumLibABC/Economi1.pas b/Samples/NumLibABC/Economi1.pas new file mode 100644 index 0000000..a66bbd0 --- /dev/null +++ b/Samples/NumLibABC/Economi1.pas @@ -0,0 +1,12 @@ +uses NumLibABC; + +// +begin + var x:=ArrGen(8,-0.75,x->x+0.25); + var p:=new Polynom(0,1,-1/2,1/3,-1/4,1/5); + var r:=p.EconomSym(0.75, 0.05); + Println(r.eps,r.n); + r.PrintlnBeauty; + for var i:=1 to x.Length do + Write(r.Value(x[i-1]):0:3,' ') +end. diff --git a/Samples/NumLibABC/FMinN_1.pas b/Samples/NumLibABC/FMinN_1.pas new file mode 100644 index 0000000..b99d8d5 --- /dev/null +++ b/Samples/NumLibABC/FMinN_1.pas @@ -0,0 +1,13 @@ +uses NumLibABC; + +// - +function f(x:array of real):real:=100*Sqr(x[1]-Sqr(x[0]))+Sqr(1-x[0]); + +begin + var xb:=Arr(-1.2,1.0); + var oL:=new FMinN(xb,f); + var r:=oL.HJ; + Writeln(' : ',oL.iter); + Write(' : '); r.Println; + Writeln(' : ',f(r)); +end. diff --git a/Samples/NumLibABC/FMinN_2.pas b/Samples/NumLibABC/FMinN_2.pas new file mode 100644 index 0000000..4dcf385 --- /dev/null +++ b/Samples/NumLibABC/FMinN_2.pas @@ -0,0 +1,14 @@ +uses NumLibABC; + +// MKSearch +begin + var f:function(x:array of real):real:= x->Power(x[0],4)+ + Power(x[1],4)-2*Sqr(x[0])+4*x[0]*x[1]-2*Sqr(x[1])+3; + var a:=Arr(-20.0,-20.0); + var b:=Arr(20.0,20.0); + var y:real; + var oL:=new FMinN(a,f); + oL.MKSearch(a,b,y); + Write(' : '); oL.x.Println; + Writeln(' : ', y); +end. diff --git a/Samples/NumLibABC/FMinN_3.pas b/Samples/NumLibABC/FMinN_3.pas new file mode 100644 index 0000000..9d9cf69 --- /dev/null +++ b/Samples/NumLibABC/FMinN_3.pas @@ -0,0 +1,14 @@ +uses NumLibABC; + +// BPHS +begin + var f:function(x:array of real):real:= x->Power(x[0],4)+ + Power(x[1],4)-2*Sqr(x[0])+4*x[0]*x[1]-2*Sqr(x[1])+3; + var a:=Arr(-20.0,-20.0); // + var b:=Arr(20.0,20.0); // + var y:real; // + var oL:=new FMinN(a,f); + oL.BPHS(a,b,y); + Write(' : '); oL.x.Println; + Writeln(' : ', y); +end. diff --git a/Samples/NumLibABC/FMinN_4.pas b/Samples/NumLibABC/FMinN_4.pas new file mode 100644 index 0000000..809e15e --- /dev/null +++ b/Samples/NumLibABC/FMinN_4.pas @@ -0,0 +1,23 @@ +uses NumLibABC; + +// BestP +begin + var f:function(x:array of real):real:= x->Power(x[0],4)+ + Power(x[1],4)-2*Sqr(x[0])+4*x[0]*x[1]-2*Sqr(x[1])+3; + var a:=Arr(-20.0,-20.0); // + var b:=Arr(20.0,20.0); // + var x:=new real[a.Length]; // MinHJ + var oL:=new FMinN(x,f); + var r:=oL.BestP(a,b,0.01); + var y:real; + var fet:=f(Arr(Sqrt(2),-Sqrt(2))); + foreach var t in r do begin + (y,x):=(t[0],t[1]); + Write(' : '); x.Println; + Write('.: '); + x.Foreach(z->WriteFormat('{0:0.0e0} ',Abs(z)-Sqrt(2))); + Writeln; + Writeln(' : ', y, ', .: ',Abs(y-fet)); + Writeln + end +end. diff --git a/Samples/NumLibABC/FMinN_5.pas b/Samples/NumLibABC/FMinN_5.pas new file mode 100644 index 0000000..eddd2b8 --- /dev/null +++ b/Samples/NumLibABC/FMinN_5.pas @@ -0,0 +1,13 @@ +uses NumLibABC; + +// ARS +begin + var f:function(x:array of real):real:= + x->4*Sqr(x[0]-5)+Sqr(x[1]-6); + var x:=Arr(-8.0,9.0); + var (t,R):=(1.0,1e-6); + var oL:=new FMinN(x,f); + oL.ARS(R,t); + Write(': '); oL.x.Println; + Writeln(' : ',f(oL.x)) +end. diff --git a/Samples/NumLibABC/FMinN_6.pas b/Samples/NumLibABC/FMinN_6.pas new file mode 100644 index 0000000..dccdb8d --- /dev/null +++ b/Samples/NumLibABC/FMinN_6.pas @@ -0,0 +1,27 @@ +uses NumLibABC; + +// ( ) + +function f(x:array of real):real; +begin + var x1:=x[0]; + var x2:=x[1]; + var s:=0.0; // + if x1+x2>8 then s:=real.MaxValue + else if -2*x1+3*x2>9 then s:=real.MaxValue + else if 2*x1-x2>10 then s:=real.MaxValue + else if x1<0 then s:=real.MaxValue + else if x2<0 then s:=real.MaxValue; + Result:=-4*x1-3*x2+1+s +end; + +begin + var a:=Arr(0.0,0.0); + var b:=Arr(8.0,8.0); + var y:real; + var oL:=new FMinN(a,f); + oL.MKSearch(a,b,y); + oL.x.Transform(t->real(Round(t))); + Write(' : '); oL.x.Println; + Writeln(' : ',f(oL.x)) +end. diff --git a/Samples/NumLibABC/FMin_1.pas b/Samples/NumLibABC/FMin_1.pas new file mode 100644 index 0000000..c0ede58 --- /dev/null +++ b/Samples/NumLibABC/FMin_1.pas @@ -0,0 +1,9 @@ +uses NumLibABC; + +// + +begin + var fun:real->real:=x->x*Sqr(x)-2*x-5; + var oL:=new Fmin(fun,-1,1); + Println(oL.x, oL.Value) +end. diff --git a/Samples/NumLibABC/Factors1.pas b/Samples/NumLibABC/Factors1.pas new file mode 100644 index 0000000..697873c --- /dev/null +++ b/Samples/NumLibABC/Factors1.pas @@ -0,0 +1,10 @@ +uses NumLibABC; + +// +// +begin + var oL:=new Factors(-20, 7, 73, -42); + var r:=oL.Factorize; + Writeln('k:=',r[0,1]); + for var i:=1 to r[0,0] do r.Row(i).Println; +end. diff --git a/Samples/NumLibABC/Fraction1.pas b/Samples/NumLibABC/Fraction1.pas new file mode 100644 index 0000000..25db375 --- /dev/null +++ b/Samples/NumLibABC/Fraction1.pas @@ -0,0 +1,8 @@ +uses NumLibABC; + +// +begin + var r:=((Frc(5,5,9)-Frc(7,18))/35+(Frc(40,63)-Frc(8,21))/20+ + (Frc(83,90)-Frc(41,50))/2)*50; + r.Print +end. diff --git a/Samples/NumLibABC/Matrix1.pas b/Samples/NumLibABC/Matrix1.pas new file mode 100644 index 0000000..f91f8bf --- /dev/null +++ b/Samples/NumLibABC/Matrix1.pas @@ -0,0 +1,11 @@ +uses NumLibABC; + +// () +begin + // M = det ((A-BxC)^T)xA + var A:=new Matrix(2,4,-3,0,4,-1,2,-7,5,6); + var B:=new Matrix(2,3,8,1,-5,6,7,2); + var C:=new Matrix(3,4,1,-1,7,0,3,2,9,4,5,0,-2,-4); + var M:=(((A-B*C).Transpose)*A).Det; + Writeln(M) +end. diff --git a/Samples/NumLibABC/NumLibABCTest.pas b/Samples/NumLibABC/NumLibABCTest.pas new file mode 100644 index 0000000..2210833 --- /dev/null +++ b/Samples/NumLibABC/NumLibABCTest.pas @@ -0,0 +1,981 @@ +uses NumLibABC; + +procedure TestApproxCheb(s:string; a,b:array of real; eps:real); +// a - +// b - +// eps - +begin + for var i:=0 to a.Length-1 do begin + var Msg:=s+': : '+a[i]+', '+b[i]; + Assert(Abs(Abs(a[i])-Abs(b[i]))<=eps,Msg); + end +end; + +procedure TestDecomp(s:string; a:array[,] of real; b:array of real; + roots:array of real; eps:real); +// a - ; +// b - ; +// roots - ; +// eps - +begin + var oD:=new Decomp(a); + var Msg:=s+': cond='+oD.cond+' '; + var Flag:=oD.cond+1=oD.cond; + Assert(not Flag,Msg); + if not Flag then begin + oD.Solve(b); + var sum:=b.Zip(roots,(p,q)->Abs(Abs(p)-Abs(q))).Sum; + Msg:=s+': '+sum+' > '+eps+NewLine+ + ' : '+b.JoinIntoString(' ')+NewLine+ + ': '+roots.JoinIntoString(' '); + Assert(sum<=eps,Msg); + end +end; + +procedure TestFactors(s:string; a:array of integer; roots:array of integer); +// a - ; +// aroots - ; +begin + var oL:=new Factors(a); + var r:=oL.Factorize; + var r1:=r.Rows.SelectMany(x->x); + var Msg:=s+': .'+Newline+r1.JoinIntoString+': '+NewLine+ + roots.JoinIntoString+': '; + if r1.Count=roots.Count then begin + var s1:=r1.Zip(roots,(i,j)->i-j).Sum; + Assert(s1=0,Msg) + end + else + Assert(false,Msg) +end; + +{$region FMinTest} +procedure TestFMin(s:string; f:real->real; a,b,etx,ety,epsx,epsy:real); +// etx - +// etx - +// epsx - +// epsy - +begin + var oL:=new FMin(f,a,b); + var (x,y):=(oL.x,oL.Value); + var Msg:=s+': : '+x+', '+etx; + Assert(Abs(x-etx)<=epsx,Msg); + Msg:=s+': : '+y+', '+ety; + Assert(Abs(y-ety)<=epsy,Msg); +end; + +procedure TestFMinN1(s:string; f:function(x:array of real):real; + xb:array of real; etx:array of real; ety,epsx,epsy:real); +// xb - +// etx - +// etx - +// epsx - +// epsy - +begin + var oL:=new FMinN(xb,f); + var x:=oL.HJ; + var y:=f(x); + var Msg:=s+':'+NewLine+' : '+ + x.Select(t->Format('{0}',t)).JoinIntoString+NewLine+ + ' : '+ + etx.Select(t->Format('{0}',t)).JoinIntoString; + for var i:=0 to x.Length-1 do + if Abs(x[i]-etx[i])>epsx then begin + Assert(false,Msg); + break + end; + Msg:=s+': : '+y+', '+ety; + Assert(Abs(y-ety)<=epsy,Msg); +end; + +procedure TestFMinN2(s:string; f:function(x:array of real):real; + a,b:array of real; k,m:integer; etx:array of real; ety,epsx,epsy:real); +// a,b - +// k - BPHS +// m - MKSearch +// etx - +// etx - +// epsx - +// epsy - +begin + var oL:=new FMinN(etx,f); + var y:real; + oL.BPHS(a,b,y,k,m); + var Msg:=s+':'+NewLine+' : '+ + oL.x.Select(t->Format('{0}',t)).JoinIntoString+NewLine+ + ' : '+ + etx.Select(t->Format('{0}',t)).JoinIntoString; + for var i:=0 to oL.x.Length-1 do + if Abs(oL.x[i]-etx[i])>epsx then begin + Assert(false,Msg); + break + end; + Msg:=s+': : '+y+', '+ety; + Assert(Abs(y-ety)<=epsy,Msg); +end; + +procedure TestFMinN3(s:string; f:function(x:array of real):real; + a,b:array of real; k,m:integer; etx:array of real; ety,epsx,epsy:real); +// a,b - +// k - BPHS +// m - MKSearch +// etx - +// etx - +// epsx - +// epsy - +begin + var oL:=new FMinN(etx,f); + var y:real; + var r:=oL.BestP(a,b,epsx,10,k,m); + var x:array of real; + foreach var t in r do begin + (y,x):=(t[0],t[1]); + var Msg:=s+':'+NewLine+' : '+ + x.Select(t->Format('{0}',t)).JoinIntoString+NewLine+ + ' : '+ + etx.Select(t->Format('{0}',t)).JoinIntoString; + for var i:=0 to x.Length-1 do + if Abs(x[i]-etx[i])>epsx then begin + Assert(false,Msg); + break + end; + Msg:=s+': : '+y+', '+ety; + Assert(Abs(y-ety)<=epsy,Msg) + end +end; + +procedure TestFMin4(s:string; f:function(x:array of real):real; + x:array of real; R:real; var t:real; v:array of real; eps,epsf:real); +// f - +// x - +// R - +// t - +// v - +// eps - +// epsf - +begin + var oL:=new FMinN(x,f); + oL.ARS(R,t); + var Msg:=s+': '; + Assert(t<=R,Msg); + Msg:=s+': , ['+v.Skip(1).JoinIntoString(',')+ + '], ['+oL.x.JoinIntoString(',')+']'; + var p:=true; + for var i:=0 to oL.x.Length-1 do p:=p and (Abs(oL.x[i])-Abs(v[i+1])<=eps); + Assert(p,Msg); + Msg:=s+': '+t+', '+v[0]; + Assert(Abs(t-v[0])<=epsf,Msg) +end; +{$endregion} + +procedure TestFraction(s:string; res,ans:Fraction); +// res=ans +begin + Assert(res=ans,s+': '+res.ToString+', '+ans.ToString) +end; + +{$region MatrixTest} +procedure TestMatrixS(s:string; a,r,eps:real); +// a - ; +// r - ; +// eps - +begin + var Msg:=s+': .'+Newline+' '+ + a+', '+r; + Assert(Abs(a-r)<=eps,Msg) +end; + +procedure TestMatrixV(s:string; a,r:Vector; eps:real); +// a - ; +// r - ; +// eps - +begin + for var i:=0 to a.Length-1 do + Assert(Abs(a.Value[i]-r.Value[i])<=eps, + s+': .'+Newline+' '+ + a.Value[i]+', '+r.Value[i]) +end; + +procedure TestMatrixM(s:string; a,r:Matrix; eps:real); +// a - ; +// r - ; +// eps - +begin + for var i:=0 to a.RowCount-1 do + for var j:=0 to a.ColCount-1 do + Assert(Abs(a.Value[i,j]-r.Value[i,j])<=eps, + s+': .'+Newline+' a['+ + i+','+j+']='+a.Value[i,j]+', '+r.Value[i,j]) +end; +{$endregion} + +procedure TestPolRt(s:string; a:Polynom; roots:array of complex; eps:real); +// roots - +// eps - +begin + var oP:=new PolRt(a); + if oP.ier>0 then begin + var Msg:=s+': , '+oP.ier; + Assert(false,Msg) + end + else begin + var r:=oP.Value; + for var i:=0 to r.Length-1 do begin + var Msg:=s+': : ('+r[i].Real+','+r[i].Imaginary+'), ('+ + roots[i].Real+','+roots[i].Imaginary+')'; + Assert(Complex.Abs(r[i]-roots[i])<=eps,Msg); + end + end +end; + +procedure TestPolynomD(s:string; res,lim:real; n1,n2:integer); +// res - +// lim - res +// n2n2,s+': '); + Assert(res<=lim,s+': '+res+' '+lim); +end; + +procedure TestPolynomV(s:string; p:Polynom; x,r,eps:real); +// - , +// r - +// eps - +begin + var a:=p.Value(x); + var Msg:=s+': : '+a+', '+r; + Assert(Abs(a-r)<=eps,Msg) +end; + +procedure TestQuanc8(s:string; a,b:real; F:real->real; ae,re,r2,eps:real); +// cres - +// eps - +begin + var Msg:string; + var oQ:=new Quanc8(f,a,b,ae,re); + var r1:=oQ.Value; + if r1[2]=0 then begin + Msg:=s+': '+r1[0]+', '+r2; + Assert(Abs(r1[0]-r2)<=eps,Msg) + end + else begin + Msg:=s+': '+r1[0]+', '+r2+', errest='+r1[1]+', flag='+r1[2]; + Assert(Abs(r1[0]-r2)<=eps,Msg) + end +end; + +procedure TestRKF45(s:string; res,ans,eps:real); +begin + Assert(Abs(res-ans)<=eps,s+': '+res+', '+ans) +end; + +procedure TestRootsIsolation(s:string; f:real->real; a,b,h:real; + t:array of real); +// f - +// a,b - +// h - +// t - +begin + var oRI:=new RootsIsolation(f,a,b,h); + var r:=oRI.Value; + for var i:=0 to t.Length-1 do begin + var Msg:=s+': '+t[i]+' ['+r[i][0]+';'+r[i][1]+']'; + Assert(t[i].Between(r[i][0],r[i][1]),Msg) + end; +end; + +procedure TestSpline(st:string; x:real; F:real->real; eps:real; S:Spline); +// eps - +begin + var r1:=F(x); + var r2:=S.Value(x); + var Msg:=st+': F('+x+')='+r1+', '+r2; + Assert(Abs((r1-r2)/r1)<=eps/100,Msg); +end; + +procedure TestSvenn(s:string; f:real->real; x0,t,a,b:real); +// f - +// x0 - +// t - +// a,b - ( ) +begin + var oS:=new Svenn(f,x0,t); + var r:=oS.Value; + var Msg:=s+': , ['+a+';'+b+']'; + Assert(r[2]=0,Msg); + Msg:=s+': ['+a+';'+b+'] ['+r[0]+';'+r[1]+']'; + Assert(a.Between(r[0],r[1]) and b.Between(r[0],r[1]),Msg) +end; + +{$region VectorTest} +procedure TestVector1(s:string; a,r,eps:real); +// a - ; +// r - ; +// eps - +begin + var Msg:=s+': .'+Newline+' '+ + a+', '+r; + Assert(Abs(a-r)<=eps,Msg) +end; + +procedure TestVectorN(s:string; a,r:Vector; eps:real); +// a - ; +// r - ; +// eps - +begin + for var i:=0 to a.Length-1 do + Assert(Abs(a.Value[i]-r.Value[i])<=eps, + s+': .'+Newline+' '+ + a.Value[i]+', '+r.Value[i]) +end; +{$endregion} + +procedure TestZeroin(s:string; a,b:real; F:real->real; root,eps:real); +// root - +// eps - +begin + var oZ:=new Zeroin(F,eps); + var x:=oZ.Value(a,b); + var Msg:=s+': : '+x+', '+root; + Assert(Abs(x-root)<=eps,Msg); +end; + +begin + var nt:=1; + Writeln('*** ',&NumLibABCVersion,' ***'); + Writeln(' *** ***'); + + {$region ApproxCheb} + begin + var e:=0.1; + var x:=ArrGen(12,i->0.25*i-2); + var y:=x.Select(z->2*z-5*Sqr(z)+8*z*Sqr(z)).ToArray; + var oC:=new ApproxCheb(x,y,e); + oC.MakeCoef; + TestApproxCheb('AppoxCheb 1',oC.c,Arr(0.0,2.0,-5.0,8.0),1e-12); + + e:=0.1; + x:=ArrGen(10,i->i-3.0); + y:=x.Select(z->4+z*(-2.5+z*(1.752+z*(-9+z*0.28)))).ToArray; + oC:=new ApproxCheb(x,y,e); + oC.MakeCoef; + TestApproxCheb('AppoxCheb 2',oC.c,Arr(4.0,-2.5,1.752,-9.0,0.28),1e-12); + + e:=0.5; + x:=ArrGen(7,i->0.2*i-0.3); + y:=x.Select(z->3*sin(z)+5.6*Ln(Abs(z))).ToArray; + oC:=new ApproxCheb(x,y,e); + TestApproxCheb('AppoxCheb 3',oC.f,y,0.8); + + Writeln(nt:2,'. ApproxCheb '); + nt+=1; + end; + {$endregion} + + {$region Decomp} + begin + // + var a:=new real[3,3] ( + (10.0,-7.0,0.0), + (-3.0,2.0,6.0), + (5.0,-1.0,5.0)); + var b:=Arr(7.0,4.0,6.0); + var r:=Arr(0.0,-1.0,1.0); + TestDecomp('Decomp/Solve 1',a,b,r,1e-15); + + // ., .. " " + // Maple15 + a:=new real[4,4] ( + (1.0,0.17,-0.25,0.54), + (0.47,1.0,0.67,-0.32), + (-0.11,0.35,1.0,-0.74), + (0.55,0.43,0.36,1.0)); + b:=Arr(0.3,0.5,0.7,0.9); + r:=Arr(7039205/15965951,-5796135/15965951,18629045/15965951,6283675/15965951); + TestDecomp('Decomp/Solve 2',a,b,r,1e-15); + + // 135. . .. . + // " 101-150" + var aa:=new real[3,3] ( + (4.0,2.0,2.0), + (2.0,2.0,2.0), + (2.0,2.0,3.0)); + a:=Copy(aa); // + //a:=MatrGen(3,3,(i,j)->aa[3*i+j]); + b:=Arr(2.0,3.0,4.0); + r:=Arr(-0.5,1.0,1.0); + TestDecomp('Decomp/Solve 3-1',a,b,r,1e-15); + a:=Copy(aa); + b:=Arr(-1.0,1.0,2.0); + r:=Arr(-1.0,0.5,1.0); + TestDecomp('Decomp/Solve 3-2',a,b,r,1e-15); + a:=Copy(aa); + b:=Arr(3.0,2.0,3.0); + r:=Arr(0.5,-0.5,1.0); + TestDecomp('Decomp/Solve 3-3',a,b,r,1e-15); + + Writeln(nt:2,'. Decomp/Solve '); + nt+=1 + end; + {$endregion} + + {$region Factors} + begin + var a:=Arr(-20,7,73,-42); + TestFactors('Factors 1',a,Arr(3,-1,2,-1,3,5,7,4)); + + a:=Arr(45,-12,-52,-1,6); + TestFactors('Factors 2',a,Arr(2,1,1,3,2,-5)); + + a:=Arr(6,-13,9,-2); + TestFactors('Factors 3',a,Arr(3,-1,1,1,2,3,1,2)); + + a:=Arr(40,10,2); + TestFactors('Factors 4',a,Arr(0,1)); + + a:=Arr(-40,78,-29,3); + TestFactors('Factors 5',a,Arr(3,1,1,4,1,5,3,2)); + + Writeln(nt:2,'. Factors '); + nt+=1 + end; + {$endregion} + + {$region FMin} + begin + var f:real->real:=x->x*(x*x-2)-5; + TestFMin('FMin 1',f,0,1,Sqrt(2/3),-(Sqrt(32/27)+5),1e-8,1e-18); + + TestFMin('FMin 2',f,-4,4,Sqrt(2/3),-(Sqrt(32/27)+5),1e-7,1e-18); + + f:=x->x*Sqr(x-1)*(x-3)*Sqr(x-3); + var etx:=(13-Sqrt(97))/12; + var ety:=-(232229+4171*Sqrt(97))/93312; + TestFMin('FMin 3',f,-5,1.5,etx,ety,1e-7,1e-17); + + etx:=(13+Sqrt(97))/12; + ety:=(-232229+4171*Sqrt(97))/93312; + TestFMin('FMin 4',f,0.5,3.1,etx,ety,1e-7,1e-15); + + f:=x->x=0?1e15:(x+2)*Exp(1/x); + TestFMin('FMin 5',f,-1.5,4,2.0,4*Exp(0.5),1e-7,1e-17); + + Writeln(nt:2,'. FMin '); + nt+=1 + end; + {$endregion} + + {$region FMinN} + begin + var Rosenbrock:function(x:array of real):real:= + x->100*Sqr(x[1]-Sqr(x[0]))+Sqr(1-x[0]); + var xb:=Arr(-1.2,1.0); + var xet:=Arr(1.0,1.0); + TestFminN1('FMinN 1: HJ, ', + Rosenbrock,xb,xet,0,1e-5,1e-8); + + var Woods:function(x:array of real):real:=x-> + begin + var s1:=x[1]-Sqr(x[0]); + var s2:=1-x[0]; + var s3:=x[1]-1; + var t1:=x[3]-Sqr(x[2]); + var t2:=1-x[2]; + var t3:=x[3]-1; + var t4:=s3+t3; + var t5:=s3-t3; + Result:=100*Sqr(s1)+Sqr(s2)+90*Sqr(t1)+Sqr(t2)+10*Sqr(t4)+0.1*Sqr(t5) + end; + xb:=Arr(-3.0,-1.0,-3.0,-1.0); + xet:=Arr(1.0,1.0,1.0,1.0); + TestFminN1('FMinN 2: HJ, 4 ', + Woods,xb,xet,0,1e-4,1e-8); + + var f1:function(x:array of real):real:= + x->x[0]*(Sqr(x[0])-2)-5; + xb:=Arr(0.0); + xet:=Arr(Sqrt(2/3)); + TestFminN1('FMinN 3: HJ, x^3-2x-5', + f1,xb,xet,-Sqrt(32/27)-5,1e-4,1e-8); + + var FSimplex:function(x:array of real):real:=x-> + begin + var x1:=x[0]; + var x2:=x[1]; + var s:=0.0; + if x1+x2>8 then s:=real.MaxValue + else if -2*x1+3*x2>9 then s:=real.MaxValue + else if 2*x1-x2>10 then s:=real.MaxValue + else if x1<0 then s:=real.MaxValue + else if x2<0 then s:=real.MaxValue; + Result:=-4*x1-3*x2+1+s + end; + xb:=Arr(0.0,0.0); + xet:=Arr(6.0,2.0); + var oL:=new FMinN(xb,FSimplex); + var a:=Arr(0.0,0.0); + var b:=Arr(8.0,8.0); + var y:real; + oL.MKSearch(a,b,y); + xb:=oL.x.Select(t->real(Round(t))).ToArray; + TestFminN1('FMinN 4: MKSearch+HJ, ', + FSimplex,xb,xet,-29,1e-4,1e-8); + + a:=Arr(-1.0,-1.0); + b:=Arr(2.0,2.0); + xb:=new real[a.Length]; + xet:=Arr(1.0,1.0); + TestFminN2('FMinN 5: BPHS, ', + Rosenbrock,a,b,100,1000,xet,0,1e-3,1e-5); + + a:=Arr(-1.0,-1.0,-1.0,-1.0); + b:=Arr(2.0,2.0,2.0,2.0); + xet:=Arr(1.0,1.0,1.0,1.0); + TestFminN2('FMinN 6: BPHS, 4 ', + Woods,a,b,100,5000,xet,0,1e-1,1e-2); + + a:=Arr(0.0,0.0); + b:=Arr(8.0,8.0); + xet:=Arr(6.0,2.0); + TestFminN2('FMinN 7: BestP, ', + FSimplex,a,b,100,1000,xet,-29,1e-2,1e-6); + + f1:=x->4*Sqr(x[0]-5)+Sqr(x[1]-6); + xb:=Arr(-8.0,9.0); + var (t,R):=(1.0,1e-6); + var v:=Arr(f1(Arr(5.0,6.0)),5.0,6.0); + TestFMin4('FMinN 8: ARS',f1,xb,R,t,v,2*R,10*R); + + f1:=x->2*Sqr(x[0])+x[0]*x[1]+Sqr(x[1]); + xb:=Arr(-10.0,10.0); + (t,R):=(1.0,1e-10); + v:=Arr(f1(Arr(0.0,0.0)),0.0,0.0); + TestFMin4('FMinN 9: ARS',f1,xb,R,t,v,2*R,10*R); + + Writeln(nt:2,'. FMinN '); + nt+=1 + end; + {$endregion} + + {$region Fraction} + begin + var r:=((Frc(5,5,9)-Frc(7,18))/35+(Frc(40,63)-Frc(8,21))/20+ + (Frc(83,90)-Frc(41,50))/2)*50; + TestFraction('Fraction 1',r,Frc(74,7)); + + r:=Frc(34,197)+Frc(6,9,91)-Frc(351,95113)*Frc(1,7); + TestFraction('Fraction 2',r,Frc(10692560566,1705090751)); + + var m:=Range(1,30,2).Aggregate(BigInteger(1),(i,j)->i*j); + var n:=Range(2,30,2).Aggregate(BigInteger(1),(i,j)->i*j)+1; + var a:=Frc(m,n); + var b:=Frc(6190283353629375,42849873690624001); + TestFraction('Fraction 3',a,b); + + Writeln(nt:2,'. Fraction '); + nt+=1 + end; + {$endregion} + + {$region Matrix} + begin + var a:=new Matrix(3,4,-2,4,0,3,6,11,-5,7,0,8,-4,1); + a.SetRow(new Vector(a.Row(2).Value.Select(x->x-2).ToArray),2); + a.MultCol(1,3); + var vb:=new Vector(1,-1,0,2); + a.InsertRowBefore(vb,3); + a.SwapRows(2,3); + a.SwapCols(1,3); + a:=a.Transpose; + var Atr:=a.Inv; + var d:=254.0; + var x:=new Matrix(4,4,173/d,83/d,27/d,28/d,-426/d,-222/d,-112/d,72/d, + 122/d,60/d,44/d,8/d,-277/d,-105/d,-77/d,-14/d); + TestMatrixM('Matrix 1',Atr,x,1e-14); + + a:=new Matrix(2,4,-3,0,4,-1,2,-7,5,6); + var b:=new Matrix(2,3,8,1,-5,6,7,2); + var c:=new Matrix(3,4,1,-1,7,0,3,2,9,4,5,0,-2,-4); + var r:=(((a-b*c).Transpose)*a).Det; + TestMatrixS('Matrix 2',r,0.0,1e-15); + + a:=new Matrix(3,3,2,3,-1,1,-2,1,1,0,2); + vb:=new Vector(9,3,2); + var vr:=a.Inv*vb; + TestMatrixV('Matrix 3',vr,new Vector(4,0,-1),1e-15); + + vr:=new Vector(vb.Length); + var det:=a.Det; + for var i:=0 to vb.Length-1 do begin + var t:=a.Copy; + t.SetCol(vb,i,0); + var detx:=t.Det; + vr.Value[i]:=detx/det; + end; + TestMatrixV('Matrix 4',vr,new Vector(4,0,-1),1e-15); + + var cond:real; + vr:=A.SLAU(vb,cond); + TestMatrixV('Matrix 5.1',vr,new Vector(4,0,-1),1e-15); + TestMatrixS('Matrix 5.2',cond,1.97935318837932,1e-14); + + Writeln(nt:2,'. Matrix '); + nt+=1 + end; {$endregion} + + {$region Polrt} + begin + var p:=new Polynom(-120,34,-4,-1,1); + var cr:=Arr(cplx(3,0),cplx(-4,0),cplx(1,-3),cplx(1,3)); + TestPolrt('Polrt 1',p,cr,1e-15); + + p:=new Polynom(6,-5,-2,1); + cr:=Arr(cplx(1,0),cplx(-2,0),cplx(3,0)); + TestPolrt('Polrt 2',p,cr,1e-15); + + p:=new Polynom(-120,274,-225,85,-15,1); + cr:=Arr(cplx(1,0),cplx(2,0),cplx(3,0),cplx(4,0),cplx(5,0)); + TestPolrt('Polrt 3',p,cr,1e-12); + + p:=new Polynom(8,-6,6,1,2,-2,1); + cr:=ArrFill(6,cplx(-1,-1)); + cr[0]:=cplx(0.5,-Sqrt(3)/2); cr[1]:=Conjugate(cr[0]); + cr[2]:=cplx(1.5,-Sqrt(7)/2); cr[3]:=Conjugate(cr[2]); + cr[5]:=Conjugate(cr[4]); + TestPolrt('Polrt 4',p,cr,1e-15); + + p:=new Polynom(-36,0,49,0,-14,0,1); + cr:=Arr(cplx(-2,0),cplx(2,0),cplx(-3,0),cplx(3,0),cplx(-1,0),cplx(1,0)); + TestPolrt('Polrt 5',p,cr,1e-15); + + p:=new Polynom(-16,0,0,0,1); + cr:=Arr(cplx(0,2),cplx(0,-2),cplx(-2,0),cplx(2,0)); + TestPolrt('Polrt 6',p,cr,1e-15); + + p:=new Polynom(-250,125,45,-32,4); + cr:=Arr(cplx(2.5,0),cplx(5,0),cplx(-2,0),cplx(2.5,0)); + TestPolrt('Polrt 7',p,cr,1e-8); + + p:=new Polynom(-1,0,0,0,0,1); + cr:=ArrFill(5,cplx(1,0)); // y=x^5-1 + cr[1]:=cplx(-(Sqrt(5)+1)/4,-Sqrt(10-2*Sqrt(5))/4); cr[2]:=Conjugate(cr[1]); + cr[3]:=cplx((Sqrt(5)-1)/4,-Sqrt(10+2*Sqrt(5))/4); cr[4]:=Conjugate(cr[3]); + TestPolrt('Polrt 8',p,cr,1e-15); + + Writeln(nt:2,'. PolRt '); + nt+=1; + end; + {$endregion} + + {$region Polynom} + begin + var p:=new Polynom(2,6,8,3,1); // 13862(10) + TestPolynomV('Polynom 1',p,10,13862,1e-15); + + p:=new Polynom(0,3,8,6,4,2,5); // 0.386425 + TestPolynomV('Polynom 2',p,0.1,0.386425,1e-15); + + p:=new Polynom(1,0,1,1,0,1,1,0,1); // 365(10)=101101101(2) + TestPolynomV('Polynom 3',p,2,365,1e-15); + + p:=new Polynom(1,1,1/2,1/6,1/24,1/120,1/720,1/5040,1/40320); // exp(x) + TestPolynomV('Polynom 4',p,0.36,exp(0.36),1e-9); + + // -1435+(25*12+917) = -218 + var a:=new Polynom(5,3,4,1); + var b:=new Polynom(5,2); + var c:=new Polynom(2,1); + var d:=new Polynom(7,1,9); + TestPolynomV('Polynom 5',-a+(b*c+d),10,-218,1e-15); + + p:=new Polynom(6,-2,0,-5,0,2,3); + a:=new Polynom(-1,3,-2,4); + (b,c):=p/a; + var x:=pi; + var x1:=b.Value(x)+c.Value(x)/a.Value(x); + var x2:=p.Value(x)/a.Value(x); + var Msg:='Polynom 6: : '+x1+', '+x2; + Assert(Abs(x1-x2)<=1e-15,Msg); + + var k:=ArrFill(20,0.0); + var i:=3; + k[1]:=2; + var pr:=1.0; + while i<=19 do begin + pr:=-pr*i*(i-1); + k[i]:=1/pr; + i:=i+2 + end; + p:=new Polynom(k); + var p2:=p.EconomSym(1,1e-10); + var dm:=-1.0;; + for var j:=0 to 20 do begin + x:=-1.0+j/10; + var y:=p.Value(x); + var z:=p2.Value(x); + var d1:=Abs(y-z); + if dmreal:=x->x=0?1.0:Sin(x)/x; // + var s:real; + begin + s:=2.0; + var (p2,f1,sgn,i):=(2.0,1.0,1,1); + var tt:real; + repeat + p2*=4; f1*=2*i*(2*i+1); sgn:=-sgn; + tt:=sgn*p2/f1/(2*i+1); + s+=tt; + i+=1; + until Abs(tt)4/(1+x*x); + TestQuanc8('Quanc8 2',0,1,f,abserr,relerr,pi,1e-13); + + s:=6+20*Sqrt(10); + TestQuanc8('Quanc8 3',-9,1000,x->1/Sqrt(Abs(x)),abserr,relerr,s,1e-3); + + f:=x->x/Sqrt(Sqr(Sqr(x))+16); + s:=ln(2)/2; + TestQuanc8('Quanc8 4',0,Sqrt(3),f,abserr,relerr,s,1e-12); + + f:=x->ArcCos(2*x); + s:=pi/2; + TestQuanc8('Quanc8 5',-0.5,0.5,f,abserr,relerr,s,1e-15); + + Writeln(nt:2,'. Quanc8 '); + nt+=1 + end; + {$endregion} + + {$region RKF45} + begin + // - + var p1:procedure(t:real; y,yp:array of real):=(t,y,yp)-> + begin + var alpha:=Sqr(ArcTan(1.0)); + var r:=y[0]*y[0]+y[1]*y[1]; r:=r*Sqrt(r)/alpha; + yp[0]:=y[2]; yp[1]:=y[3]; yp[2]:=-y[0]/r; yp[3]:=-y[1]/r + end; + // + var e:=0.25; + var y:=Arr(1.0-e,0.0,0.0,ArcTan(1)*Sqrt((1.0+e)/(1.0-e))); + var (abserr,relerr):=(0.0,0.3e-6); + var oL:=new RKF45(p1,y,abserr,relerr); + var (t,tb,th):=(0.0,12.0,0.5); + var t_out:=t; + var ss:=0.0; + repeat + oL.Solve(t,t_out); + ss+=t+oL.y[0]+y[1]; + case oL.flag of + -3,-2,-1,1,8: break; + 2:t_out:=t+th; + end + until t>=tb; + TestRKF45('RKF45 1',ss,140.749980780164,1e-12); + + p1:=(t,y,yp)->begin yp[0]:=y[0]/4*(1-y[0]/20) end; + // + (abserr,relerr):=(0.0,1e-6); + (t,tb,th):=(0.0,20.0,5.0); + y:=Arr(1.0); + t_out:=t; + oL:=new RKF45(p1,y,abserr,relerr); + ss:=0.0; + repeat + OL.Solve(t,t_out); + ss+=t+oL.y[0]+20/(1+19*Exp(-0.25*t)); + case oL.flag of + -3,-2,-1,1,8: break; + 2:t_out:=t+th + end + until t>=tb; + TestRKF45('RKF45 2',ss,136.941910731927,1e-12); + + (abserr,relerr):=(0.0,1e-6); + (t,tb,t_out):=(0.0,0.0,0.0); + var (te,ns):=(20.0,4); + y:=Arr(1.0); + oL:=new RKF45(p1,y,abserr,relerr); + oL.flag:=-1; + p1(t,y,oL.yp); + for var i:=1 to ns do begin + t:=((ns-i+1)*tb+(i-1)*te)/ns; + t_out:=((ns-i)*tb+i*te)/ns; + while oL.flag<0 do begin + oL.Solve(t,t_out); + ss+=t+oL.y[0]+20/(1+19*Exp(-0.25*t)); + case oL.flag of + -3,-1,1,8: break; + end + end; + oL.flag:=-2 + end; + TestRKF45('RKF45 3',ss,603.231676788451,1e-12); + + Writeln(nt:2,'. RKF45 '); + nt+=1 + end; + {$endregion} + + {$region RootsIsolation} + begin + var f:real->real:=x->(x+4.5)*(x+3)*(x-2)*(x-3.8); + var (a,b,h):=(-10.0,8.0,0.5); + TestRootsIsolation('RootsIsolation 1',f,a,b,h,Arr(-4.5,-3.0,2.0,3.8)); + + f:=t->sin(t)/(1+Sqr(Exp(t)))-0.1; + (a,b,h):=(-10,5,0.3); + var r:=Arr(-9.52495,-6.18307,-3.24191,0.27789,1.00272); // + TestRootsIsolation('RootsIsolation 2',f,a,b,h,r); + + Writeln(nt:2,'. RootsIsolation '); + nt+=1 + end; + {$endregion} + + {$region Spline} + begin + var f:real->real:=x->x*x*x; + var pp:=Partition(1.0,10.0,9).Select(x->new Point(x,f(x))).ToArray; + var Sp:=new Spline(pp); // . + TestSpline('Spline1-1',1,f,1e-15,Sp); // + TestSpline('Spline1-2',1.25,f,1e-15,Sp); // + TestSpline('Spline1-3',2.5,f,1e-15,Sp); // + TestSpline('Spline1-4',7.2,f,1e-15,Sp); // + TestSpline('Spline1-5',10,f,1e-5,Sp); // + + f:=x->Power(x,4); + pp:=Partition(1.0,10.0,9).Select(x->new Point(x,f(x))).ToArray; + Sp:=new Spline(pp); + TestSpline('Spline2-1',1.28,f,32,Sp); // 32% ... + TestSpline('Spline2-2',2.5,f,0.8,Sp); // 0.8% + TestSpline('Spline2-3',5.1,f,0.005,Sp); // 0.005% + TestSpline('Spline2-4',9.7,f,0.01,Sp); // 0.01% + + pp:=Partition(1.0,10.0,36).Select(x->new Point(x,f(x))).ToArray; + Sp:=new Spline(pp); + TestSpline('Spline3-1',1.28,f,0.03,Sp); // 0.03% + TestSpline('Spline3-2',1.1,f,0.24,Sp); // 0.24% + TestSpline('Spline3-3',1.03,f,0.18,Sp); // 0.18% + + f:=x->(3*x-8)/(8*x-4.1); + pp:=Partition(1.0,10.0,18).Select(x->new Point(x,f(x))).ToArray; + Sp:=new Spline(pp); + TestSpline('Spline4-1',1.1,f,4.8,Sp); // 4.8% + TestSpline('Spline4-2',2.6,f,5.8,Sp); // 5.8% + TestSpline('Spline4-3',5.9,f,0.001,Sp); // <0.001% + TestSpline('Spline4-4',9.9,f,0.001,Sp); // <0.001% + + Writeln(nt:2,'. Spline '); + nt+=1 + end; + {$endregion} + + {$region Svenn} + begin + var f:real->real:=x->Sqr(x-5); + TestSvenn('Svenn 1',f,0,1,5-1e-10,5+1e-10); + + f:=x->Abs((x-4)*(x+7)); + TestSvenn('Svenn 2',f,0,2,4-1e-10,4+1e-10); + + TestSvenn('Svenn 3',f,-3,1,-7-1e-10,-7+1e-10); + + f:=x->x*(x*x-2)-5; + TestSvenn('Svenn 4',f,0,1,2.0945514814,2.0945514816); + + Writeln(nt:2,'. Svenn '); + nt+=1 + end; + {$endregion} + + {$region Vector} + begin + var a:=new Vector(3,-4,1); + var b:=new Vector(-1,0,5); + var r:=(2*a-b).ModV; + TestVector1('Vector 1',r,Sqrt(122),1e-15); + + a:=new Vector(Arr(3.0,0.0,-4.0)); + var vr:=a.Ort; + TestVectorN('Vector 2',vr,new Vector(0.6,0,-0.8),1e-15); + + var pa:=Arr(2.0,-1.0,2.0); + var pb:=Arr(1.0,2.0,-1.0); + var pc:=Arr(3.0,2.0,1.0); + var BC:=new Vector(pb,pb); + var CA:=new Vector(pc,pa); + var CB:=new Vector(pc,pb); + vr:=(BC-2*CA).VP(CB); + TestVectorN('Vector 3',vr,new Vector(-12,8,12),1e-15); + + a:=new Vector(2,-1,1); + b:=new Vector(2,3,6); + r:=a*b/(a.ModV*b.ModV); + TestVector1('Vector 4',r,1/Sqrt(6),1e-15); + + pa:=Arr(7.0,3.0,4.0); + pb:=Arr(1.0,0.0,6.0); + pc:=Arr(4.0,5.0,-2.0); + a:=new Vector(pa,pb); + b:=new Vector(pA,pc); + r:=a.VP(b).ModV/2; + TestVector1('Vector 5',r,24.5,1e-15); + + Writeln(nt:2,'. Vector '); + nt+=1 + end; + {$endregion} + + {$region Zeroin} + begin + var f:real->real:=x->x*(x*x-2)-5; // + // e 2.094551481542326591482386540579... + var root:=(Power(5+Sqrt(643/27),1/3)+Power(5-Sqrt(643/27),1/3))/Power(2,1/3); + TestZeroin('Zeroin 1',2,3,f,root,1e-15); + + f:=x->Power((12-2*x)/(x-1),1/3)+Power((x-1)/(12-2*x),1/3)-2.5; + root:=2; + TestZeroin('Zeroin 2',1.01,3.5,f,root,1e-15); // =1 + + root:=97/17; + TestZeroin('Zeroin 3',3,5.99,f,root,1e-15); // =6 + + f:=x->3*Sin(x)+4*Cos(x)-5; + root:=2*ArcTan(1/3); + TestZeroin('Zeroin 4',-1,1,f,root,1e-8); + + Writeln(nt:2,'. Zeroin '); + nt+=1 + end; + {$endregion} + + Writeln('*** ***'); + Writeln('*** FMinN , ***'); + +end. \ No newline at end of file diff --git a/Samples/NumLibABC/PolRT1.pas b/Samples/NumLibABC/PolRT1.pas new file mode 100644 index 0000000..c97da73 --- /dev/null +++ b/Samples/NumLibABC/PolRT1.pas @@ -0,0 +1,10 @@ +uses NumLibABC; + +// +// +begin + var p:=new Polynom(-609, -283 ,294, -38, -5,1); + var oL:=new PolRt(p); + if oL.ier=0 then oL.Value.Println + else Writeln(': ier=',oL.ier); +end. diff --git a/Samples/NumLibABC/Polynom1.pas b/Samples/NumLibABC/Polynom1.pas new file mode 100644 index 0000000..52a2aa2 --- /dev/null +++ b/Samples/NumLibABC/Polynom1.pas @@ -0,0 +1,11 @@ +uses NumLibABC; + +// +begin + var u:=(new Polynom(2, -6, 0, 3.8, 0, 1)).Value(-7.16); // + Println(u); + + var t:=new Polynom(1, -7, 12, -3, -2); + var (p,q):=(t.PInt, t.PDif); // + p.PrintlnBeauty; q.PrintlnBeauty; +end. diff --git a/Samples/NumLibABC/Polynom2.pas b/Samples/NumLibABC/Polynom2.pas new file mode 100644 index 0000000..6b8a408 --- /dev/null +++ b/Samples/NumLibABC/Polynom2.pas @@ -0,0 +1,16 @@ +uses NumLibABC; + +// +begin + var a:=new Polynom(6.5,-4,2.12,1); + var b:=new Polynom(3,0,-3.8); + var c:=new Polynom(ArrGen(5,i->i*i+1.0)); + (-c +(a-2*b)*a+11.5*(1-b)).Println; // - + + a:=new Polynom(3,0,-72,12,0,-1,2); + b:=new Polynom(-1,0,2,1); + var (p,q):=a/b; + Print(''); p.PrintlnBeauty; + Print(''); b.PrintlnBeauty + +end. diff --git a/Samples/NumLibABC/Quanc8_1.pas b/Samples/NumLibABC/Quanc8_1.pas new file mode 100644 index 0000000..d749547 --- /dev/null +++ b/Samples/NumLibABC/Quanc8_1.pas @@ -0,0 +1,9 @@ +uses NumLibABC; + +// + +begin + var f:real->real := x->x=0?1.0:sin(x)/x; + var oL := new Quanc8(f,0,2,1e-7,0); + Writeln(oL.Value); +end. diff --git a/Samples/NumLibABC/RootsIsolation1.pas b/Samples/NumLibABC/RootsIsolation1.pas new file mode 100644 index 0000000..5e22591 --- /dev/null +++ b/Samples/NumLibABC/RootsIsolation1.pas @@ -0,0 +1,10 @@ +uses NumLibABC; + +// y(x)=0 +// +begin + var f:real->real:=t->sin(t)/(1+Sqr(Exp(t)))-0.1; + var (a,b,h):=(-10,5,0.5); + var oL:=new RootsIsolation(f,a,b,h); + Println(oL.Value) +end. diff --git a/Samples/NumLibABC/SLAU1.pas b/Samples/NumLibABC/SLAU1.pas new file mode 100644 index 0000000..3395d2f --- /dev/null +++ b/Samples/NumLibABC/SLAU1.pas @@ -0,0 +1,11 @@ +uses NumLibABC; + +// () +begin + var A:=new Matrix(3,3,2,3,-1,1,-2,1,1,0,2); + var B:=new Vector(9,3,2); + var cond:real; + var x:=A.SLAU(B,cond); + x.Println; + Writeln(' = ',cond) +end. diff --git a/Samples/NumLibABC/Spline1.pas b/Samples/NumLibABC/Spline1.pas new file mode 100644 index 0000000..255f767 --- /dev/null +++ b/Samples/NumLibABC/Spline1.pas @@ -0,0 +1,12 @@ +uses NumLibABC; + +// +begin + var f:real->real:=x->(3*x-8)/(8*x-4.1); + var pt:=Partition(1.0,10.0,18).Select(x->new Point(x,f(x))).ToArray; + var oL:=new Spline(pt); + var r:=oL.Value(4.8); + Writeln(' =4.8: ',r); + var (d1,d2):=oL.Diff(4.8); + Writeln(' 1- 2- : ',d1,' ',d2) +end. diff --git a/Samples/NumLibABC/Vector1.pas b/Samples/NumLibABC/Vector1.pas new file mode 100644 index 0000000..b11ad62 --- /dev/null +++ b/Samples/NumLibABC/Vector1.pas @@ -0,0 +1,20 @@ +uses NumLibABC; + +// +begin + // + var a:=new Vector(3,-4,1); + var b:=new Vector(-1,0,5); + Writeln((2*a-b).ModV); + + // + var p:=Arr(3.0,0.0,-4.0); + a:=new Vector(p); + a.Ort.Println; + + // + a:=new Vector(2,-1,1); + b:=new Vector(2,3,6); + Writeln(a*b/(a.ModV*b.ModV)) + +end. diff --git a/Samples/NumLibABC/Zeroin1.pas b/Samples/NumLibABC/Zeroin1.pas new file mode 100644 index 0000000..5840c73 --- /dev/null +++ b/Samples/NumLibABC/Zeroin1.pas @@ -0,0 +1,9 @@ +uses NumLibABC; + +// +begin + var f:real->real := t->sin(t)/(1+Sqr(Exp(t)))-0.1; + var oL:=new Zeroin(f,1e-12); + Println(oL.Value(-10,-9.5), oL.Value(-6.5,-6), oL.Value(-3.5,-3), + oL.Value(0,0.5),oL.Value(1,1.5)) +end. diff --git a/Samples/OMPSamples/Hanoi.pas b/Samples/OMPSamples/Hanoi.pas new file mode 100644 index 0000000..9b02ba6 --- /dev/null +++ b/Samples/OMPSamples/Hanoi.pas @@ -0,0 +1,35 @@ +//Демонстрация использования параллельных секций на примере задачи о ханойских башнях +// Вывод решения закомментирован, так как он занимает большую часть времени + +//параллельная процедура +procedure MovePiramidParallel(n: integer; f, t, w: integer); +begin + if n = 0 then + exit; + {$omp parallel sections} + begin + MovePiramidParallel(n - 1, f, w, t); + //writelnFormat('Переложить диск с {0} на {1}', f, t); + MovePiramidParallel(n - 1, w, t, f); + end; +end; +//последовательная процедура +procedure MovePiramid(n: integer; f, t, w: integer); +begin + if n = 0 then + exit; + MovePiramid(n - 1, f, w, t); + //writelnFormat('Переложить диск с {0} на {1}', f, t); + MovePiramid(n - 1, w, t, f); + +end; + +begin + var m0 := Milliseconds; + MovePiramid(27, 1, 2, 3); + writeln('Последовательное выполнение: ', Milliseconds - m0, 'ms'); + + var m1 := Milliseconds; + MovePiramidParallel(27, 1, 2, 3); + writeln('Параллельное выполнение: ', Milliseconds - m1, 'ms'); +end. \ No newline at end of file diff --git a/Samples/OMPSamples/MultMatrix.pas b/Samples/OMPSamples/MultMatrix.pas new file mode 100644 index 0000000..13796ff --- /dev/null +++ b/Samples/OMPSamples/MultMatrix.pas @@ -0,0 +1,37 @@ +uses Arrays; + +procedure ParallelMult(a,b,c: array [,] of real; n: integer); +begin + {$omp parallel for } + for var i:=0 to n-1 do + for var j:=0 to n-1 do + begin + c[i,j]:=0; + for var l:=0 to n-1 do + c[i,j]:=c[i,j]+a[i,l]*b[l,j]; + end; +end; + +procedure Mult(a,b,c: array [,] of real; n: integer); +begin + for var i:=0 to n-1 do + for var j:=0 to n-1 do + begin + c[i,j]:=0; + for var l:=0 to n-1 do + c[i,j]:=c[i,j]+a[i,l]*b[l,j]; + end; +end; + +const n = 400; + +begin + var a := Arrays.CreateRandomRealMatrix(n,n); + var b := Arrays.CreateRandomRealMatrix(n,n); + var c := new real[n,n]; + ParallelMult(a,b,c,n); + writeln('Параллельное перемножение матриц: ',Milliseconds,' миллисекунд'); + var d := Milliseconds; + Mult(a,b,c,n); + writeln('Последовательное перемножение матриц: ',Milliseconds-d,' миллисекунд'); +end. \ No newline at end of file diff --git a/Samples/OMPSamples/Mutual Lock.pas b/Samples/OMPSamples/Mutual Lock.pas new file mode 100644 index 0000000..03e1848 --- /dev/null +++ b/Samples/OMPSamples/Mutual Lock.pas @@ -0,0 +1,33 @@ +// Демонстрация использования критических секций и возможных взаимоблокировок +begin + {$omp parallel sections} + begin + begin + WriteLn('Thread 1 started'); + {$omp critical a} + begin + Writeln('Lock a set by 1 thread'); + //ReadLn; + {$omp critical b} + begin + Writeln('Lock b set by 1 thread'); + end; + end; + WriteLn('Thread 1 finished'); + end; + begin + WriteLn('Thread 2 started'); + {$omp critical b} + begin + Writeln('Lock b set by 2 thread'); + //ReadLn; + {$omp critical a} + begin + Writeln('Lock a set by 2 thread'); + end; + end; + WriteLn('Thread 2 finished'); + end; + end; + Writeln('Program finished without mutual lock!'); +end. \ No newline at end of file diff --git a/Samples/OMPSamples/QuickSort.pas b/Samples/OMPSamples/QuickSort.pas new file mode 100644 index 0000000..ca6541c --- /dev/null +++ b/Samples/OMPSamples/QuickSort.pas @@ -0,0 +1,96 @@ +//Демонстрация использования параллельных секций на примере быстрой сортировки +var + a: array of integer; + +var + b: array of integer; + +// Partition - разделение A[l]..A[r] на части A[l]..A[q] <= A[q+1]..A[r] +function Partition(a: array of integer; l, r: integer): integer; +begin + var i := l - 1; + var j := r + 1; + var x := A[l]; + while True do + begin + repeat + i += 1; + until A[i] >= x; + repeat + j -= 1; + until A[j] <= x; + if i < j then + Swap(A[i], A[j]) + else + begin + Result := j; + exit; + end; + end; +end; + + // Параллельная cортировка частей +procedure Sort(A: array of integer; l, r: integer); +begin + if l >= r then + exit; + var j := Partition(A, l, r); + {$omp parallel sections} + begin + Sort(A, l, j); + Sort(A, j + 1, r); + end; +end; +// Параллельная сортировка +procedure QuickSortParrallel(A: array of integer); +begin + Sort(A, 0, a.Length - 1) +end; + +//Последовательная Сортировка частей +procedure SortSeq(a: array of integer; l, r: integer); +begin + if l >= r then + exit; + var j := Partition(A, l, r); + SortSeq(A, l, j); + SortSeq(A, j + 1, r); +end; +//Последовательная сортировка +procedure QuickSortSeq(A: array of integer); +begin + SortSeq(A, 0, a.Length - 1) +end; + //заполнение массивов равными значениями для обоих сортировок +procedure FillRandArr(A, B: array of integer); +begin + Randomize; + for var i := 0 to A.Length - 1 do + begin + a[i] := Random(1000); + b[i] := a[i]; + end; +end; + //Вывод массива +procedure printArr(A: array of integer); +begin + Randomize; + for var i := 0 to A.Length - 1 do + writeln(a[i]); +end; + +begin + + SetLength(a, 10000000); + SetLength(b, 10000000); + + FillRandArr(a, b); + var m1 := Milliseconds; + QuickSortSeq(B); + writeln('Последовательное выполнение: ', Milliseconds - m1, 'ms'); + + var m0 := Milliseconds; + QuickSortParrallel(a); + writeln('Параллельное выполнение: ', Milliseconds - m0, 'ms'); + +end. \ No newline at end of file diff --git a/Samples/OMPSamples/SqrSinArrays.pas b/Samples/OMPSamples/SqrSinArrays.pas new file mode 100644 index 0000000..3c7de0f --- /dev/null +++ b/Samples/OMPSamples/SqrSinArrays.pas @@ -0,0 +1,47 @@ +// демонстрация работы параллельного for +//заполнение массива +procedure FillRandArr(A: array of real); +begin + Randomize; + for var i := 0 to A.Length - 1 do + a[i] := Random(1000); +end; + // вывод массива +procedure printArr(A: array of real); +begin + for var i := 0 to A.Length - 1 do + writeln(a[i]); +end; +// Последовательное вычисление квадратов синусов +procedure SqrSinArr(A: array of real; var C: array of real); +begin + + for var i := 0 to A.Length - 1 do + C[i] := sqr(sin(A[i])); +end; +// Параллельное вычисление квадратов синусов +procedure SqrSinArrParallel(A: array of real; var C: array of real); +begin + + {$omp parallel for} + for var i := 0 to A.Length - 1 do + C[i] := sqr(sin(A[i])); +end; + +begin + var A: array of real; + var C: array of real; + SetLength(A, 10000000); + SetLength(C, A.Length); + FillRandArr(A); + + var m0 := Milliseconds; + SqrSinArrParallel(A, C); + + writeln('Параллельное выполнение: ', Milliseconds - m0, 'ms'); + + m0 := Milliseconds; + SqrSinArr(A, C); + writeln('Последовательное выполнение: ', Milliseconds - m0, 'ms'); + +end. \ No newline at end of file diff --git a/Samples/OMPSamples/SumOfPrime.pas b/Samples/OMPSamples/SumOfPrime.pas new file mode 100644 index 0000000..ef2c2e6 --- /dev/null +++ b/Samples/OMPSamples/SumOfPrime.pas @@ -0,0 +1,44 @@ +// Демонстрация работы директивы parallel for c опцией редукции +// на примере вычисления суммы простых чисел среди первых n +// натуральных чисел + +// проверка на простоту числа n +function IsPrime(n:integer):boolean; +begin + result:=false; + for var i:integer:=2 to round(sqrt(n)) do + if n mod i = 0 then + exit; + result:=true; +end; +//Последовательное вычисление суммы простых чисел +function SumOfPrimesSeq(n:integer):int64; +begin + var sum:int64:=0; + for var i:integer:=2 to n do + if IsPrime(i) then + sum:=sum+i; + result:=sum; +end; +//Параллельное вычисление суммы простых чисел +function SumOfPrimesPar(n:integer):int64; +begin + var sum:int64:=0; + {$omp parallel for reduction(+:sum)} + for var i:integer:=2 to n do + if IsPrime(i) then + sum:=sum+i; + result:=sum; +end; + +const Count = 5000000; + +begin + var t := Milliseconds; + WriteLn(SumOfPrimesSeq(Count)); + Writeln('Seq time = ', Milliseconds - t); + + t := Milliseconds; + WriteLn(SumOfPrimesPar(Count)); + Writeln('Par time = ', Milliseconds - t); +end. \ No newline at end of file diff --git a/Samples/OMPSamples/Write Critical.pas b/Samples/OMPSamples/Write Critical.pas new file mode 100644 index 0000000..c850aa8 --- /dev/null +++ b/Samples/OMPSamples/Write Critical.pas @@ -0,0 +1,27 @@ +// Вывод в параллельной секции без использования критических секций +// и с их использованием. В первом случае из-за параллельного доступа +// к разделяемому ресурсу возможно, что строки будут выводиться +// на одной строке, и в произвольно порядке. Во втором случае такого не будет. +begin + {$omp parallel sections} + begin + begin + WriteLn('Thread 1 started'); + end; + begin + WriteLn('Thread 2 started'); + end; + end; + + {$omp parallel sections} + begin + begin + {$omp critical a} + WriteLn('Thread 1 started'); + end; + begin + {$omp critical a} + WriteLn('Thread 2 started'); + end; + end; +end. \ No newline at end of file diff --git a/Samples/Other/SpeedTests/CalculationsGlobalLocal/BlockVars.pas b/Samples/Other/SpeedTests/CalculationsGlobalLocal/BlockVars.pas new file mode 100644 index 0000000..4f8bcf2 --- /dev/null +++ b/Samples/Other/SpeedTests/CalculationsGlobalLocal/BlockVars.pas @@ -0,0 +1,15 @@ +// Сравнение скорости работы глобальных и внутриблочных переменных. +// См. также файл GlobalVars.pas +uses Utils; + +begin + var s := 0.0; + var i: real := 1; + while i<10000000 do + begin + s += 1/i; + i += 1; + end; + writeln(s); + writeln('Время расчета = ',Milliseconds/1000,' с'); +end. diff --git a/Samples/Other/SpeedTests/CalculationsGlobalLocal/GlobalVars.pas b/Samples/Other/SpeedTests/CalculationsGlobalLocal/GlobalVars.pas new file mode 100644 index 0000000..6cd714a --- /dev/null +++ b/Samples/Other/SpeedTests/CalculationsGlobalLocal/GlobalVars.pas @@ -0,0 +1,17 @@ +// Сравнение скорости работы глобальных и внутриблочных переменных. +// См. также файл BlockVars.pas +uses Utils; + +var + s: real := 0; + i: real := 1; + +begin + while i<10000000 do + begin + s += 1/i; + i += 1; + end; + writeln(s); + writeln('Время расчета = ',Milliseconds/1000,' с'); +end. diff --git a/Samples/Other/SpeedTests/Milli.pas b/Samples/Other/SpeedTests/Milli.pas new file mode 100644 index 0000000..92f5c8d --- /dev/null +++ b/Samples/Other/SpeedTests/Milli.pas @@ -0,0 +1,13 @@ +// Демонстрация функции Milliseconds +uses Utils; + +const n = 5000; + +var a: array [1..n,1..n] of real; + +begin + for var i:=1 to n do + for var j:=1 to n do + a[i,j] := 1; + writeln(Milliseconds/1000); +end. diff --git a/Samples/Other/UnmanagedGraphics/MessageBox.pas b/Samples/Other/UnmanagedGraphics/MessageBox.pas new file mode 100644 index 0000000..df79987 --- /dev/null +++ b/Samples/Other/UnmanagedGraphics/MessageBox.pas @@ -0,0 +1,6 @@ +function MessageBox(h:integer;m,c:string;t:integer):integer; +external 'User32.dll' name 'MessageBox'; + +begin + MessageBox(0,'Привет!','Сообщение',0); +end. \ No newline at end of file diff --git a/Samples/StandardUnits/CRT/Bill.pas b/Samples/StandardUnits/CRT/Bill.pas new file mode 100644 index 0000000..91f57c0 --- /dev/null +++ b/Samples/StandardUnits/CRT/Bill.pas @@ -0,0 +1,145 @@ +// Отражение шарика от стенок. Консольный режим +// Для запуска программы используйте Shift+F9 !!! +uses CRT; + +const +// Ширина поля + w = 80; +// Высота поля + h = 24; + +var +/// Координаты шарика + ax,ay: integer; +/// Вектор перемещения шарика + vx,vy: integer; +/// Массив клеток поля + a: array [1..w,1..h] of char; + +/// Очистка массива a +procedure CleanA; +begin + for var j := 1 to h do + for var i := 1 to w do + A[i,j] := ' ' +end; + +/// Создание горизонтальной стены +procedure HorizWall(x,y,L: integer); +begin + for var i := x to x+L-1 do + A[i,y] := '*' +end; + +/// Создание вертикальной стены +procedure VertWall(x,y,L: integer); +begin + for var j := y to y+L-1 do + A[x,j] := '*' +end; + +/// Заполнение поля стенами +procedure Fill; +begin + CleanA; + HorizWall(1,1,w); + HorizWall(1,h,w); + VertWall(1,1,h); + VertWall(w,1,h); + + HorizWall(49,9,31); + HorizWall(49,14,31); +end; + +/// Перерисовка экрана +procedure DrawScreen; +begin + TextColor(White); + ClrScr; + for var j := 1 to h do + for var i := 1 to w do + write(A[i,j]) +end; + +/// Возвращает True, если на пути шарика препятствие +function FilledInFront: boolean; +begin + Result := (A[ax+vx,ay]<>' ') or (A[ax,ay+vy]<>' ') or (A[ax+vx,ay+vy]<>' ') +end; + +/// Меняет направление шарика +procedure ChangeDirection; +begin + if A[ax+vx,ay]<>' ' then + vx := -vx; + if A[ax,ay+vy]<>' ' then + vy := -vy; + if (A[ax+vx,ay]=' ') and (A[ax,ay+vy]=' ') and (A[ax+vx,ay+vy]<>' ') then + begin + vx := -vx; + vy := -vy + end; + Sleep(10); +end; + +/// Рисует шарик +procedure ShowBall; +begin + GotoXY(ax,ay); + write('B'); +end; + +/// Стирает шарик +procedure HideBall; +begin + GotoXY(ax,ay); + write(' '); +end; + +/// Устанавливает вектор движение шарика +procedure SetBallCoords(x,y: integer); +begin + ax := x; + ay := y +end; + +/// Устанавливает координаты шарика +procedure SetBallVeloc(vx0,vy0: integer); +begin + vx := vx0; + vy := vy0 +end; + +/// Перемещает шарик к позиции (x,y) +procedure MoveTo(x,y: integer); +begin + HideBall; + SetBallCoords(x,y); + ShowBall +end; + +/// Перемещает шарик на вектор (dx,dy) +procedure MoveOn(dx,dy: integer); +begin + MoveTo(ax+dx,ay+dy); +end; + +BEGIN + SetWindowTitle('Биллиард (ностальгия по CRT)'); + HideCursor; + + Fill; + DrawScreen; + + SetBallCoords(70,13); + SetBallVeloc(1,1); + TextColor(Yellow); + ShowBall; + + repeat + Delay(20); + if FilledInFront then + ChangeDirection; + MoveOn(vx,vy); + until KeyPressed; +END. diff --git a/Samples/StandardUnits/CRT/CPaint.pas b/Samples/StandardUnits/CRT/CPaint.pas new file mode 100644 index 0000000..5ea9b40 --- /dev/null +++ b/Samples/StandardUnits/CRT/CPaint.pas @@ -0,0 +1,70 @@ +// Рисование курсором в консольном окне +// Иллюстрация GotoXY, TextBackGround +// Для запуска программы используйте Shift+F9 !!! +uses Crt; + +var + draw: boolean; + color: integer; + +function IsCoordCorrect(x,y: integer): boolean; +begin + Result := (x in [1..WindowWidth]) and (y in [1..WindowHeight]); +end; + +procedure MyGotoXY(x,y: integer); +begin + if not IsCoordCorrect(x,y) then + exit; + GotoXY(x,y); +end; + +procedure DrawSymbol(x,y: integer; c: char); +begin + if not IsCoordCorrect(x,y) then + exit; + GotoXY(x,y); + write(c); + GotoXY(x,y); +end; + +begin + draw := True; + color := Green; + ClrScr; + SetWindowTitle('Рисование курсором (Esc-выход, Num 5 - изменение цвета)'); + TextBackGround(color); + GotoXY(WindowWidth div 2,WindowHeight div 2); + var c: char; + repeat + c := ReadKey; + if c=#32 then + draw := not draw; + if c=#0 then + begin + c := ReadKey; + case c of + // Изменение цвета по клавише Num 5 + {5} #12: begin + color := color + 1; + if color=16 then + color := 0; + TextBackGround(color); + end; + {RU}#33: MyGotoXY(WhereX+1,WhereY-1); + {RD}#34: MyGotoXY(WhereX+1,WhereY+1); + {LD}#35: MyGotoXY(WhereX-1,WhereY+1); + {LU}#36: MyGotoXY(WhereX-1,WhereY-1); + {L} #37: MyGotoXY(WhereX-1,WhereY); + {U} #38: MyGotoXY(WhereX,WhereY-1); + {R} #39: MyGotoXY(WhereX+1,WhereY); + {D} #40: MyGotoXY(WhereX,WhereY+1); + #67: ClrScr; + end; + if draw then + DrawSymbol(WhereX, WhereY,' '); + end; + until c=#27; + TextBackGround(Black); + GotoXY(1,25); +end. diff --git a/Samples/StandardUnits/CRT/CRTColors.pas b/Samples/StandardUnits/CRT/CRTColors.pas new file mode 100644 index 0000000..5b205c8 --- /dev/null +++ b/Samples/StandardUnits/CRT/CRTColors.pas @@ -0,0 +1,20 @@ +// Стандартные CRT-цвета +// Для запуска программы используйте Shift+F9 !!! +uses CRT; + +begin + SetWindowTitle('Стандартные CRT-цвета'); + for var i:=0 to 15 do + begin + TextBackground(i); + for var j:=0 to 15 do + begin + TextColor(j); + write(' CRT'); + end; + writeln; + end; + HideCursor; + TextBackground(0); + TextColor(0); +end. diff --git a/Samples/StandardUnits/CRT/SimpleTextEditor.pas b/Samples/StandardUnits/CRT/SimpleTextEditor.pas new file mode 100644 index 0000000..b8dc321 --- /dev/null +++ b/Samples/StandardUnits/CRT/SimpleTextEditor.pas @@ -0,0 +1,17 @@ +// Простейший текстовый редактор +// Для запуска программы используйте Shift+F9 !!! +uses CRT; + +begin + SetWindowTitle('Текстовый редактор (Enter - новая строка, Esc - выход)'); + clrScr; + repeat + var c := ReadKey; + case c of + #13: writeln; + #27: break; + #32..#255: write(c); + #0: c := ReadKey; + end; + until false; +end. diff --git a/Samples/StandardUnits/FormsABC/CalcIntegral.pas b/Samples/StandardUnits/FormsABC/CalcIntegral.pas new file mode 100644 index 0000000..d73a20b --- /dev/null +++ b/Samples/StandardUnits/FormsABC/CalcIntegral.pas @@ -0,0 +1,64 @@ +uses FormsABC; + +type Fun = function (x: real): real; + +var funs: array of Fun := (sin,cos,sqr); + +function CalcIntegral(a,b: real; N: integer; f: Fun): real; +begin + Result := 0; + var x := a; + var h := (b-a)/N; + for var i:=0 to N-1 do + begin + Result += f(x); + x += h; + end; + Result *= h; +end; + +var + a := new RealField('a:'); + f1 := new FlowBreak; + b := new RealField('b:'); + f2 := new FlowBreak; + N := new IntegerField('N:'); + f3 := new FlowBreak; + tl := new TextLabel('Функция: '); + f4 := new FlowBreak; + cb := new ComboBox; + f5 := new FlowBreak(50); + s1 := new Space(20); + ok := new Button('Вычислить'); + tb: TextBox; + +procedure MyClick; +begin + var f := funs[cb.SelectedIndex]; + var res := CalcIntegral(a.Value,b.Value,N.Value,f); + tb.AddLine(Format('Интеграл({0},{1},{2},{3}) = {4}',a.Value,b.Value,N.Value,cb.SelectedValue,res.ToString)); +end; + +procedure InitControls; +begin + MainForm.Title := 'Вычисление определенного интеграла'; + MainForm.SetSize(500,350); + MainForm.CenterOnScreen; + b.Value := 1; + N.Value := 10; + cb.Items.Add('sin'); + cb.Items.Add('cos'); + cb.Items.Add('x^2'); + cb.SelectedIndex := 0; + ok.Click += MyClick; + mainPanel.Dock := DockStyle.Left; + mainPanel.Width := 150; + + ParentControl := MainForm; + tb := new TextBox; + tb.Dock := DockStyle.Fill; +end; + +begin + InitControls; +end. \ No newline at end of file diff --git a/Samples/StandardUnits/FormsABC/PaintBoxDraw.pas b/Samples/StandardUnits/FormsABC/PaintBoxDraw.pas new file mode 100644 index 0000000..3f5e162 --- /dev/null +++ b/Samples/StandardUnits/FormsABC/PaintBoxDraw.pas @@ -0,0 +1,76 @@ +uses + System.Drawing, + System.Windows.Forms, + System.Threading, + FormsABC; + +procedure DrawMandelbrot(g: Graphics; w,h: integer; scale: real; dx,dy: integer); +const max = 10; +begin + for var ix:=0 to w-1 do + for var iy:=0 to h-1 do + begin + var x := 0.0; + var y := 0.0; + var cx := scale * (ix - dx); + var cy := scale * (iy - dy); + var i := 1; + while i<255 do + begin + var x1 := x*x-y*y+cx; + var y1 := 2*x*y+cy; + x := x1; + y := y1; + if (abs(x)>max) and (abs(y)>max) then break; + i += 1; + end; + if i>=255 then + g.FillRectangle(Brushes.Red,ix,iy,1,1) + else + g.FillRectangle(new SolidBrush(Color.FromArgb(255,255-i,255-i)),ix,iy,1,1) + end; +end; + +var + Scale := new RealField('Масштаб: '); + l1 := new FlowBreak; + dx := new IntegerField('dx: '); + l2 := new FlowBreak; + dy := new IntegerField('dy: '); + l3 := new FlowBreak(20); + b := new Button(' Нарисовать '); + p: PaintBox; + + +procedure Draw; +begin + var g := p.Graphics; + DrawMandelbrot(g,p.Width,p.Height,Scale.Value,dx.Value,dy.Value); + p.Invalidate; +end; + +procedure My(o: Object); +begin + Draw; +end; + +procedure Click; +begin + ThreadPool.QueueUserWorkItem(My); +end; + +begin + MainForm.Title := 'Множество Мандельброта'; + MainForm.SetSize(700, 600); + MainPanel.Dock := Dockstyle.Left; + MainPanel.Width := 120; + Scale.Value := 0.0035; + dx.Value := 430; + dy.Value := 280; + b.Click += Click; + + ParentControl := MainForm; + p := new PaintBox; + p.Dock := DockStyle.Fill; + ThreadPool.QueueUserWorkItem(My); +end. \ No newline at end of file diff --git a/Samples/StandardUnits/FormsABC/f0.pas b/Samples/StandardUnits/FormsABC/f0.pas new file mode 100644 index 0000000..9d99a29 --- /dev/null +++ b/Samples/StandardUnits/FormsABC/f0.pas @@ -0,0 +1,24 @@ +uses FormsABC; + +var + a,b,sum,prod: IntegerField; + d: Button; + +procedure MyClick; +begin + sum.Value := a.Value + b.Value; + prod.Value := a.Value * b.Value; +end; + +begin + a := new IntegerField('a:'); + b := new IntegerField('b:'); + LineBreak; + sum := new IntegerField('Сумма:',220); + LineBreak; + prod := new IntegerField('Произведение:',220); + LineBreak; + EmptyLine(20); + d := new Button('Вычислить'); + d.Click += MyClick; +end. \ No newline at end of file diff --git a/Samples/StandardUnits/FormsABC/f0_MV.pas b/Samples/StandardUnits/FormsABC/f0_MV.pas new file mode 100644 index 0000000..0c38882 --- /dev/null +++ b/Samples/StandardUnits/FormsABC/f0_MV.pas @@ -0,0 +1,40 @@ +uses FormsABC; + +type + Model = class + class procedure Calc(x,y: integer; var sum,prod: integer); + begin + sum := x + y; + prod := x * y; + end; + end; + + View = class + private + a,b,sum,prod: IntegerField; + procedure MyClick; + begin + var s,p: integer; + Model.Calc(a.Value,b.Value,s,p); + sum.Value := s; + prod.Value := p; + end; + public + constructor Create; + begin + a := new IntegerField('a:'); + b := new IntegerField('b:'); + LineBreak; + sum := new IntegerField('Сумма:',220); + LineBreak; + prod := new IntegerField('Произведение:',220); + LineBreak; + EmptyLine(20); + var d := new Button('Вычислить'); + d.Click += MyClick; + end; + end; + +begin + var v := new View; +end. \ No newline at end of file diff --git a/Samples/StandardUnits/FormsABC/f0_class.pas b/Samples/StandardUnits/FormsABC/f0_class.pas new file mode 100644 index 0000000..fc46960 --- /dev/null +++ b/Samples/StandardUnits/FormsABC/f0_class.pas @@ -0,0 +1,30 @@ +uses FormsABC; + +type + View = class + private + a,b,sum,prod: IntegerField; + procedure MyClick; + begin + sum.Value := a.Value + b.Value; + prod.Value := a.Value * b.Value; + end; + public + constructor Create; + begin + a := new IntegerField('a:'); + b := new IntegerField('b:'); + LineBreak; + sum := new IntegerField('Сумма:',220); + LineBreak; + prod := new IntegerField('Произведение:',220); + LineBreak; + EmptyLine(20); + var d := new Button('Вычислить'); + d.Click += MyClick; + end; + end; + +begin + var v := new View; +end. \ No newline at end of file diff --git a/Samples/StandardUnits/Timers/Timer1.pas b/Samples/StandardUnits/Timers/Timer1.pas new file mode 100644 index 0000000..fadc433 --- /dev/null +++ b/Samples/StandardUnits/Timers/Timer1.pas @@ -0,0 +1,21 @@ +Uses Timers; + +var t1, t2: Timer; + +procedure OnTimer1; +begin + Write('!'); +end; + +procedure OnTimer2; +begin + Write('?'); +end; + +begin + t1 := new Timer(200, OnTimer1); + t2 := new Timer(300, OnTimer2); + t1.Start; + t2.Start; + Sleep(10000); +end. \ No newline at end of file diff --git a/Samples/StandardUnits/Timers/Timer2.pas b/Samples/StandardUnits/Timers/Timer2.pas new file mode 100644 index 0000000..073c3a6 --- /dev/null +++ b/Samples/StandardUnits/Timers/Timer2.pas @@ -0,0 +1,59 @@ +// "Собачка". Иллюстрация использования таймера. +uses GraphABC, Timers; + +var + t: Timer; + xx,yy,px,py: integer; + +procedure Draw; +begin + FillCircle(xx,yy,11); +end; + +procedure Show; +begin + Brush.Color := clBlack; + Draw; +end; + +procedure Hide; +begin + Brush.Color := clWhite; + Draw; +end; + +procedure Move(x,y: integer); +begin + Hide; + xx := x; + yy := y; + show; +end; + +procedure Timer1; +begin + if (xx<>px) or (yy<>py) then + begin + var t := 1/10; + var newx := round((1-t)*xx+t*px); + var newy := round((1-t)*yy+t*py); + Move(newx,newy); + end; +end; + +procedure MouseMove(x,y,mb: integer); +begin + px := x; py := y; +end; + +begin + SetWindowCaption('"Собачка"'); + SetSmoothingOff; + OnMouseMove:=MouseMove; + xx := 100; yy := 100; + px := xx; py := yy; + Show; + Timer1; + t := new Timer(20,Timer1); + t.Start; +end.