Advertisement
Guest User

Untitled

a guest
Jul 25th, 2017
118
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 135.71 KB | None | 0 0
  1. // Copyright (c) Ivan Bondarev, Stanislav Mihalkovich (for details please see \doc\copyright.txt)
  2. // This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
  3.  
  4. ///Модуль предоставляет константы, типы, процедуры, функции и классы для рисования в графическом окне
  5. //unit GraphABC;
  6. library _GraphABC;
  7.  
  8. //ne udaljat, IB 7.10.08
  9. //с дополнениями 2015.01 (mabr)
  10. {$apptype windows}
  11. {$reference '%GAC%\System.Windows.Forms.dll'}
  12. {$reference '%GAC%\System.Drawing.dll'}
  13. {$gendoc true}
  14.  
  15. interface
  16.  
  17. uses
  18.   System,
  19.   System.Drawing,
  20.   System.Windows.Forms,
  21.   System.Drawing.Drawing2D;
  22.  
  23. type
  24. /// Тип цвета
  25.   Color = System.Drawing.Color;
  26. /// Тип стиля штриховки кисти
  27.   HatchStyle = System.Drawing.Drawing2D.HatchStyle;
  28. /// Тип стиля штриховки пера
  29.   DashStyle = System.Drawing.Drawing2D.DashStyle;
  30. /// Тип исключения GraphABC  
  31.   GraphABCException = class(Exception) end;
  32. /// Тип точки
  33.   Point = System.Drawing.Point;
  34.  
  35. var
  36.   clMoneyGreen: Color;
  37.  
  38. const
  39.   // Default graph window size
  40.   defaultWindowWidth = 640;
  41.   defaultWindowHeight = 480;
  42.  
  43.   // Color constants
  44.   clAquamarine = Color.Aquamarine;             clAzure = Color.Azure;                    
  45.   clBeige = Color.Beige;                       clBisque = Color.Bisque;                  
  46.   clBlack = Color.Black;                       clBlanchedAlmond = Color.BlanchedAlmond;  
  47.   clBlue = Color.Blue;                         clBlueViolet = Color.BlueViolet;          
  48.   clBrown = Color.Brown;                       clBurlyWood = Color.BurlyWood;            
  49.   clCadetBlue = Color.CadetBlue;               clChartreuse = Color.Chartreuse;          
  50.   clChocolate = Color.Chocolate;               clCoral = Color.Coral;                    
  51.   clCornflowerBlue = Color.CornflowerBlue;     clCornsilk = Color.Cornsilk;              
  52.   clCrimson = Color.Crimson;                   clCyan = Color.Cyan;                      
  53.   clDarkBlue = Color.DarkBlue;                 clDarkCyan = Color.DarkCyan;              
  54.   clDarkGoldenrod = Color.DarkGoldenrod;       clDarkGray = Color.DarkGray;              
  55.   clDarkGreen = Color.DarkGreen;               clDarkKhaki = Color.DarkKhaki;            
  56.   clDarkMagenta = Color.DarkMagenta;           clDarkOliveGreen = Color.DarkOliveGreen;  
  57.   clDarkOrange = Color.DarkOrange;             clDarkOrchid = Color.DarkOrchid;          
  58.   clDarkRed = Color.DarkRed;                   clDarkTurquoise = Color.DarkTurquoise;    
  59.   clDarkSeaGreen = Color.DarkSeaGreen;         clDarkSlateBlue = Color.DarkSlateBlue;    
  60.   clDarkSlateGray = Color.DarkSlateGray;       clDarkViolet = Color.DarkViolet;          
  61.   clDeepPink = Color.DeepPink;                 clDarkSalmon = Color.DarkSalmon;          
  62.   clDeepSkyBlue = Color.DeepSkyBlue;           clDimGray = Color.DimGray;                
  63.   clDodgerBlue = Color.DodgerBlue;             clFirebrick = Color.Firebrick;            
  64.   clFloralWhite = Color.FloralWhite;           clForestGreen = Color.ForestGreen;        
  65.   clFuchsia = Color.Fuchsia;                   clGainsboro = Color.Gainsboro;            
  66.   clGhostWhite = Color.GhostWhite;             clGold = Color.Gold;                      
  67.   clGoldenrod = Color.Goldenrod;               clGray = Color.Gray;                      
  68.   clGreen = Color.Green;                       clGreenYellow = Color.GreenYellow;        
  69.   clHoneydew = Color.Honeydew;                 clHotPink = Color.HotPink;                
  70.   clIndianRed = Color.IndianRed;               clIndigo = Color.Indigo;                  
  71.   clIvory = Color.Ivory;                       clKhaki = Color.Khaki;                    
  72.   clLavender = Color.Lavender;                 clLavenderBlush = Color.LavenderBlush;    
  73.   clLawnGreen = Color.LawnGreen;               clLemonChiffon = Color.LemonChiffon;      
  74.   clLightBlue = Color.LightBlue;               clLightCoral = Color.LightCoral;          
  75.   clLightCyan = Color.LightCyan;               clLightGray = Color.LightGray;            
  76.   clLightGreen = Color.LightGreen;             clLightGoldenrodYellow = Color.LightGoldenrodYellow;
  77.   clLightPink = Color.LightPink;               clLightSalmon = Color.LightSalmon;        
  78.   clLightSeaGreen = Color.LightSeaGreen;       clLightSkyBlue = Color.LightSkyBlue;      
  79.   clLightSlateGray = Color.LightSlateGray;     clLightSteelBlue = Color.LightSteelBlue;  
  80.   clLightYellow = Color.LightYellow;           clLime = Color.Lime;                      
  81.   clLimeGreen = Color.LimeGreen;               clLinen = Color.Linen;                    
  82.   clMagenta = Color.Magenta;                   clMaroon = Color.Maroon;                  
  83.   clMediumBlue = Color.MediumBlue;             clMediumOrchid = Color.MediumOrchid;      
  84.   clMediumAquamarine = Color.MediumAquamarine; clMediumPurple = Color.MediumPurple;      
  85.   clMediumSeaGreen = Color.MediumSeaGreen;     clMediumSlateBlue = Color.MediumSlateBlue;
  86.   clPlum = Color.Plum;                         clMistyRose = Color.MistyRose;            
  87.   clNavy = Color.Navy;                         clMidnightBlue = Color.MidnightBlue;      
  88.   clMintCream = Color.MintCream;               clMediumSpringGreen = Color.MediumSpringGreen;
  89.   clMoccasin = Color.Moccasin;                 clNavajoWhite = Color.NavajoWhite;        
  90.   clMediumTurquoise = Color.MediumTurquoise;   clOldLace = Color.OldLace;                
  91.   clOlive = Color.Olive;                       clOliveDrab = Color.OliveDrab;            
  92.   clOrange = Color.Orange;                     clOrangeRed = Color.OrangeRed;            
  93.   clOrchid = Color.Orchid;                     clPaleGoldenrod = Color.PaleGoldenrod;    
  94.   clPaleGreen = Color.PaleGreen;               clPaleTurquoise = Color.PaleTurquoise;    
  95.   clPaleVioletRed = Color.PaleVioletRed;       clPapayaWhip = Color.PapayaWhip;          
  96.   clPeachPuff = Color.PeachPuff;               clPeru = Color.Peru;                      
  97.   clPink = Color.Pink;                         clMediumVioletRed = Color.MediumVioletRed;
  98.   clPowderBlue = Color.PowderBlue;             clPurple = Color.Purple;                  
  99.   clRed = Color.Red;                           clRosyBrown = Color.RosyBrown;            
  100.   clRoyalBlue = Color.RoyalBlue;               clSaddleBrown = Color.SaddleBrown;        
  101.   clSalmon = Color.Salmon;                     clSandyBrown = Color.SandyBrown;          
  102.   clSeaGreen = Color.SeaGreen;                 clSeaShell = Color.SeaShell;              
  103.   clSienna = Color.Sienna;                     clSilver = Color.Silver;                  
  104.   clSkyBlue = Color.SkyBlue;                   clSlateBlue = Color.SlateBlue;            
  105.   clSlateGray = Color.SlateGray;               clSnow = Color.Snow;                      
  106.   clSpringGreen = Color.SpringGreen;           clSteelBlue = Color.SteelBlue;            
  107.   clTan = Color.Tan;                           clTeal = Color.Teal;                      
  108.   clThistle = Color.Thistle;                   clTomato = Color.Tomato;                  
  109.   clTransparent = Color.Transparent;           clTurquoise = Color.Turquoise;            
  110.   clViolet = Color.Violet;                     clWheat = Color.Wheat;                    
  111.   clWhite = Color.White;                       clWhiteSmoke = Color.WhiteSmoke;          
  112.   clYellow = Color.Yellow;                     clYellowGreen = Color.YellowGreen;
  113.  
  114. // Virtual Key Codes
  115.   VK_Back = 8;              VK_Tab = 9;
  116.   VK_LineFeed = 10;         VK_Enter = 13;
  117.   VK_Return = 13;           VK_ShiftKey = 16;           VK_ControlKey = 17;
  118.   VK_Menu = 18;             VK_Pause = 19;              VK_CapsLock = 20;
  119.   VK_Capital = 20;
  120.   VK_Escape = 27;
  121.   VK_Space = 32;
  122.   VK_Prior = 33;            VK_PageUp = 33;             VK_PageDown = 34;
  123.   VK_Next = 34;             VK_End = 35;                VK_Home = 36;
  124.   VK_Left = 37;             VK_Up = 38;                 VK_Right = 39;
  125.   VK_Down = 40;             VK_Select = 41;             VK_Print = 42;
  126.   VK_Snapshot = 44;         VK_PrintScreen = 44;
  127.   VK_Insert = 45;           VK_Delete = 46;             VK_Help = 47;
  128.   VK_A = 65;                VK_B = 66;
  129.   VK_C = 67;                VK_D = 68;                  VK_E = 69;
  130.   VK_F = 70;                VK_G = 71;                  VK_H = 72;
  131.   VK_I = 73;                VK_J = 74;                  VK_K = 75;
  132.   VK_L = 76;                VK_M = 77;                  VK_N = 78;
  133.   VK_O = 79;                VK_P = 80;                  VK_Q = 81;
  134.   VK_R = 82;                VK_S = 83;                  VK_T = 84;
  135.   VK_U = 85;                VK_V = 86;                  VK_W = 87;
  136.   VK_X = 88;                VK_Y = 89;                  VK_Z = 90;
  137.   VK_LWin = 91;             VK_RWin = 92;               VK_Apps = 93;
  138.   VK_Sleep = 95;            VK_NumPad0 = 96;            VK_NumPad1 = 97;
  139.   VK_NumPad2 = 98;          VK_NumPad3 = 99;            VK_NumPad4 = 100;
  140.   VK_NumPad5 = 101;         VK_NumPad6 = 102;           VK_NumPad7 = 103;
  141.   VK_NumPad8 = 104;         VK_NumPad9 = 105;           VK_Multiply = 106;
  142.   VK_Add = 107;             VK_Separator = 108;         VK_Subtract = 109;
  143.   VK_Decimal = 110;         VK_Divide = 111;            VK_F1 = 112;
  144.   VK_F2 = 113;              VK_F3 = 114;                VK_F4 = 115;
  145.   VK_F5 = 116;              VK_F6 = 117;                VK_F7 = 118;
  146.   VK_F8 = 119;              VK_F9 = 120;                VK_F10 = 121;
  147.   VK_F11 = 122;             VK_F12 = 123;               VK_NumLock = 144;
  148.   VK_Scroll = 145;          VK_LShiftKey = 160;         VK_RShiftKey = 161;
  149.   VK_LControlKey = 162;     VK_RControlKey = 163;       VK_LMenu = 164;
  150.   VK_RMenu = 165;          
  151.   VK_KeyCode = 65535;       VK_Shift = 65536;           VK_Control = 131072;
  152.   VK_Alt = 262144;          VK_Modifiers = -65536;
  153.  
  154. // Pen style constants
  155.   psSolid = DashStyle.Solid;
  156.   psClear = DashStyle.Custom;    
  157.   psDash = DashStyle.Dash;
  158.   psDot = DashStyle.Dot;  
  159.   psDashDot = DashStyle.DashDot;  
  160.   psDashDotDot = DashStyle.DashDotDot;
  161.  
  162. // Pen mode constants
  163.   pmCopy = 0;
  164.   pmNot = 1;
  165.  
  166. // Brush hatch type constants
  167.   bhHorizontal = HatchStyle.Horizontal;
  168.   bhMin = HatchStyle.Min;
  169.   bhVertical = HatchStyle.Vertical;
  170.   bhForwardDiagonal = HatchStyle.ForwardDiagonal;
  171.   bhBackwardDiagonal = HatchStyle.BackwardDiagonal;
  172.   bhCross = HatchStyle.Cross;
  173.   bhLargeGrid = HatchStyle.LargeGrid;
  174.   bhMax = HatchStyle.Max;
  175.   bhDiagonalCross = HatchStyle.DiagonalCross;
  176.   bhPercent05 = HatchStyle.Percent05;
  177.   bhPercent10 = HatchStyle.Percent10;
  178.   bhPercent20 = HatchStyle.Percent20;
  179.   bhPercent25 = HatchStyle.Percent25;
  180.   bhPercent30 = HatchStyle.Percent30;
  181.   bhPercent40 = HatchStyle.Percent40;
  182.   bhPercent50 = HatchStyle.Percent50;
  183.   bhPercent60 = HatchStyle.Percent60;
  184.   bhPercent70 = HatchStyle.Percent70;
  185.   bhPercent75 = HatchStyle.Percent75;
  186.   bhPercent80 = HatchStyle.Percent80;
  187.   bhPercent90 = HatchStyle.Percent90;
  188.   bhLightDownwardDiagonal = HatchStyle.LightDownwardDiagonal;
  189.   bhLightUpwardDiagonal = HatchStyle.LightUpwardDiagonal;
  190.   bhDarkDownwardDiagonal = HatchStyle.DarkDownwardDiagonal;
  191.   bhDarkUpwardDiagonal = HatchStyle.DarkUpwardDiagonal;
  192.   bhWideDownwardDiagonal = HatchStyle.WideDownwardDiagonal;
  193.   bhWideUpwardDiagonal = HatchStyle.WideUpwardDiagonal;
  194.   bhLightVertical = HatchStyle.LightVertical;
  195.   bhLightHorizontal = HatchStyle.LightHorizontal;
  196.   bhNarrowVertical = HatchStyle.NarrowVertical;
  197.   bhNarrowHorizontal = HatchStyle.NarrowHorizontal;
  198.   bhDarkVertical = HatchStyle.DarkVertical;
  199.   bhDarkHorizontal = HatchStyle.DarkHorizontal;
  200.   bhDashedDownwardDiagonal = HatchStyle.DashedDownwardDiagonal;
  201.   bhDashedUpwardDiagonal = HatchStyle.DashedUpwardDiagonal;
  202.   bhDashedHorizontal = HatchStyle.DashedHorizontal;
  203.   bhDashedVertical = HatchStyle.DashedVertical;
  204.   bhSmallConfetti = HatchStyle.SmallConfetti;
  205.   bhLargeConfetti = HatchStyle.LargeConfetti;
  206.   bhZigZag = HatchStyle.ZigZag;
  207.   bhWave = HatchStyle.Wave;
  208.   bhDiagonalBrick = HatchStyle.DiagonalBrick;
  209.   bhHorizontalBrick = HatchStyle.HorizontalBrick;
  210.   bhWeave = HatchStyle.Weave;
  211.   bhPlaid = HatchStyle.Plaid;
  212.   bhDivot = HatchStyle.Divot;
  213.   bhDottedGrid = HatchStyle.DottedGrid;
  214.   bhDottedDiamond = HatchStyle.DottedDiamond;
  215.   bhShingle = HatchStyle.Shingle;
  216.   bhTrellis = HatchStyle.Trellis;
  217.   bhSphere = HatchStyle.Sphere;
  218.   bhSmallGrid = HatchStyle.SmallGrid;
  219.   bhSmallCheckerBoard = HatchStyle.SmallCheckerBoard;
  220.   bhLargeCheckerBoard = HatchStyle.LargeCheckerBoard;
  221.   bhOutlinedDiamond = HatchStyle.OutlinedDiamond;
  222.   bhSolidDiamond = HatchStyle.SolidDiamond;
  223.  
  224. // Font & Brush style constants
  225. type
  226.   FontStyleType = (fsNormal, fsBold, fsItalic, fsBoldItalic, fsUnderline, fsBoldUnderline, fsItalicUnderline, fsBoldItalicUnderline);
  227.   BrushStyleType = (bsSolid, bsClear, bsHatch, bsGradient, bsNone);
  228.  
  229. /// Закрашивает пиксел с координатами (x,y) цветом c
  230. procedure SetPixel(x,y: integer; c: Color);
  231. /// Закрашивает пиксел с координатами (x,y) цветом c
  232. procedure PutPixel(x,y: integer; c: Color);
  233. /// Возвращает цвет пиксела с координатами (x,y)
  234. function GetPixel(x,y: integer): Color;
  235.  
  236. /// Устанавливает текущую позицию рисования в точку (x,y)
  237. procedure MoveTo(x,y: integer);
  238. /// Перемещает текущую позицию рисования на вектор (dx,dy)
  239. procedure MoveRel(dx,dy: integer);
  240. /// Рисует отрезок от текущей позиции до точки (x,y). Текущая позиция переносится в точку (x,y)
  241. procedure LineTo(x,y: integer);
  242. /// Рисует отрезок от текущей позиции до точки (x,y) цветом c. Текущая позиция переносится в точку (x,y)
  243. procedure LineTo(x,y: integer; c: Color);
  244. /// Рисует отрезок от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку
  245. procedure LineRel(dx,dy: integer);
  246. /// Рисует отрезок цветом c от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку
  247. procedure LineRel(dx,dy: integer; c: Color);
  248.  
  249. /// Рисует отрезок от точки (x1,y1) до точки (x2,y2)
  250. procedure Line(x1,y1,x2,y2: integer);
  251. /// Рисует отрезок от точки p1 до точки p2
  252. procedure Line(p1,p2: Point);
  253. /// Рисует отрезок от точки (x1,y1) до точки (x2,y2) цветом c
  254. procedure Line(x1,y1,x2,y2: integer; c: Color);
  255. /// Рисует отрезок от точки p1 до точки p2 цветом c
  256. procedure Line(p1,p2: Point; c: Color);
  257.  
  258. /// Заполняет внутренность окружности с центром (x,y) и радиусом r
  259. procedure FillCircle(x,y,r: integer);
  260. /// Рисует окружность с центром (x,y) и радиусом r
  261. procedure DrawCircle(x,y,r: integer);
  262. /// Заполняет внутренность эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
  263. procedure FillEllipse(x1,y1,x2,y2: integer);
  264. /// Рисует границу эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
  265. procedure DrawEllipse(x1,y1,x2,y2: integer);
  266. /// Заполняет внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
  267. procedure FillRectangle(x1,y1,x2,y2: integer);
  268. /// Заполняет внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
  269. procedure FillRect(x1,y1,x2,y2: integer);
  270. /// Рисует границу прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
  271. procedure DrawRectangle(x1,y1,x2,y2: integer);
  272. /// Заполняет внутренность прямоугольника со скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
  273. procedure FillRoundRect(x1,y1,x2,y2,w,h: integer);
  274. /// Рисует границу прямоугольника со скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
  275. procedure DrawRoundRect(x1,y1,x2,y2,w,h: integer);
  276.  
  277. /// Рисует заполненную окружность с центром (x,y) и радиусом r
  278. procedure Circle(x,y,r: integer);
  279. /// Рисует заполненный эллипс, ограниченный прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
  280. procedure Ellipse(x1,y1,x2,y2: integer);
  281. /// Рисует заполненный прямоугольник, заданный координатами противоположных вершин (x1,y1) и (x2,y2)
  282. procedure Rectangle(x1,y1,x2,y2: integer);
  283. /// Рисует заполненный прямоугольник со скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
  284. procedure RoundRect(x1,y1,x2,y2,w,h: integer);
  285.  
  286. /// Рисует дугу окружности с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
  287. procedure Arc(x,y,r,a1,a2: integer);
  288. /// Заполняет внутренность сектора окружности, ограниченного дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
  289. procedure FillPie(x,y,r,a1,a2: integer);
  290. /// Рисует сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
  291. procedure DrawPie(x,y,r,a1,a2: integer);
  292. /// Рисует заполненный сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
  293. procedure Pie(x,y,r,a1,a2: integer);
  294.  
  295. /// Возвращает точку на плоскости с координатами (x,y)
  296. function Pnt(x,y: integer): Point;
  297.  
  298. /// Рисует замкнутую ломаную по точкам, координаты которых заданы в массиве points
  299. procedure DrawPolygon(points: array of Point);
  300. /// Рисует замкнутую ломаную по точкам, координаты которых заданы в массиве points
  301. procedure DrawPolygon(params points: array of (integer,integer));
  302. /// Заполняет многоугольник, координаты вершин которого заданы в массиве points
  303. procedure FillPolygon(points: array of Point);
  304. /// Заполняет многоугольник, координаты вершин которого заданы в массиве points
  305. procedure FillPolygon(params points: array of (integer,integer));
  306. /// Рисует заполненный многоугольник, координаты вершин которого заданы в массиве points
  307. procedure Polygon(points: array of Point);
  308. /// Рисует заполненный многоугольник, координаты вершин которого заданы в массиве points
  309. procedure Polygon(params points: array of (integer,integer));
  310. /// Рисует ломаную по точкам, координаты которых заданы в массиве points
  311. procedure Polyline(points: array of Point);
  312. /// Рисует ломаную по точкам, координаты которых заданы в массиве points
  313. procedure Polyline(params points: array of (integer,integer));
  314. /// Рисует кривую по точкам, координаты которых заданы в массиве points
  315. procedure Curve(points: array of Point);
  316. /// Рисует кривую по точкам, координаты которых заданы в массиве points
  317. procedure Curve(params points: array of (integer,integer));
  318. /// Рисует замкнутую кривую по точкам, координаты которых заданы в массиве points
  319. procedure DrawClosedCurve(points: array of Point);
  320. /// Рисует замкнутую кривую по точкам, координаты которых заданы в массиве points
  321. procedure DrawClosedCurve(params points: array of (integer,integer));
  322. /// Заполняет замкнутую кривую по точкам, координаты которых заданы в массиве points
  323. procedure FillClosedCurve(points: array of Point);
  324. /// Заполняет замкнутую кривую по точкам, координаты которых заданы в массиве points
  325. procedure FillClosedCurve(params points: array of (integer,integer));
  326. /// Рисует заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
  327. procedure ClosedCurve(points: array of Point);
  328. /// Рисует заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
  329. procedure ClosedCurve(params points: array of (integer,integer));
  330.  
  331. /// Выводит строку s в прямоугольник к координатами левого верхнего угла (x,y)
  332. procedure TextOut(x,y: integer; s: string);
  333. /// Выводит целое n в прямоугольник к координатами левого верхнего угла (x,y)
  334. procedure TextOut(x,y: integer; n: integer);
  335. /// Выводит вещественное r в прямоугольник к координатами левого верхнего угла (x,y)
  336. procedure TextOut(x,y: integer; r: real);
  337. /// Выводит строку s, отцентрированную в прямоугольнике с координатами (x,y,x1,y1)
  338. procedure DrawTextCentered(x,y,x1,y1: integer; s: string);
  339. /// Выводит целое значение n, отцентрированное в прямоугольнике с координатами (x,y,x1,y1)
  340. procedure DrawTextCentered(x,y,x1,y1: integer; n: integer);
  341. /// Выводит вещественное значение r, отцентрированное в прямоугольнике с координатами (x,y,x1,y1)
  342. procedure DrawTextCentered(x,y,x1,y1: integer; r: real);
  343. /// Выводит строку s, отцентрированное по точке с координатами (x,y)
  344. procedure DrawTextCentered(x,y: integer; s: string);
  345. /// Выводит целое n, отцентрированное по точке с координатами (x,y)
  346. procedure DrawTextCentered(x,y: integer; n: integer);
  347. /// Выводит вещественное r, отцентрированное по точке с координатами (x,y)
  348. procedure DrawTextCentered(x,y: integer; r: real);
  349. /// Заливает область одного цвета цветом c, начиная с точки (x,y).
  350. procedure FloodFill(x,y: integer; c: Color);
  351.  
  352. {procedure FillCircle(x,y,r: integer; c: Color);
  353. procedure DrawCircle(x,y,r: integer; c: Color);
  354. procedure FillEllipse(x1,y1,x2,y2: integer; c: Color);
  355. procedure DrawEllipse(x1,y1,x2,y2: integer; c: Color);
  356. procedure FillRectangle(x1,y1,x2,y2: integer; c: Color);
  357. procedure FillRect(x1,y1,x2,y2: integer; c: Color);
  358. procedure DrawRectangle(x1,y1,x2,y2: integer; c: Color);
  359. procedure DrawRoundRect(x1,y1,x2,y2,w,h: integer; c: Color);
  360. procedure FillRoundRect(x1,y1,x2,y2,w,h: integer; c: Color);
  361.  
  362. procedure Circle(x,y,r: integer; c: Color);
  363. procedure Ellipse(x1,y1,x2,y2: integer; c: Color);
  364. procedure Rectangle(x1,y1,x2,y2: integer; c: Color);
  365. procedure RoundRect(x1,y1,x2,y2,w,h: integer; c: Color);
  366.  
  367. procedure Arc(x,y,r,a1,a2: integer; c: Color);
  368. procedure FillPie(x,y,r,a1,a2: integer; c: Color);
  369. procedure DrawPie(x,y,r,a1,a2: integer; c: Color);
  370. procedure Pie(x,y,r,a1,a2: integer; c: Color);
  371.  
  372. procedure DrawPolygon(a: array of Point; c: Color);
  373. procedure FillPolygon(a: array of Point; c: Color);
  374. procedure Polygon(a: array of Point; c: Color);
  375. procedure Polyline(a: array of Point; c: Color);}
  376.  
  377. //--------------------------------------------
  378. ////                Цвета
  379. //--------------------------------------------
  380. /// Возвращает цвет, который содержит красную (r), зеленую (g) и синюю (b) составляющие (r,g и b - в диапазоне от 0 до 255)
  381. function RGB(r,g,b: byte): Color;
  382. /// Возвращает цвет, который содержит красную (r), зеленую (g) и синюю (b) составляющие и прозрачность (a) (a,r,g,b - в диапазоне от 0 до 255)
  383. function ARGB(a,r,g,b: byte): Color;
  384.  
  385. /// Возвращает красный цвет с интенсивностью r (r - в диапазоне от 0 до 255)
  386. function RedColor(r: byte): Color;
  387. /// Возвращает зеленый цвет с интенсивностью g (g - в диапазоне от 0 до 255)
  388. function GreenColor(g: byte): Color;
  389. /// Возвращает синий цвет с интенсивностью b (b - в диапазоне от 0 до 255)
  390. function BlueColor(b: byte): Color;
  391. /// Возвращает случайный цвет
  392. function clRandom: Color;
  393.  
  394. /// Возвращает красную составляющую цвета
  395. function GetRed(c: Color): integer;
  396. /// Возвращает зеленую составляющую цвета
  397. function GetGreen(c: Color): integer;
  398. /// Возвращает синюю составляющую цвета
  399. function GetBlue(c: Color): integer;
  400. /// Возвращает составляющую прозрачности цвета
  401. function GetAlpha(c: Color): integer;
  402.  
  403. //--------------------------------------------
  404. ////                Перья
  405. //--------------------------------------------
  406. /// Устанавливает цвет текущего пера
  407. procedure SetPenColor(c: Color);
  408. /// Возвращает цвет текущего пера
  409. function PenColor: Color;
  410. /// Устанавливает ширину текущего пера
  411. procedure SetPenWidth(Width: integer);
  412. /// Возвращает ширину текущего пера
  413. function PenWidth: integer;
  414. /// Устанавливает стиль текущего пера
  415. procedure SetPenStyle(style: DashStyle);
  416. /// Возвращает стиль текущего пера
  417. function PenStyle: DashStyle;
  418. /// Устанавливает режим текущего пера
  419. procedure SetPenMode(m: integer);
  420. /// Возвращает режим текущего пера
  421. function PenMode: integer;
  422. //2015.01>
  423. /// Устанавливает или отменяет режим закругленных концов линий
  424. procedure SetPenRoundCap(isRoundCap: boolean);
  425. /// Возвращает truе, если установлен режим закругленных концов линий
  426. function PenRoundCap: boolean;
  427. //2015.01<    
  428. /// Возвращают x-координату текущей позиции рисования
  429. function PenX: integer;
  430. /// Возвращают y-координату текущей позиции рисования
  431. function PenY: integer;
  432.  
  433. //--------------------------------------------
  434. ////                Кисти
  435. //--------------------------------------------
  436. /// Устанавливает цвет текущей кисти
  437. procedure SetBrushColor(c: Color);
  438. /// Возвращает цвет текущей кисти
  439. function BrushColor: Color;
  440. /// Устанавливает цвет текущей кисти
  441. procedure SetBrushStyle(bs: BrushStyleType);
  442. /// Возвращает цвет текущей кисти
  443. function BrushStyle: BrushStyleType;
  444. /// Устанавливает штриховку текущей кисти
  445. procedure SetBrushHatch(bh: HatchStyle);
  446. /// Возвращает штриховку текущей кисти
  447. function BrushHatch: HatchStyle;
  448. /// Устанавливает цвет заднего плана текущей штриховой кисти
  449. procedure SetHatchBrushBackgroundColor(c: Color);
  450. /// Возвращает цвет заднего плана текущей штриховой кисти
  451. function HatchBrushBackgroundColor: Color;
  452. /// Устанавливает второй цвет текущей градиентной кисти
  453. procedure SetGradientBrushSecondColor(c: Color);
  454. /// Возвращает второй цвет текущей градиентной кисти
  455. function GradientBrushSecondColor: Color;
  456.  
  457. //--------------------------------------------
  458. ////                Шрифты
  459. //--------------------------------------------
  460. /// Устанавливает размер текущего шрифта в пунктах
  461. procedure SetFontSize(size: integer);
  462. /// Возвращает размер текущего шрифта в пунктах
  463. function FontSize: integer;
  464. /// Устанавливает имя текущего шрифта
  465. procedure SetFontName(name: string);
  466. /// Возвращает имя текущего шрифта
  467. function FontName: string;
  468. /// Устанавливает цвет текущего шрифта
  469. procedure SetFontColor(c: Color);
  470. /// Возвращает цвет текущего шрифта
  471. function FontColor: Color;
  472. /// Устанавливает стиль текущего шрифта
  473. procedure SetFontStyle(fs: FontStyleType);
  474. /// Возвращает стиль текущего шрифта
  475. function FontStyle: FontStyleType;
  476. /// Возвращает ширину строки s в пикселях при текущих настройках шрифта
  477. function TextWidth(s: string): integer;
  478. /// Возвращает высоту строки s в пикселях при текущих настройках шрифта
  479. function TextHeight(s: string): integer;
  480.  
  481. //--------------------------------------------
  482. ////                Графическое окно
  483. //--------------------------------------------
  484. /// Очищает графическое окно белым цветом
  485. procedure ClearWindow;
  486. /// Очищает графическое окно цветом c
  487. procedure ClearWindow(c: Color);
  488.  
  489. /// Возвращает ширину клиентской части графического окна в пикселах
  490. function WindowWidth: integer;
  491. /// Возвращает высоту клиентской части графического окна в пикселах
  492. function WindowHeight: integer;
  493. /// Возвращает отступ графического окна от левого края экрана в пикселах
  494. function WindowLeft: integer;
  495. /// Возвращает отступ графического окна от верхнего края экрана в пикселах
  496. function WindowTop: integer;
  497. /// Возвращает центр графического окна
  498. function WindowCenter: Point;
  499. /// Возвращает True, если графическое окно имеет фиксированный размер, и False в противном случае
  500. function WindowIsFixedSize: boolean;
  501.  
  502. /// Устанавливает ширину клиентской части графического окна в пикселах
  503. procedure SetWindowWidth(w: integer);
  504. /// Устанавливает высоту клиентской части графического окна в пикселах
  505. procedure SetWindowHeight(h: integer);
  506. /// Устанавливает отступ графического окна от левого края экрана в пикселах
  507. procedure SetWindowLeft(l: integer);
  508. /// Устанавливает отступ графического окна от верхнего края экрана в пикселах
  509. procedure SetWindowTop(t: integer);
  510. /// Устанавливает, имеет ли графическое окно фиксированный размер
  511. procedure SetWindowIsFixedSize(b: boolean);
  512.  
  513. /// Устанавливает размеры клиентской части графического окна в пикселах
  514. procedure SetWindowSize(w,h: integer);
  515. /// Устанавливает отступ графического окна от левого верхнего края экрана в пикселах
  516. procedure SetWindowPos(l,t: integer);
  517.  
  518. /// Возвращает ширину графического компонента в пикселах (по умолчанию совпадает с WindowWidth)
  519. function GraphBoxWidth: integer;
  520. /// Возвращает высоту графического компонента в пикселах (по умолчанию совпадает с WindowHeight)
  521. function GraphBoxHeight: integer;
  522. /// Возвращает отступ графического компонента от левого края окна в пикселах
  523. function GraphBoxLeft: integer;
  524. /// Возвращает отступ графического компонента от верхнего края окна в пикселах
  525. function GraphBoxTop: integer;
  526.  
  527. /// Возвращает заголовок графического окна
  528. function WindowCaption: string;
  529. /// Возвращает заголовок графического окна
  530. function WindowTitle: string;
  531. /// Устанавливает заголовок графического окна
  532. procedure SetWindowCaption(s: string);
  533. /// Устанавливает заголовок графического окна
  534. procedure SetWindowTitle(s: string);
  535.  
  536. /// Устанавливает ширину и высоту клиентской части графического окна в пикселах
  537. procedure InitWindow(Left,Top,Width,Height: integer; BackColor: Color := clWhite);
  538.  
  539. /// Сохраняет содержимое графического окна в файл с именем fname
  540. procedure SaveWindow(fname: string);
  541. /// Восстанавливает содержимое графического окна из файла с именем fname
  542. procedure LoadWindow(fname: string);
  543. /// Заполняет содержимое графического окна обоями из файла с именем fname
  544. procedure FillWindow(fname: string);
  545. /// Закрывает графическое окно и завершает приложение
  546. procedure CloseWindow;
  547.  
  548. /// Возвращает ширину экрана в пикселях
  549. function ScreenWidth: integer;
  550. /// Возвращает высоту экрана в пикселях
  551. function ScreenHeight: integer;
  552.  
  553. /// Центрирует графическое окно по центру экрана
  554. procedure CenterWindow;
  555. /// Максимизирует графическое окно
  556. procedure MaximizeWindow;
  557. /// Сворачивает графическое окно
  558. procedure MinimizeWindow;
  559. /// Возвращает графическое окно к нормальному размеру
  560. procedure NormalizeWindow;
  561.  
  562. //--------------------------------------------
  563. ////           Буферизация рисования
  564. //--------------------------------------------
  565. /// Перерисовывает содержимое графического окна. Вызывается в паре с LockDrawing
  566. procedure Redraw;
  567. ///--
  568. procedure FullRedraw;
  569. /// Блокирует рисование на графическом окне. Перерисовка графического окна выполняется с помощью Redraw
  570. procedure LockDrawing;
  571. /// Снимает блокировку рисования на графическом окне и осуществляет его перерисовку
  572. procedure UnlockDrawing;
  573.  
  574. //--------------------------------------------
  575. ////              Сглаживание
  576. //--------------------------------------------
  577. /// Устанавливает режим сглаживания
  578. procedure SetSmoothing(sm: boolean);
  579. /// Включает режим сглаживания
  580. procedure SetSmoothingOn;
  581. /// Выключает режим сглаживания
  582. procedure SetSmoothingOff;
  583. /// Возвращает True, если режим сглаживания установлен
  584. function SmoothingIsOn: boolean;
  585.  
  586. //--------------------------------------------
  587. ////        Вспомогательные подпрограммы
  588. //--------------------------------------------
  589. /// Блокирует прорисовку графики. Вызывается для синхронизации
  590. procedure LockGraphics;
  591. /// Разблокирует прорисовку графики. Вызывается для синхронизации
  592. procedure UnLockGraphics;
  593.  
  594. //------------------------------------------------------------
  595. ////        Подпрограммы для работы с системой координат
  596. //------------------------------------------------------------
  597. /// Устанавливает начало координат в точку (x0,y0)
  598. procedure SetCoordinateOrigin(x0,y0: integer);
  599. /// Устанавливает масштаб системы координат
  600. procedure SetCoordinateScale(sx,sy: real);
  601. /// Устанавливает поворот системы координат
  602. procedure SetCoordinateAngle(a: real);
  603.  
  604. //----------------------------------------
  605. ////        Сервисные подпрограммы
  606. //----------------------------------------
  607. /// Возвращает прямоугольник, заданный координатами противоположных вершин
  608. function Rect(x1,y1,x2,y2: integer): System.Drawing.Rectangle;
  609.  
  610. /// Возвращает прямоугольник клиентской части главного окна
  611. function ClientRectangle: System.Drawing.Rectangle;
  612.  
  613. //------------------------------------------
  614. ////        Рисование графиков функций
  615. //------------------------------------------
  616. /// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
  617. procedure Draw(f: real -> real; a,b,min,max: real; x1,y1,x2,y2: integer);
  618. /// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r
  619. procedure Draw(f: real -> real; a,b,min,max: real; r: System.Drawing.Rectangle);
  620. /// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно
  621. procedure Draw(f: real -> real; a,b,min,max: real);
  622. /// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
  623. procedure Draw(f: real -> real; a,b: real; x1,y1,x2,y2: integer);
  624. /// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике r
  625. procedure Draw(f: real -> real; a,b: real; r: System.Drawing.Rectangle);
  626. /// Рисует график функции f, заданной на отрезке [-5,5], в прямоугольнике r
  627. procedure Draw(f: real -> real; r: System.Drawing.Rectangle);
  628. /// Рисует график функции f, заданной на отрезке [a,b], на полное графическое окно
  629. procedure Draw(f: real -> real; a,b: real);
  630. /// Рисует график функции f, заданной на отрезке [-5,5], на полное графическое окно  
  631. procedure Draw(f: real -> real);
  632.  
  633. //------------------------------------------
  634. ////        Рисование изображений
  635. //------------------------------------------
  636. /// Выводит растровое изображение из файла с именем fname в позицию x,y
  637. procedure Draw(fname: string; x: integer := 0; y: integer := 0);
  638. /// Выводит растровое изображение из файла с именем fname в позицию x,y, масштабируя его к размеру w на h
  639. procedure Draw(fname: string; x,y,w,h: integer);
  640. /// Выводит растровое изображение из файла с именем fname в позицию x,y, масштабируя его с коэффициентом Scale
  641. procedure Draw(fname: string; x,y: integer; Scale: real);
  642.  
  643.  
  644. /// Инициализирует графическое окно. Используется для внутренних целей
  645. procedure InitGraphABC;
  646.  
  647. type
  648. /// Тип пера GraphABC
  649.   GraphABCPen = class
  650.   private
  651.     _NETPen: System.Drawing.Pen;
  652.     procedure SetColor(c: _GraphABC.Color);
  653.     function GetColor: _GraphABC.Color;
  654.     procedure SetWidth(w: integer);
  655.     function GetWidth: integer;
  656.     procedure SetStyle(st: DashStyle);
  657.     function GetStyle: DashStyle;
  658.     procedure SetMode(m: integer);
  659.     function GetMode: integer;
  660.     procedure SetNETPen(p: System.Drawing.Pen);
  661.     function GetX: integer;
  662.     function GetY: integer;
  663. //2015.01>
  664.     procedure SetRoundCap(isRoundCap: boolean);
  665.     function GetRoundCap: boolean;
  666. //2015.01<    
  667.   public  
  668.     /// Текущее перо .NET
  669.     property NETPen: System.Drawing.Pen read _NETPen write SetNETPen;
  670.     /// Цвет пера
  671.     property Color: _GraphABC.Color read GetColor write SetColor;
  672.     /// Ширина пера
  673.     property Width: integer read GetWidth write SetWidth;
  674.     /// Стиль пера
  675.     property Style: DashStyle read GetStyle write SetStyle;
  676.     /// Режим пера
  677.     property Mode: integer read GetMode write SetMode;
  678.     /// X-координата текущей позиции пера
  679.     property X: integer read GetX;
  680.     /// Y-координата текущей позиции пера
  681.     property Y: integer read GetY;
  682. //2015.01>
  683.     /// Режим закругленных концов линий
  684.     property RoundCap: boolean read GetRoundCap write SetRoundCap;
  685. //2015.01<    
  686.   end;
  687.  
  688. /// Тип кисти GraphABC
  689.   GraphABCBrush = class
  690.   private
  691.     _NETBrush: System.Drawing.Brush;
  692.     procedure SetNETBrush(b: System.Drawing.Brush);
  693.     procedure SetColor(c: _GraphABC.Color);
  694.     function GetColor: _GraphABC.Color;
  695.     procedure SetStyle(st: BrushStyleType);
  696.     function GetStyle: BrushStyleType;
  697.     procedure SetHatch(h: HatchStyle);
  698.     function GetHatch: HatchStyle;
  699.     procedure SetHatchBackgroundColor(c: _GraphABC.Color);
  700.     function GetHatchBackgroundColor: _GraphABC.Color;
  701.     procedure SetGradientSecondColor(c: _GraphABC.Color);
  702.     function GetGradientSecondColor: _GraphABC.Color;
  703.   public  
  704. /// Текущая кисть .NET
  705.     property NETBrush: System.Drawing.Brush read _NETBrush write SetNETBrush;
  706. /// Цвет кисти
  707.     property Color: _GraphABC.Color read GetColor write SetColor;
  708. /// Стиль кисти
  709.     property Style: BrushStyleType read GetStyle write SetStyle;
  710. /// Штриховка кисти
  711.     property Hatch: HatchStyle read GetHatch write SetHatch;
  712. /// Цвет заднего плана штриховой кисти
  713.     property HatchBackgroundColor: _GraphABC.Color read GetHatchBackgroundColor write SetHatchBackgroundColor;
  714. /// Второй цвет градиентной кисти
  715.     property GradientSecondColor: _GraphABC.Color read GetGradientSecondColor write SetGradientSecondColor;
  716.   end;
  717.  
  718. /// Тип шрифта GraphABC
  719.   GraphABCFont = class
  720.   private
  721.     _NETFont: System.Drawing.Font;
  722.     procedure SetNETFont(f: System.Drawing.Font);
  723.     procedure SetColor(c: _GraphABC.Color);
  724.     function GetColor: _GraphABC.Color;
  725.     procedure SetStyle(st: FontStyleType);
  726.     function GetStyle: FontStyleType;
  727.     procedure SetSize(sz: integer);
  728.     function GetSize: integer;
  729.     procedure SetName(nm: string);
  730.     function GetName: string;
  731.   public  
  732. /// Текущий шрифт .NET
  733.     property NETFont: System.Drawing.Font read _NETFont write SetNETFont;
  734.     /// Цвет шрифта
  735.     property Color: _GraphABC.Color read GetColor write SetColor;
  736.     /// Стиль шрифта
  737.     property Style: FontStyleType read GetStyle write SetStyle;
  738.     /// Размер шрифта в пунктах
  739.     property Size: integer read GetSize write SetSize;
  740.     /// Наименование шрифта
  741.     property Name: string read GetName write SetName;
  742.   end;
  743.  
  744.   GraphABCCoordinate = class
  745.   private
  746.     coef: integer;
  747.     procedure SetOriginX(x: integer);
  748.     procedure SetOriginY(y: integer);
  749.     procedure SetOrigin(p: Point);
  750.     procedure SetAngle(a: real);
  751.     procedure SetScaleX(sx: real);
  752.     procedure SetScaleY(sy: real);
  753.     function GetOriginX: integer;
  754.     function GetOriginY: integer;
  755.     function GetOrigin: Point;
  756.     function GetAngle: real;
  757.     function GetScaleX: real;
  758.     function GetScaleY: real;
  759.     function GetMatrix: System.Drawing.Drawing2D.Matrix;
  760.   public
  761.     constructor;
  762.     /// Устанавливает параметры системы координат
  763.     procedure SetTransform(x0,y0,angle,sx,sy: real);
  764.     /// Устанавливает начало системы координат
  765.     procedure SetOrigin(x0,y0: integer);
  766.     /// Устанавливает масштаб системы координат
  767.     procedure SetScale(sx,sy: real);
  768.     /// Устанавливает масштаб системы координат
  769.     procedure SetScale(scale: real);
  770.     /// Устанавливает правую систему координат (ось OY направлена вверх, ось OX - вправо)
  771.     procedure SetMathematic;
  772.     /// Устанавливает левую систему координат (ось OY направлена вниз, ось OX - вправо)
  773.     procedure SetStandard;
  774.    
  775.     procedure ScaleOn(scale: real);
  776.  
  777.     procedure Transform(x,y: real);
  778.  
  779.     procedure Rotate(angle: real);
  780.    
  781.     procedure ClearMatrix;
  782.  
  783.     /// X-координата начала координат относительно левого верхнего угла окна
  784.     property OriginX: integer read GetOriginX write SetOriginX;
  785.     /// Y-координата начала координат относительно левого верхнего угла окна
  786.     property OriginY: integer read GetOriginY write SetOriginY;
  787.     /// Координаты начала координат относительно левого верхнего угла окна
  788.     property Origin: Point read GetOrigin write SetOrigin;
  789.     /// Угол поворота системы координат
  790.     property Angle: real read GetAngle write SetAngle;
  791.     /// Масштаб системы координат по оси X
  792.     property ScaleX: real read GetScaleX write SetScaleX;
  793.     /// Масштаб системы координат по оси Y
  794.     property ScaleY: real read GetScaleY write SetScaleY;
  795.     /// Масштаб системы координат по обоим осям
  796.     property Scale: real write SetScale;
  797.     /// Матрица 3x3 преобразований координат
  798.     property Matrix: System.Drawing.Drawing2D.Matrix read GetMatrix;
  799.   end;
  800.  
  801.   GraphABCWindow = class
  802.   private
  803.     procedure SetLeft(l: integer);
  804.     function GetLeft: integer;
  805.     procedure SetTop(t: integer);
  806.     function GetTop: integer;
  807.     procedure SetWidth(w: integer);
  808.     function GetWidth: integer;
  809.     procedure SetHeight(h: integer);
  810.     function GetHeight: integer;
  811.     procedure SetCaption(c: string);
  812.     function GetCaption: string;
  813.     procedure SetIsFixedSize(b: boolean);
  814.     function GetIsFixedSize: boolean;
  815.   public
  816. /// Отступ графического окна от левого края экрана в пикселах
  817.     property Left: integer read GetLeft write SetLeft;
  818. /// Отступ графического окна от верхнего края экрана в пикселах
  819.     property Top: integer read GetTop write SetTop;
  820. /// Ширина клиентской части графического окна в пикселах
  821.     property Width: integer read GetWidth write SetWidth;
  822. /// Высота клиентской части графического окна в пикселах
  823.     property Height: integer read GetHeight write SetHeight;
  824. /// Заголовок графического окна
  825.     property Caption: string read GetCaption write SetCaption;
  826. /// Заголовок графического окна
  827.     property Title: string read GetCaption write SetCaption;
  828. /// Имеет ли графическое окно фиксированный размер
  829.     property IsFixedSize: boolean read GetIsFixedSize write SetIsFixedSize;
  830. /// Очищает графическое окно белым цветом
  831.     procedure Clear;
  832. /// Очищает графическое окно цветом c
  833.     procedure Clear(c: Color);
  834. /// Устанавливает размеры клиентской части графического окна в пикселах
  835.     procedure SetSize(w,h: integer);
  836. /// Устанавливает отступ графического окна от левого верхнего края экрана в пикселах
  837.     procedure SetPos(l,t: integer);
  838. /// Устанавливает положение, размеры и цвет графического окна
  839.     procedure Init(Left,Top,Width,Height: integer; BackColor: Color := clWhite);
  840. /// Сохраняет содержимое графического окна в файл с именем fname
  841.     procedure Save(fname: string);
  842. /// Восстанавливает содержимое графического окна из файла с именем fname
  843.     procedure Load(fname: string);
  844. /// Заполняет содержимое графического окна обоями из файла с именем fname
  845.     procedure Fill(fname: string);
  846. /// Закрывает графическое окно и завершает приложение
  847.     procedure Close;
  848. /// Сворачивает графическое окно
  849.     procedure Minimize;
  850. /// Максимизирует графическое окно
  851.     procedure Maximize;
  852. /// Возвращает графическое окно к нормальному размеру
  853.     procedure Normalize;
  854. /// Центрирует графическое окно по центру экрана
  855.     procedure CenterOnScreen;
  856. /// Возвращает центр графического окна
  857.     function Center: Point;
  858.   end;
  859.  
  860.   GraphABCStatusPanel = class
  861.   private
  862.     p: System.Windows.Forms.ToolStripStatusLabel;
  863.     procedure SetText(s: string);
  864.     function GetText: string;
  865.   public
  866.     constructor (pp: System.Windows.Forms.ToolStripStatusLabel);
  867.     property Text: string read GetText write SetText;
  868.   end;
  869.  
  870.   GraphABCStatus = class
  871.   private
  872.     procedure SetText(s: string);
  873.     function GetText: string;
  874.     procedure SetPanelsCount(n: integer);
  875.     function GetPanelsCount: integer;
  876.     function GetItem(i: integer): GraphABCStatusPanel;
  877.   public
  878.     procedure Show;
  879.     procedure Hide;
  880.     property Text: string read GetText write SetText;
  881.     property Items[i: integer]: GraphABCStatusPanel read GetItem; default;
  882.     property PanelsCount: integer read GetPanelsCount write SetPanelsCount;
  883.   end;
  884.  
  885. /// Тип рисунка GraphABC
  886.   Picture = class
  887.   public
  888.     bmp,savedbmp: Bitmap;
  889.     gb: Graphics;
  890.     istransp: boolean;
  891.     transpcolor: System.Drawing.Color;
  892.     procedure SetWidth(w: integer);
  893.     function GetWidth: integer;
  894.     procedure SetHeight(h: integer);
  895.     function GetHeight: integer;
  896.     procedure SetTransparent(b: boolean);
  897.     procedure SetTransparentColor(c: _GraphABC.Color);
  898.     function GetTransparentColor: _GraphABC.Color;
  899.   public
  900. /// Создает рисунок размера w на h пикселей
  901.     constructor Create(w,h: integer);
  902. /// Создает рисунок из файла с именем fname
  903.     constructor Create(fname: string);
  904. /// Создает рисунок из прямоугольника r графического окна
  905.     constructor Create(r: System.Drawing.Rectangle); // Create from screen
  906. /// Загружает рисунок из файла с именем fname
  907.     procedure Load(fname: string);
  908. /// Сохраняет рисунок в файл с именем fname
  909.     procedure Save(fname: string);
  910. /// Устанавливает размер рисунка w на h пикселей
  911.     procedure SetSize(w,h: integer);
  912. /// Ширина рисунка в пикселах
  913.     property Width: integer read GetWidth write SetWidth;
  914. /// Высота рисунка в пикселах
  915.     property Height: integer read GetHeight write SetHeight;
  916. /// Прозрачность рисунка; прозрачный цвет задается свойством TransparentColor
  917.     property Transparent: boolean read istransp write SetTransparent;
  918. /// Прозрачный цвет рисунка. Должна быть установлена прозрачность Transparent := True
  919.     property TransparentColor: _GraphABC.Color read GetTransparentColor write SetTransparentColor;
  920. /// Возвращает True, если изображение данного рисунка пересекается с изображением рисунка p, и False в противном случае. Белый цвет считается прозрачным
  921.     function Intersect(p: Picture): boolean;
  922. /// Выводит рисунок в позиции (x,y)
  923.     procedure Draw(x: integer := 0; y: integer := 0);
  924. /// Выводит рисунок в позиции (x,y) на поверхность рисования g
  925.     procedure Draw(x,y: integer; g: Graphics);
  926. /// Выводит рисунок в позиции (x,y), масштабируя его к размеру (w,h)
  927.     procedure Draw(x,y,w,h: integer);
  928. /// Выводит рисунок в позиции (x,y), масштабируя его к размеру (w,h), на поверхность рисования g
  929.     procedure Draw(x,y,w,h: integer; g: Graphics);
  930. /// Выводит часть рисунка, заключенную в прямоугольнике r, в позиции (x,y)
  931.     procedure Draw(x,y: integer; r: System.Drawing.Rectangle); // r - part of Picture
  932. /// Выводит часть рисунка, заключенную в прямоугольнике r, в позиции (x,y) на поверхность рисования g
  933.     procedure Draw(x,y: integer; r: System.Drawing.Rectangle; g: Graphics);
  934. /// Выводит часть рисунка, заключенную в прямоугольнике r, в позиции (x,y), масштабируя его к размеру (w,h)
  935.     procedure Draw(x,y,w,h: integer; r: System.Drawing.Rectangle); // r - part of Picture
  936. /// Выводит часть рисунка, заключенную в прямоугольнике r, в позиции (x,y), масштабируя его к размеру (w,h), на поверхность рисования g
  937.     procedure Draw(x,y,w,h: integer; r: System.Drawing.Rectangle; g: Graphics);
  938. /// Выводит рисунок, повернутый на угол rotateAngle, масштабируя его к размеру (w,h)
  939.     procedure Draw(x,y: integer; rotateAngle: real; w,h: integer);
  940. /// Копирует прямоугольник src рисунка p в прямоугольник dst текущего рисунка
  941.     procedure CopyRect(dst: System.Drawing.Rectangle; p: Picture; src: System.Drawing.Rectangle);
  942. /// Копирует прямоугольник src битового образа bmp в прямоугольник dst текущего рисунка
  943.     procedure CopyRect(dst: System.Drawing.Rectangle; bmp: Bitmap; src: System.Drawing.Rectangle);
  944. /// Зеркально отображает рисунок относительно горизонтальной оси симметрии
  945.     procedure FlipHorizontal;
  946. /// Зеркально отображает рисунок относительно вертикальной оси симметрии
  947.     procedure FlipVertical;
  948.  
  949. /// Закрашивает пиксел (x,y) рисунка цветом c
  950.     procedure SetPixel(x,y: integer; c: Color);
  951. /// Закрашивает пиксел (x,y) рисунка цветом c
  952.     procedure PutPixel(x,y: integer; c: Color);
  953. /// Возвращает цвет пиксела (x,y) рисунка
  954.     function GetPixel(x,y: integer): Color;
  955.  
  956. /// Выводит на рисунке отрезок от точки (x1,y1) до точки (x2,y2)
  957.     procedure Line(x1,y1,x2,y2: integer);
  958. /// Выводит на рисунке отрезок от точки (x1,y1) до точки (x2,y2) цветом c
  959.     procedure Line(x1,y1,x2,y2: integer; c: Color);
  960.  
  961. /// Заполняет на рисунке внутренность окружности с центром (x,y) и радиусом r
  962.     procedure FillCircle(x,y,r: integer);
  963. /// Выводит на рисунке окружность с центром (x,y) и радиусом r
  964.     procedure DrawCircle(x,y,r: integer);
  965. /// Заполняет на рисунке внутренность эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
  966.     procedure FillEllipse(x1,y1,x2,y2: integer);
  967. /// Выводит на рисунке границу эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
  968.     procedure DrawEllipse(x1,y1,x2,y2: integer);
  969. /// Заполняет на рисунке внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
  970.     procedure FillRectangle(x1,y1,x2,y2: integer);
  971. /// Заполняет на рисунке внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
  972.     procedure FillRect(x1,y1,x2,y2: integer);
  973. /// Выводит на рисунке границу ы прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
  974.     procedure DrawRectangle(x1,y1,x2,y2: integer);
  975.  
  976. /// Выводит на рисунке заполненную окружность с центром (x,y) и радиусом r
  977.     procedure Circle(x,y,r: integer);
  978. /// Выводит на рисунке заполненный эллипс, ограниченный прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
  979.     procedure Ellipse(x1,y1,x2,y2: integer);
  980. /// Выводит на рисунке заполненный прямоугольник, заданный координатами противоположных вершин (x1,y1) и (x2,y2)
  981.     procedure Rectangle(x1,y1,x2,y2: integer);
  982. /// Выводит на рисунке заполненный прямоугольник со скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
  983.     procedure RoundRect(x1,y1,x2,y2,w,h: integer);
  984.  
  985. /// Выводит на рисунке дугу окружности с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
  986.     procedure Arc(x,y,r,a1,a2: integer);
  987. /// Заполняет на рисунке внутренность сектора окружности, ограниченного дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
  988.     procedure FillPie(x,y,r,a1,a2: integer);
  989. /// Выводит на рисунке сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
  990.     procedure DrawPie(x,y,r,a1,a2: integer);
  991. /// Выводит на рисунке заполненный сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
  992.     procedure Pie(x,y,r,a1,a2: integer);
  993.  
  994. /// Выводит на рисунке замкнутую ломаную по точкам, координаты которых заданы в массиве points
  995.     procedure DrawPolygon(points: array of Point);
  996. /// Заполняет на рисунке многоугольник, координаты вершин которого заданы в массиве points
  997.     procedure FillPolygon(points: array of Point);
  998. /// Выводит на рисунке заполненный многоугольник, координаты вершин которого заданы в массиве points
  999.     procedure Polygon(points: array of Point);
  1000. /// Выводит на рисунке ломаную по точкам, координаты которых заданы в массиве points
  1001.     procedure Polyline(points: array of Point);
  1002. /// Выводит на рисунке кривую по точкам, координаты которых заданы в массиве points
  1003.     procedure Curve(points: array of Point);
  1004. /// Выводит на рисунке замкнутую кривую по точкам, координаты которых заданы в массиве points
  1005.     procedure DrawClosedCurve(points: array of Point);
  1006. /// Заполняет на рисунке замкнутую кривую по точкам, координаты которых заданы в массиве points
  1007.     procedure FillClosedCurve(points: array of Point);
  1008. /// Выводит на рисунке заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
  1009.     procedure ClosedCurve(points: array of Point);
  1010.  
  1011. /// Выводит на рисунке строку s в прямоугольник к координатами левого верхнего угла (x,y)
  1012.     procedure TextOut(x,y: integer; s: string);
  1013. /// Заливает на рисунке область одного цвета цветом c, начиная с точки (x,y).
  1014.     procedure FloodFill(x,y: integer; c: Color);
  1015.    
  1016. /// Очищает рисунок белым цветом
  1017.     procedure Clear;
  1018. /// Очищает рисунок цветом c
  1019.     procedure Clear(c: Color);
  1020.   end;
  1021.  
  1022. type
  1023.   ABCControl = class(Control)
  1024.   private
  1025.     procedure OnPaint(sender: Object; e: PaintEventArgs);
  1026.     procedure OnClosing(sender: Object; e: FormClosingEventArgs);
  1027.     procedure OnMouseDown(sender: Object; e: MouseEventArgs);
  1028.     procedure OnMouseUp(sender: Object; e: MouseEventArgs);
  1029.     procedure OnMouseMove(sender: Object; e: MouseEventArgs);
  1030.     procedure OnKeyDown(sender: Object; e: KeyEventArgs);
  1031.     procedure OnKeyUp(sender: Object; e: KeyEventArgs);
  1032.     procedure OnKeyPress(sender: Object; e: KeyPressEventArgs);
  1033.     procedure OnResize(sender: Object; e: EventArgs);
  1034.     procedure Init;
  1035.   protected
  1036.     function IsInputKey(keyData: Keys): boolean; override;
  1037.     procedure OnPaintBackground(e: PaintEventArgs); override; begin end; // сами все перерисовываем!
  1038.   public  
  1039.     constructor (w,h: integer);
  1040.   end;
  1041.  
  1042. /// Создает рисунок размера w на h пикселов и записывает его в переменную p
  1043. procedure CreatePicture(var p: Picture; w,h: integer);
  1044. /// Возвращает окно графического приложения
  1045. function Window: GraphABCWindow;
  1046. /// Возвращает главную форму графического приложения
  1047. function MainForm: Form;
  1048. /// Возвращает графический компонент
  1049. function GraphABCControl: ABCControl;
  1050. /// Возвращает текущее перо
  1051. function Pen: GraphABCPen;
  1052. /// Возвращает текущую кисть
  1053. function Brush: GraphABCBrush;
  1054. /// Возвращает текущий шрифт
  1055. function Font: GraphABCFont;
  1056. /// Возвращает систему координат GraphABC
  1057. function Coordinate: GraphABCCoordinate;
  1058. /// Строка статуса
  1059. function StatusBar: GraphABCStatus;
  1060.  
  1061. function GraphWindowGraphics: Graphics;
  1062. function GraphBufferGraphics: Graphics;
  1063. function GraphBufferBitmap: Bitmap;
  1064.  
  1065. /// Устанавливает консольный ввод-вывод
  1066. procedure SetConsoleIO;
  1067. /// Устанавливает ввод-вывод через графическое окно (по умолчанию)
  1068. procedure SetGraphABCIO;
  1069.  
  1070. var
  1071. /// Событие нажатия на кнопку мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 1, если нажата левая кнопка мыши, и 2, если нажата правая кнопка мыши
  1072.   OnMouseDown: procedure (x,y,mousebutton: integer);
  1073. /// Событие отжатия кнопки мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 1, если отжата левая кнопка мыши, и 2, если отжата правая кнопка мыши
  1074.   OnMouseUp: procedure (x,y,mousebutton: integer);
  1075. /// Событие перемещения мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 0, если кнопка мыши не нажата, 1, если нажата левая кнопка мыши, и 2, если нажата правая кнопка мыши
  1076.   OnMouseMove: procedure (x,y,mousebutton: integer);
  1077. /// Событие нажатия клавиши
  1078.   OnKeyDown: procedure (key: integer);
  1079. /// Событие отжатия клавиши
  1080.   OnKeyUp: procedure (key: integer);
  1081. /// Событие нажатия символьной клавиши
  1082.   OnKeyPress: procedure (ch: char);
  1083. /// Событие изменения размера графического окна
  1084.   OnResize: procedure;
  1085. /// Событие закрытия графического окна
  1086.   OnClose: procedure;
  1087.  
  1088. /// Процедурная переменная перерисовки графического окна. Если равна nil, то используется стандартная перерисовка
  1089.   RedrawProc: procedure;
  1090. /// Следует ли рисовать во внеэкранном буфере
  1091.   DrawInBuffer: boolean;
  1092.  
  1093. ///--  
  1094. procedure __InitModule__;
  1095.  
  1096. implementation
  1097.  
  1098. uses
  1099.   System.Threading,
  1100.   GraphABCHelper;
  1101.      
  1102. const
  1103.   FILE_NOT_FOUND_MESSAGE = 'Файл {0} не найден';
  1104.   BUTTON_ENTER_TEXT = 'Ввести';
  1105.  
  1106. type
  1107.   Proc1Integer = procedure(x: integer);
  1108.   Proc1String = procedure(s: string);
  1109.   Proc2Integer = procedure(x,y: integer);
  1110.   Proc1Boolean = procedure(b: boolean);
  1111.   Proc1BorderStyle = procedure(st: FormBorderStyle);
  1112.  
  1113.   IOGraphABCSystem = class(IOStandardSystem)
  1114.   public
  1115.     constructor Create;
  1116. //    procedure write(p: pointer);     override;
  1117.     procedure write(obj: object);    override;
  1118.     procedure writeln;               override;
  1119.     function read_symbol: char;      override;
  1120.     function peek: integer;          override;
  1121.   end;
  1122.  
  1123. function SetProcessDPIAware(): boolean; external 'user32.dll';
  1124.  
  1125. var
  1126.   // строка-буфер ввода
  1127.   MainThread: Thread;
  1128.   // строка-буфер ввода
  1129.   readbuffer: string;
  1130.   _Window: GraphABCWindow := new GraphABCWindow;
  1131.   _MainForm: Form;
  1132.   _GraphABCControl: ABCControl;
  1133.   _Pen := new GraphABCPen;
  1134.   _Brush := new GraphABCBrush;
  1135.   _Font := new GraphABCFont;
  1136.   _Coordinate := new GraphABCCoordinate;
  1137.   _StatusBar := new GraphABCStatus;
  1138.  
  1139.   __buffer: Bitmap;
  1140.   bmp: Bitmap;
  1141.   gr: Graphics;
  1142.   gbmp: Graphics;
  1143.  
  1144.   f: ABCControl;
  1145.   ed: TextBox;
  1146.   IOPanel: Panel;
  1147.   EnterButton: Button;
  1148.  
  1149.   CurrentSolidBrush: SolidBrush;
  1150.   CurrentHatchBrush: HatchBrush;
  1151.   CurrentGradientBrush: LinearGradientBrush;
  1152.   PixelBrush: SolidBrush;
  1153.  
  1154.   // For MoveTo, LineTo
  1155.   x_coord,y_coord: integer;
  1156.   NotLockDrawing: boolean;
  1157.  
  1158.   StartIsComplete: boolean;
  1159.   MainFormThread: System.Threading.Thread;
  1160.  
  1161.   // coords for write
  1162.   writecoords: Point := new Point(1,1);
  1163.   // font for write
  1164. //  CurrentWriteFont: System.Drawing.Font;
  1165.   // format for TextWidth
  1166.   sf: StringFormat;
  1167.  
  1168. // ------------ IOGraphABCSystem -----------------
  1169. constructor IOGraphABCSystem.Create;
  1170. begin
  1171.   lock f do
  1172.   begin
  1173. {    var fnt := _GraphABC.Font.NETFont;
  1174.     _GraphABC.Font.NETFont := CurrentWriteFont;
  1175.     _GraphABC.Font.NETFont := fnt;}
  1176.     readbuffer := '';
  1177.   end;  
  1178. end;
  1179.  
  1180. procedure NextLine;
  1181. begin
  1182.   writecoords.X := 1;
  1183.   writecoords.Y += TextHeight('a')-1;
  1184.   if writecoords.Y > Window.Height then
  1185.   begin
  1186.     writecoords.Y := 1;
  1187.   end;
  1188. end;
  1189.  
  1190. procedure IOGraphABCSystem.write(obj: object);
  1191.  
  1192.  function CountSymBeforeDivision(s: string): integer;
  1193.  begin
  1194.    var tw := TextWidth(s);
  1195.    var rem := Window.Width - writecoords.X;
  1196.    if rem = 0 then
  1197.      Result := 0
  1198.    else if tw <= rem then // строка влазит полностью
  1199.      Result := Length(s)
  1200.    else  
  1201.    begin
  1202.      // ns - примерное количество символов до переноса
  1203.      var ns := Round(Length(s)*rem/TextWidth(s));
  1204.      if ns>Length(s) then
  1205.        ns := Length(s);
  1206.      tw := TextWidth(s.Substring(0,ns));
  1207.      if tw > rem then
  1208.        while tw > rem do
  1209.        begin // начинаем уменьшать ns, пока не влезет
  1210.          ns -= 1;
  1211.          tw := TextWidth(s.Substring(0,ns));
  1212.        end
  1213.      else if tw = rem then
  1214.      begin
  1215.        // ничего не делать
  1216.      end
  1217.      else
  1218.      begin // tw < rem
  1219.        // увеличиваем ns
  1220.        while (ns<Length(s)) and (tw<rem) do
  1221.        begin
  1222.          ns += 1;
  1223.          tw := TextWidth(s.Substring(0,ns));
  1224.        end;
  1225.        if tw>rem then
  1226.          ns -= 1;
  1227.      end;
  1228.      Result := ns;
  1229.    end;
  1230.  end;
  1231.  
  1232.  procedure InternalWrite(s: string);
  1233.  begin
  1234.     var cs := CountSymBeforeDivision(s);
  1235.     if cs = Length(s) then
  1236.     begin
  1237.       TextOut(writecoords.X-1,writecoords.Y-1,s);
  1238.       var w := TextWidth(s)-1;
  1239.       writecoords.X += w;
  1240.     end
  1241.     else
  1242.     begin
  1243.       var srem := s.Substring(cs,s.Length-cs);
  1244.       s := s.Substring(0,cs);
  1245.       TextOut(writecoords.X-1,writecoords.Y-1,s);
  1246.       NextLine;
  1247.       InternalWrite(srem);
  1248.     end;
  1249.  end;
  1250.  
  1251. begin
  1252.   var s := _ObjectToString(obj);
  1253.   lock f do
  1254.   begin
  1255.     //var fnt := _GraphABC.Font.NETFont;
  1256. //    _GraphABC.Font.NETFont := CurrentWriteFont;
  1257.     InternalWrite(s);
  1258. //    _GraphABC.Font.NETFont := fnt;
  1259.   end;  
  1260. end;
  1261.  
  1262. procedure IOGraphABCSystem.writeln;
  1263. begin
  1264.   NextLine
  1265. end;
  1266.  
  1267. procedure SetIOPanelVisible;
  1268. begin
  1269.   ed.Text := '';
  1270.   IOPanel.Visible := True;
  1271.   MainForm.Height := MainForm.Height + ed.Height;
  1272.   MainForm.ActiveControl := ed;
  1273. end;
  1274.  
  1275. procedure SetIOPanelInVisible;
  1276. begin
  1277.   IOPanel.Visible := False;
  1278.   MainForm.ActiveControl := f;
  1279.   MainForm.Height := MainForm.Height - ed.Height;
  1280. end;
  1281.  
  1282. function IOGraphABCSystem.read_symbol: char;
  1283. begin
  1284.   if readbuffer.Length=0 then
  1285.   begin
  1286.     IOPanel.Invoke(SetIOPanelVisible);
  1287.     // приостановить основной поток
  1288.     MainThread.Suspend;
  1289.   end;
  1290.   Result := readBuffer[1];
  1291.   readBuffer := readBuffer.Remove(0,1);
  1292. end;
  1293.  
  1294. function IOGraphABCSystem.peek: integer;
  1295. begin
  1296.   if readbuffer.Length=0 then
  1297.   begin
  1298.     IOPanel.Invoke(SetIOPanelVisible);
  1299.     // приостановить основной поток
  1300.     MainThread.Suspend;
  1301.   end;
  1302.   Result := integer(readBuffer[1]);
  1303. end;
  1304.  
  1305. // ------------ GraphABCCoordinate -----------------
  1306. constructor GraphABCCoordinate.Create;
  1307. begin
  1308.   // 1 - компьютерная система координат (ось OY - вниз)
  1309.   // -1 - компьютерная система координат (ось OY - вниз)
  1310.   coef := 1;
  1311. end;
  1312.  
  1313. procedure GraphABCCoordinate.SetTransform(x0,y0,angle,sx,sy: real);
  1314. begin
  1315.   sx := abs(sx);
  1316.   sy := abs(sy);
  1317.   angle := DegToRad(angle);
  1318.   var m11 := sx * cos(angle);
  1319.   var m12 := coef * sx * sin(angle);
  1320.   var m21 := - sy * sin(angle);
  1321.   var m22 := coef * sy * cos(angle);
  1322.   var m := new System.Drawing.Drawing2D.Matrix(m11,m12,m21,m22,x0,y0);
  1323.   lock f do
  1324.   begin
  1325.     gr.Transform := m;
  1326.     gbmp.Transform := m;
  1327.   end;
  1328. end;
  1329.  
  1330. procedure GraphABCCoordinate.SetOrigin(x0,y0: integer);
  1331. begin
  1332.   SetTransform(x0,y0,Angle,ScaleX,ScaleY);
  1333. end;
  1334.  
  1335. procedure GraphABCCoordinate.SetScale(sx,sy: real);
  1336. begin
  1337.   SetTransform(OriginX,OriginY,Angle,sx,sy);
  1338. end;
  1339.  
  1340. procedure GraphABCCoordinate.SetScale(scale: real);
  1341. begin
  1342.   SetScale(scale,scale);
  1343. end;
  1344.  
  1345. procedure GraphABCCoordinate.SetMathematic;
  1346. begin
  1347.   coef := -1;
  1348.   SetTransform(OriginX,OriginY,Angle,ScaleX,ScaleY);
  1349. end;
  1350.  
  1351. procedure GraphABCCoordinate.SetStandard;
  1352. begin
  1353.   coef := 1;
  1354.   SetTransform(OriginX,OriginY,Angle,ScaleX,ScaleY);
  1355. end;
  1356.  
  1357. procedure GraphABCCoordinate.ScaleOn(scale: real);
  1358. begin
  1359.   lock f do
  1360.   begin
  1361.     gr.ScaleTransform(scale,scale);
  1362.     gbmp.ScaleTransform(scale,scale);
  1363.   end;
  1364. end;
  1365.  
  1366. procedure GraphABCCoordinate.Transform(x,y: real);
  1367. begin
  1368.   lock f do
  1369.   begin
  1370.     gr.TranslateTransform(x,y);
  1371.     gbmp.TranslateTransform(x,y)
  1372.   end;
  1373. end;
  1374.  
  1375. procedure GraphABCCoordinate.Rotate(angle: real);
  1376. begin
  1377.   lock f do
  1378.   begin
  1379.     gr.RotateTransform(angle);
  1380.     gbmp.RotateTransform(angle);
  1381.   end;
  1382. end;
  1383.  
  1384. procedure GraphABCCoordinate.ClearMatrix;
  1385. begin
  1386.   lock f do
  1387.   begin
  1388.     gr.Transform := new System.Drawing.Drawing2D.Matrix();
  1389.     gbmp.Transform := new System.Drawing.Drawing2D.Matrix();
  1390.   end;
  1391. end;
  1392.  
  1393. procedure GraphABCCoordinate.SetOriginX(x: integer);
  1394. begin
  1395.   SetOrigin(x,OriginY);
  1396. end;
  1397.  
  1398. procedure GraphABCCoordinate.SetOriginY(y: integer);
  1399. begin
  1400.   SetOrigin(OriginX,y);
  1401. end;
  1402.  
  1403. procedure GraphABCCoordinate.SetOrigin(p: Point);
  1404. begin
  1405.   SetOrigin(p.x,p.y);
  1406. end;
  1407.  
  1408. procedure GraphABCCoordinate.SetAngle(a: real);
  1409. begin
  1410.   SetTransform(OriginX,OriginY,a,ScaleX,ScaleY);
  1411. end;
  1412.  
  1413. procedure GraphABCCoordinate.SetScaleX(sx: real);
  1414. begin
  1415.   SetScale(sx,ScaleY);
  1416. end;
  1417.  
  1418. procedure GraphABCCoordinate.SetScaleY(sy: real);
  1419. begin
  1420.   SetScale(ScaleX,sy);
  1421. end;
  1422.  
  1423. function GraphABCCoordinate.GetOriginX: integer;
  1424. begin
  1425.   lock (f) do
  1426.     Result := Round(gr.Transform.OffsetX);
  1427. end;
  1428.  
  1429. function GraphABCCoordinate.GetOrigin: Point;
  1430. begin
  1431.   Result := new Point(GetOriginX,GetOriginY);
  1432. end;
  1433.  
  1434. function GraphABCCoordinate.GetOriginY: integer;
  1435. begin
  1436.   lock(f) do
  1437.     Result := Round(gr.Transform.OffsetY);
  1438. end;
  1439.  
  1440. function GraphABCCoordinate.GetAngle: real;
  1441. begin
  1442.   var a := Coordinate.Matrix.Elements;
  1443.   Result := ArcSin(a[1]/ScaleY);
  1444.   if a[0]<0 then
  1445.     if a[1]>0 then
  1446.       Result := Pi - Result
  1447.     else Result := -Pi - Result;
  1448.   Result *= coef * 180/Pi;
  1449. end;
  1450.  
  1451. function GraphABCCoordinate.GetScaleX: real;
  1452. begin
  1453.   var a := Coordinate.Matrix.Elements;
  1454.   Result := sqrt(sqr(a[0])+sqr(a[1]));
  1455. end;
  1456.  
  1457. function GraphABCCoordinate.GetScaleY: real;
  1458. begin
  1459.   var a := Coordinate.Matrix.Elements;
  1460.   Result := sqrt(sqr(a[2])+sqr(a[3]));
  1461. end;
  1462.  
  1463. function GraphABCCoordinate.GetMatrix: System.Drawing.Drawing2D.Matrix;
  1464. begin
  1465.   lock (f) do
  1466.     Result := gr.Transform;
  1467. end;
  1468.  
  1469. procedure SetCoordinateOrigin(x0,y0: integer);
  1470. begin
  1471.   Coordinate.SetOrigin(x0,y0);
  1472. end;
  1473.  
  1474. procedure SetCoordinateScale(sx,sy: real);
  1475. begin
  1476.   Coordinate.SetScale(sx,sy);
  1477. end;
  1478.  
  1479. procedure SetCoordinateAngle(a: real);
  1480. begin
  1481.   Coordinate.Angle := a;
  1482. end;
  1483.  
  1484. {function CurrentABCWindow: ABCWindow;
  1485. begin
  1486.   Result := f;
  1487. end;  }
  1488.  
  1489. procedure LockGraphics;
  1490. begin
  1491.   Monitor.Enter(f);
  1492. end;
  1493.  
  1494. procedure UnLockGraphics;
  1495. begin
  1496.   Monitor.Exit(f);
  1497. end;
  1498.  
  1499. procedure SetSmoothingOn;
  1500. begin
  1501.   gr.SmoothingMode := SmoothingMode.AntiAlias;
  1502.   gbmp.SmoothingMode := SmoothingMode.AntiAlias;
  1503. end;
  1504.  
  1505. procedure SetSmoothingOff;
  1506. begin
  1507.   gr.SmoothingMode := SmoothingMode.None;
  1508.   gbmp.SmoothingMode := SmoothingMode.None;
  1509. end;
  1510.  
  1511. procedure SetSmoothing(sm: boolean);
  1512. begin
  1513.   if sm then
  1514.     SetSmoothingOn
  1515.   else SetSmoothingOff;  
  1516. end;
  1517.  
  1518. function SmoothingIsOn: boolean;
  1519. begin
  1520.   Result := gr.SmoothingMode = SmoothingMode.AntiAlias;
  1521. end;
  1522.  
  1523. function GraphWindowGraphics: Graphics;
  1524. begin
  1525.   Result := gr;
  1526. end;
  1527.  
  1528. function GraphBufferGraphics: Graphics;
  1529. begin
  1530.   Result := gbmp;
  1531. end;
  1532.  
  1533. function GraphBufferBitmap: Bitmap;
  1534. begin
  1535.   Result := bmp;
  1536. end;
  1537.  
  1538. procedure Swap(var x1,x2: integer);
  1539. begin
  1540.   var t := x1;
  1541.   x1 := x2;
  1542.   x2 := t;
  1543. end;
  1544.  
  1545. // Graphics Primitives
  1546. // ------------ __MyPen -----------------
  1547. procedure GraphABCPen.SetColor(c: _GraphABC.Color);
  1548. begin
  1549.   SetPenColor(c);
  1550. end;
  1551.  
  1552. function GraphABCPen.GetColor: _GraphABC.Color;
  1553. begin
  1554.   Result := PenColor;
  1555. end;
  1556.  
  1557. procedure GraphABCPen.SetWidth(w: integer);
  1558. begin
  1559.   SetPenWidth(w);
  1560. end;
  1561.  
  1562. function GraphABCPen.GetWidth: integer;
  1563. begin
  1564.   Result := PenWidth;
  1565. end;
  1566.  
  1567. procedure GraphABCPen.SetStyle(st: DashStyle);
  1568. begin
  1569.   SetPenStyle(st);
  1570. end;
  1571.  
  1572. function GraphABCPen.GetStyle: DashStyle;
  1573. begin
  1574.   Result := PenStyle;
  1575. end;
  1576.  
  1577. procedure GraphABCPen.SetMode(m: integer);
  1578. begin
  1579.   SetPenMode(m);
  1580. end;
  1581.  
  1582. function GraphABCPen.GetMode: integer;
  1583. begin
  1584.   Result := PenMode;
  1585. end;
  1586.  
  1587. procedure GraphABCPen.SetNETPen(p: System.Drawing.Pen);
  1588. begin
  1589.   if p=nil then exit;
  1590.   _NETPen := p;
  1591. end;
  1592.  
  1593. function GraphABCPen.GetX: integer;
  1594. begin
  1595.   Result := PenX;
  1596. end;
  1597.  
  1598. function GraphABCPen.GetY: integer;
  1599. begin
  1600.   Result := PenY;
  1601. end;
  1602.  
  1603. //2015.01>
  1604. procedure GraphABCPen.SetRoundCap(isRoundCap: boolean);
  1605. begin
  1606.   SetPenRoundCap(isRoundCap);
  1607. end;
  1608.  
  1609. function GraphABCPen.GetRoundCap: boolean;
  1610. begin
  1611.   result := PenRoundCap;
  1612. end;  
  1613. //2015.01<    
  1614.  
  1615.  
  1616.  
  1617.  
  1618. //!!!!!!!!!!!!!!!!!!!!
  1619.  
  1620. // ------------ GraphABCBrush -----------------
  1621. procedure GraphABCBrush.SetNETBrush(b: System.Drawing.Brush);
  1622. begin
  1623.   //if b=nil then Exit;
  1624.   _NETBrush := b;
  1625. end;
  1626.  
  1627. procedure GraphABCBrush.SetColor(c: _GraphABC.Color);
  1628. begin
  1629.   SetBrushColor(c);
  1630. end;
  1631.  
  1632. function GraphABCBrush.GetColor: _GraphABC.Color;
  1633. begin
  1634.   Result := BrushColor;
  1635. end;
  1636.  
  1637. procedure GraphABCBrush.SetStyle(st: BrushStyleType);
  1638. begin
  1639.   SetBrushStyle(st);
  1640. end;
  1641.  
  1642. function GraphABCBrush.GetStyle: BrushStyleType;
  1643. begin
  1644.   Result := BrushStyle;
  1645. end;
  1646.  
  1647. procedure GraphABCBrush.SetHatch(h: HatchStyle);
  1648. begin
  1649.   SetBrushHatch(h);
  1650. end;
  1651.  
  1652. function GraphABCBrush.GetHatch: HatchStyle;
  1653. begin
  1654.   Result := BrushHatch;
  1655. end;
  1656.  
  1657. procedure GraphABCBrush.SetHatchBackgroundColor(c: _GraphABC.Color);
  1658. begin
  1659.   SetHatchBrushBackgroundColor(c);    
  1660. end;
  1661.  
  1662. function GraphABCBrush.GetHatchBackgroundColor: _GraphABC.Color;
  1663. begin
  1664.   Result := HatchBrushBackgroundColor;
  1665. end;
  1666.  
  1667. procedure GraphABCBrush.SetGradientSecondColor(c: _GraphABC.Color);
  1668. begin
  1669.   SetGradientBrushSecondColor(c);    
  1670. end;
  1671.  
  1672. function GraphABCBrush.GetGradientSecondColor: _GraphABC.Color;
  1673. begin
  1674.   Result := GradientBrushSecondColor;
  1675. end;
  1676.  
  1677. // ------------ GraphABCFont -----------------
  1678. procedure GraphABCFont.SetNETFont(f: System.Drawing.Font);
  1679. begin
  1680.   if f=nil then Exit;
  1681.   _NetFont := f;
  1682. end;
  1683.  
  1684. procedure GraphABCFont.SetColor(c: _GraphABC.Color);
  1685. begin
  1686.   SetFontColor(c);
  1687. end;
  1688.  
  1689. function GraphABCFont.GetColor: _GraphABC.Color;
  1690. begin
  1691.   Result := FontColor;
  1692. end;
  1693.  
  1694. procedure GraphABCFont.SetStyle(st: FontStyleType);
  1695. begin
  1696.   SetFontStyle(st);
  1697. end;
  1698.  
  1699. function GraphABCFont.GetStyle: FontStyleType;
  1700. begin
  1701.   Result := FontStyle;
  1702. end;
  1703.  
  1704. procedure GraphABCFont.SetSize(sz: integer);
  1705. begin
  1706.   SetFontSize(sz);
  1707. end;
  1708.  
  1709. function GraphABCFont.GetSize: integer;
  1710. begin
  1711.   Result := FontSize;
  1712. end;
  1713.  
  1714. procedure GraphABCFont.SetName(nm: string);
  1715. begin
  1716.   SetFontName(nm);
  1717. end;
  1718.  
  1719. function GraphABCFont.GetName: string;
  1720. begin
  1721.   Result := FontName;
  1722. end;
  1723.  
  1724. var _StatusStrip: System.Windows.Forms.StatusStrip := nil;
  1725.  
  1726. procedure AddStatusBarP;
  1727. begin
  1728.   _StatusStrip := new System.Windows.Forms.StatusStrip;
  1729.   _StatusStrip.Items.Add(new System.Windows.Forms.ToolStripStatusLabel);
  1730.   _StatusStrip.BackColor := Color.White;
  1731.   MainForm.Controls.Add(_StatusStrip);
  1732. end;
  1733.  
  1734. procedure AddStatusBar;
  1735. begin
  1736.   f.Invoke(AddStatusBarP);
  1737. end;
  1738.  
  1739. // GraphABCStatusPanel
  1740. constructor GraphABCStatusPanel.Create(pp: System.Windows.Forms.ToolStripStatusLabel);
  1741. begin
  1742.   p := pp
  1743. end;
  1744.  
  1745. procedure SetTextP(p: System.Windows.Forms.ToolStripStatusLabel; s: string);
  1746. begin
  1747.   p.Text := s
  1748. end;
  1749.  
  1750. procedure GraphABCStatusPanel.SetText(s: string);
  1751. begin
  1752.   f.Invoke(SetTextP,p,s)
  1753. end;
  1754.  
  1755. function GraphABCStatusPanel.GetText: string;
  1756. begin
  1757.   Result := p.Text
  1758. end;
  1759.  
  1760. procedure SetStatusTextP(s: string);
  1761. begin
  1762.   _StatusStrip.Items[0].Text := s
  1763. end;
  1764.  
  1765. // GraphABCStatus
  1766. procedure GraphABCStatus.SetText(s: string);
  1767. begin
  1768.   if (_StatusStrip=nil) or (_StatusStrip.Visible = False) then
  1769.     Show;
  1770.   f.Invoke(SetStatusTextP,s);  
  1771. end;
  1772.  
  1773. function GraphABCStatus.GetText: string;
  1774. begin
  1775.   if (_StatusStrip=nil) or (_StatusStrip.Visible = False) then
  1776.     Show;
  1777.   Result := _StatusStrip.Items[0].Text
  1778. end;
  1779.  
  1780. procedure SetPanelsCountP(n: integer);
  1781. begin
  1782.   if n<1 then n := 1;
  1783.   if n>10 then n := 10;
  1784.   if n>_StatusStrip.Items.Count then
  1785.   begin
  1786.     var d := n - _StatusStrip.Items.Count;
  1787.     for var i:=1 to d do
  1788.       _StatusStrip.Items.Add(new System.Windows.Forms.ToolStripStatusLabel);
  1789.   end;
  1790. end;
  1791.  
  1792. procedure GraphABCStatus.SetPanelsCount(n: integer);
  1793. begin
  1794.   if (_StatusStrip=nil) or (_StatusStrip.Visible = False) then
  1795.     Show;
  1796.   f.Invoke(SetPanelsCountP,n);      
  1797. end;
  1798.  
  1799. function GraphABCStatus.GetPanelsCount := _StatusStrip.Items.Count;
  1800.  
  1801. function GraphABCStatus.GetItem(i: integer): GraphABCStatusPanel;
  1802. begin
  1803.   if (_StatusStrip=nil) or (_StatusStrip.Visible = False) then
  1804.     Show;
  1805.   var p := _StatusStrip.Items[i] as System.Windows.Forms.ToolStripStatusLabel;
  1806.   Result := new GraphABCStatusPanel(p);
  1807. end;
  1808.  
  1809. procedure GraphABCStatus.Show;
  1810. begin
  1811.   if _StatusStrip<>nil then
  1812.    _StatusStrip.Visible := True
  1813.   else AddStatusBar  
  1814. end;
  1815.  
  1816. procedure PHide;
  1817. begin
  1818.   _StatusStrip.Visible := False;
  1819. end;
  1820.  
  1821. procedure GraphABCStatus.Hide;
  1822. begin
  1823.   f.Invoke(PHide);
  1824. end;
  1825.  
  1826. // Picture
  1827. constructor Picture.Create(w,h: integer);
  1828. begin
  1829.   if (w<=0) or (h<=0) then
  1830.     raise new GraphABCException('w or h <= 0');
  1831.   bmp := new Bitmap(w,h);
  1832.   gb := Graphics.FromImage(bmp);
  1833.   transpcolor := bmp.GetPixel(0,bmp.Height-1);
  1834.   istransp := false;
  1835.   savedbmp := nil;
  1836. end;
  1837.  
  1838. constructor Picture.Create(fname: string);
  1839. var
  1840.   tmp: Image;
  1841.   fs: System.IO.FileStream;
  1842. begin
  1843.   try
  1844.     fs := new System.IO.FileStream(fname, System.IO.FileMode.Open);
  1845.     tmp := Image.FromStream(fs);
  1846.     bmp := new Bitmap(tmp);
  1847.     fs.Flush;
  1848.     fs.Close;
  1849.     tmp.Dispose;
  1850.   except on ex: System.ArgumentException do
  1851.     raise new System.IO.FileNotFoundException(string.Format(FILE_NOT_FOUND_MESSAGE,fname));
  1852.   end;
  1853.    
  1854.   gb := Graphics.FromImage(bmp);  //!!!
  1855.   transpcolor := bmp.GetPixel(0,bmp.Height-1);
  1856.   istransp := false;
  1857.   savedbmp := nil;
  1858. end;
  1859.  
  1860. constructor Picture.Create(r: System.Drawing.Rectangle);
  1861. // Create from Screen
  1862. begin
  1863.   bmp := new Bitmap(r.Width,r.Height);
  1864.   gb := Graphics.FromImage(bmp);
  1865.   gb.CopyFromScreen(r.Left,r.Top,0,0,r.Size);
  1866.   transpcolor := bmp.GetPixel(0,bmp.Height-1);
  1867.   istransp := false;
  1868.   savedbmp := nil;
  1869. end;
  1870.  
  1871. procedure Picture.SetWidth(w: integer);
  1872. begin
  1873.   SetSize(w,Height);  
  1874. end;
  1875.  
  1876. function Picture.GetWidth: integer;
  1877. begin
  1878.   Result := bmp.Width;
  1879. end;
  1880.  
  1881. procedure Picture.SetHeight(h: integer);
  1882. begin
  1883.   SetSize(Width,h);  
  1884. end;
  1885.  
  1886. function Picture.GetHeight: integer;
  1887. begin
  1888.   Result := bmp.Height;
  1889. end;
  1890.  
  1891. {
  1892. // Логика установки прозрачности
  1893. // 1. Transparent := True  -  savedbmp:=bmp; bmp:=bmp.Clone; bmp.MakeTransparent(transpcolor);
  1894. // 2. Transparent := False  - bmp.Dispose; bmp := savedbmp; savedbmp := nil;
  1895. // 3. Transparentcolor := c
  1896. //   a) Если Transparent = False, то просто присвоить
  1897. //   б) Если Transparent = True, то bmp.Dispose; bmp:=savedbmp.Clone; bmp.MakeTransparent(transpcolor);
  1898. }
  1899. function Picture.GetTransparentColor: Color;
  1900. begin
  1901.   Result := transpcolor;
  1902. end;
  1903.  
  1904. procedure Picture.SetTransparentColor(c: Color);
  1905. var ob: Object;
  1906. begin
  1907.   if c=TransparentColor then
  1908.     Exit;
  1909.   transpcolor := c;
  1910.   if istransp then
  1911.   begin
  1912.     bmp.Dispose;
  1913.     ob := savedbmp.Clone;
  1914.     bmp := Bitmap(ob);
  1915.     bmp.MakeTransparent(transpcolor);
  1916.   end;
  1917. end;
  1918.  
  1919. procedure Picture.SetTransparent(b: boolean);
  1920. var ob: Object;
  1921. begin
  1922.   if b = istransp then
  1923.     Exit;
  1924.   istransp := b;  
  1925.   if istransp then
  1926.   begin
  1927.     savedbmp := bmp;
  1928.     ob := bmp.Clone;
  1929.     bmp := Bitmap(ob);
  1930.     bmp.MakeTransparent(transpcolor);  
  1931.   end
  1932.   else
  1933.   begin
  1934.     bmp.Dispose;
  1935.     bmp := savedbmp;
  1936.     savedbmp := nil;
  1937.   end;
  1938. end;
  1939.  
  1940. procedure Picture.Load(fname: string);
  1941. //2015.01>
  1942. var
  1943.   tmp: Image;
  1944.   fs: System.IO.FileStream;
  1945. //2015.01<
  1946. begin
  1947.   bmp.Dispose;
  1948. //2015.01>
  1949. //  bmp := new Bitmap(fname);
  1950.   try
  1951.     fs := new System.IO.FileStream(fname, System.IO.FileMode.Open);
  1952.     tmp := Image.FromStream(fs);
  1953.     bmp := new Bitmap(tmp);
  1954.     fs.Flush;
  1955.     fs.Close;
  1956.     tmp.Dispose;
  1957.   except on ex: System.ArgumentException do
  1958.     raise new System.IO.FileNotFoundException(string.Format(FILE_NOT_FOUND_MESSAGE,fname));
  1959.   end;
  1960. //2015.01<
  1961.   gb := Graphics.FromImage(bmp);
  1962.   istransp := False;
  1963.   if savedbmp<>nil then
  1964.   begin
  1965.     savedbmp.Dispose;
  1966.     savedbmp := nil;
  1967.   end;
  1968. end;
  1969.  
  1970. procedure Picture.Save(fname: string);
  1971. begin
  1972.   bmp.Save(fname);
  1973. end;
  1974.  
  1975. procedure Picture.SetSize(w,h: integer);
  1976. var oldbmp: Bitmap;
  1977. begin
  1978.   oldbmp := bmp;
  1979.   bmp := new Bitmap(oldbmp,w,h);
  1980.   gb := Graphics.FromImage(bmp);
  1981.   gb.DrawImage(oldbmp,0,0);
  1982.   oldbmp.Dispose;
  1983. // TODO не знаю, может, надо что-то делать для прозрачной
  1984. {  if istransp then
  1985.   begin
  1986.   end}
  1987. end;
  1988.  
  1989. function Picture.Intersect(p: Picture): boolean;
  1990. begin
  1991. //  bmp.L
  1992.   result := false;
  1993. // TODO
  1994. end;
  1995.  
  1996. procedure Picture.Draw(x,y: integer);
  1997. begin
  1998.   Monitor.Enter(f);
  1999.   if NotLockDrawing then
  2000.     gr.DrawImage(bmp,x,y,bmp.Width,bmp.Height);
  2001.   if DrawInBuffer then  
  2002.     gbmp.DrawImage(bmp,x,y,bmp.Width,bmp.Height);
  2003.   Monitor.Exit(f);
  2004. end;
  2005.  
  2006. procedure Picture.Draw(x,y: integer; g: Graphics);
  2007. begin
  2008.   g.DrawImage(bmp,x,y,bmp.Width,bmp.Height);
  2009. end;
  2010.  
  2011. procedure Picture.Draw(x,y,w,h: integer);
  2012. // Draw bmp scaled to size w,h
  2013. begin
  2014.   Monitor.Enter(f);
  2015.   if NotLockDrawing then
  2016.     gr.DrawImage(bmp,x,y,w,h);
  2017.   if DrawInBuffer then  
  2018.     gbmp.DrawImage(bmp,x,y,w,h);
  2019.   Monitor.Exit(f);
  2020. end;
  2021.  
  2022. procedure Picture.Draw(x,y,w,h: integer; g: Graphics);
  2023. // Draw bmp scaled to size w,h
  2024. begin
  2025.   g.DrawImage(bmp,x,y,w,h);
  2026. end;
  2027.  
  2028. procedure Picture.Draw(x,y: integer; r: System.Drawing.Rectangle);
  2029. // Draw bmp in rectangle r
  2030. begin
  2031.   Monitor.Enter(f);
  2032.   if NotLockDrawing then
  2033.     gr.DrawImage(bmp,x,y,r,GraphicsUnit.Pixel);
  2034.   if DrawInBuffer then  
  2035.     gbmp.DrawImage(bmp,x,y,r,GraphicsUnit.Pixel);
  2036.   Monitor.Exit(f);
  2037. end;
  2038.  
  2039. procedure Picture.Draw(x,y: integer; r: System.Drawing.Rectangle; g: Graphics);
  2040. begin
  2041.   g.DrawImage(bmp,x,y,r,GraphicsUnit.Pixel);
  2042. end;
  2043.  
  2044. procedure Picture.Draw(x,y,w,h: integer; r: System.Drawing.Rectangle);
  2045. // Draw rectangle r portion of bmp scaled to size w,h
  2046. var
  2047.   r1: System.Drawing.Rectangle;
  2048.   tempbmp: Bitmap;
  2049. begin
  2050.   r1 := new System.Drawing.Rectangle(x,y,w,h);
  2051.   tempbmp := GetView(bmp,r);
  2052.   Monitor.Enter(f);
  2053.   if NotLockDrawing then
  2054.     gr.DrawImage(tempbmp,r1);
  2055. //    gr.DrawImage(bmp,r1,r,GraphicsUnit.Pixel);
  2056.   if DrawInBuffer then  
  2057.     gbmp.DrawImage(tempbmp,r1);
  2058. //    gbmp.DrawImage(bmp,r1,r,GraphicsUnit.Pixel);
  2059.   Monitor.Exit(f);
  2060.   tempbmp.Dispose;
  2061. end;
  2062.  
  2063. procedure Picture.Draw(x,y,w,h: integer; r: System.Drawing.Rectangle; g: Graphics);
  2064. var tempbmp: Bitmap;
  2065. begin
  2066.   tempbmp := GetView(bmp,r);
  2067.   g.DrawImage(tempbmp,x,y,new System.Drawing.Rectangle(x,y,w,h),GraphicsUnit.Pixel);
  2068.   tempbmp.Dispose;
  2069. end;
  2070.  
  2071. procedure Picture.Draw(x,y: integer; rotateAngle: real; w,h: integer);
  2072. begin
  2073.   Monitor.Enter(f);
  2074.   var phi := (rotateAngle/360)*2*Pi;//угол в радианах
  2075.  
  2076.   //размер после поворота
  2077.   var new_w:integer := round(w*abs(cos(phi)) + h*abs(sin(phi)));
  2078.   var new_h:integer := round(w*abs(sin(phi)) + h*abs(cos(phi)));
  2079.  
  2080.   var newImg:Bitmap := new Bitmap(new_w, new_h);
  2081.   var g:Graphics := Graphics.FromImage(newImg);
  2082.  
  2083.   g.Clear(Color.FromArgb(0,0,0,0));
  2084.   g.TranslateTransform(new_w/2, new_h/2);
  2085.   g.RotateTransform(rotateAngle);
  2086.   g.TranslateTransform(-new_w/2, -new_h/2);
  2087.  
  2088.   g.DrawImage(bmp, (new_w-w)/2, (new_h-h)/2, w, h);
  2089.   //(x+w/2, y+h/2) - центр масштабированного изображения
  2090.   //(x+new_w/2, y+new_h/2) - центр масштабированного и повернутого изображения
  2091.   if NotLockDrawing then
  2092.     gr.DrawImage(newImg, x-(new_w-w)/2, y-(new_h-h)/2, new_w, new_h);
  2093.   if DrawInBuffer then
  2094.     gbmp.DrawImage(newImg, x-(new_w-w)/2, y-(new_h-h)/2, new_w, new_h);
  2095.   Monitor.Exit(f);
  2096. end;    
  2097.  
  2098. procedure Picture.CopyRect(dst: System.Drawing.Rectangle; p: Picture; src: System.Drawing.Rectangle);
  2099. // Copy src portion of p on dst rectangle of this picture  
  2100. begin
  2101.   CopyRect(dst,p.bmp,src);
  2102. end;
  2103.  
  2104. procedure Picture.CopyRect(dst: System.Drawing.Rectangle; bmp: Bitmap; src: System.Drawing.Rectangle);
  2105. var tempbmp: Bitmap;
  2106. begin
  2107. // Copy src portion of bmp on dst rectangle of this picture  
  2108.   tempbmp := GetView(bmp,src);
  2109. //  gb.DrawImage(bmp,dst,src,GraphicsUnit.Pixel);
  2110.   gb.DrawImage(tempbmp,dst);
  2111.   tempbmp.Dispose;
  2112. end;
  2113.  
  2114. procedure Picture.FlipHorizontal;
  2115. begin
  2116.   bmp.RotateFlip(RotateFlipType.RotateNoneFlipX);
  2117. end;
  2118.  
  2119. procedure Picture.FlipVertical;
  2120. begin
  2121.   bmp.RotateFlip(RotateFlipType.RotateNoneFlipY);
  2122. end;
  2123.  
  2124. procedure Picture.SetPixel(x,y: integer; c: Color);
  2125. begin
  2126.   bmp.SetPixel(x,y,c);
  2127. end;
  2128.  
  2129. procedure Picture.PutPixel(x,y: integer; c: Color);
  2130. begin
  2131.   bmp.SetPixel(x,y,c);
  2132. end;
  2133.  
  2134. function Picture.GetPixel(x,y: integer): Color;
  2135. begin
  2136.   Result := bmp.GetPixel(x,y);
  2137. end;
  2138.  
  2139. procedure Picture.Line(x1,y1,x2,y2: integer);
  2140. begin
  2141.   GraphABCHelper.Line(x1,y1,x2,y2,gb);
  2142. end;
  2143.  
  2144. procedure Picture.Line(x1,y1,x2,y2: integer; c: Color);
  2145. begin
  2146.   GraphABCHelper.Line(x1,y1,x2,y2,c,gb);
  2147. end;
  2148.  
  2149. procedure Picture.FillCircle(x,y,r: integer);
  2150. begin
  2151.   GraphABCHelper.FillEllipse(x-r,y-r,x+r,y+r,gb);
  2152. end;
  2153.  
  2154. procedure Picture.DrawCircle(x,y,r: integer);
  2155. begin
  2156.   GraphABCHelper.DrawEllipse(x-r,y-r,x+r,y+r,gb);
  2157. end;
  2158.  
  2159. procedure Picture.FillEllipse(x1,y1,x2,y2: integer);
  2160. begin
  2161.   GraphABCHelper.FillEllipse(x1,y1,x2,y2,gb);
  2162. end;
  2163.  
  2164. procedure Picture.DrawEllipse(x1,y1,x2,y2: integer);
  2165. begin
  2166.   GraphABCHelper.DrawEllipse(x1,y1,x2,y2,gb);
  2167. end;
  2168.  
  2169. procedure Picture.FillRectangle(x1,y1,x2,y2: integer);
  2170. begin
  2171.   GraphABCHelper.FillRectangle(x1,y1,x2,y2,gb);
  2172. end;
  2173.  
  2174. procedure Picture.FillRect(x1,y1,x2,y2: integer);
  2175. begin
  2176.   GraphABCHelper.FillRectangle(x1,y1,x2,y2,gb);
  2177. end;
  2178.  
  2179. procedure Picture.DrawRectangle(x1,y1,x2,y2: integer);
  2180. begin
  2181.   GraphABCHelper.DrawRectangle(x1,y1,x2,y2,gb);
  2182. end;
  2183.  
  2184. procedure Picture.Circle(x,y,r: integer);
  2185. begin
  2186.   GraphABCHelper.Ellipse(x-r,y-r,x+r,y+r,gb);
  2187. end;
  2188.  
  2189. procedure Picture.Ellipse(x1,y1,x2,y2: integer);
  2190. begin
  2191.   GraphABCHelper.Ellipse(x1,y1,x2,y2,gb);
  2192. end;
  2193.  
  2194. procedure Picture.Rectangle(x1,y1,x2,y2: integer);
  2195. begin
  2196.   GraphABCHelper.Rectangle(x1,y1,x2,y2,gb);  
  2197. end;
  2198.  
  2199. procedure Picture.RoundRect(x1,y1,x2,y2,w,h: integer);
  2200. begin
  2201.   GraphABCHelper.RoundRect(x1,y1,x2,y2,w,h,gb);  
  2202. end;
  2203.  
  2204. procedure Picture.Arc(x,y,r,a1,a2: integer);
  2205. begin
  2206.   GraphABCHelper.Arc(x,y,r,a1,a2,gb);
  2207. end;
  2208.  
  2209. procedure Picture.FillPie(x,y,r,a1,a2: integer);
  2210. begin
  2211.   GraphABCHelper.FillPie(x,y,r,a1,a2,gb);
  2212. end;
  2213.  
  2214. procedure Picture.DrawPie(x,y,r,a1,a2: integer);
  2215. begin
  2216.   GraphABCHelper.DrawPie(x,y,r,a1,a2,gb);
  2217. end;
  2218.  
  2219. procedure Picture.Pie(x,y,r,a1,a2: integer);
  2220. begin
  2221.   GraphABCHelper.Pie(x,y,r,a1,a2,gb);
  2222. end;
  2223.  
  2224. procedure Picture.DrawPolygon(points: array of Point);
  2225. begin
  2226.   GraphABCHelper.DrawPolygon(points,gb);
  2227. end;
  2228.  
  2229. procedure Picture.FillPolygon(points: array of Point);
  2230. begin
  2231.   GraphABCHelper.FillPolygon(points,gb);
  2232. end;
  2233.  
  2234. procedure Picture.Polygon(points: array of Point);
  2235. begin
  2236.   GraphABCHelper.Polygon(points,gb);
  2237. end;
  2238.  
  2239. procedure Picture.Polyline(points: array of Point);
  2240. begin
  2241.   GraphABCHelper.Polyline(points,gb);
  2242. end;
  2243.  
  2244. procedure Picture.Curve(points: array of Point);
  2245. begin
  2246.   GraphABCHelper.Curve(points,gb);
  2247. end;
  2248.  
  2249. procedure Picture.DrawClosedCurve(points: array of Point);
  2250. begin
  2251.   GraphABCHelper.DrawClosedCurve(points,gb);
  2252. end;
  2253.  
  2254. procedure Picture.FillClosedCurve(points: array of Point);
  2255. begin
  2256.   GraphABCHelper.FillClosedCurve(points,gb);
  2257. end;
  2258.  
  2259. procedure Picture.ClosedCurve(points: array of Point);
  2260. begin
  2261.   GraphABCHelper.ClosedCurve(points,gb);
  2262. end;
  2263.  
  2264. procedure Picture.TextOut(x,y: integer; s: string);
  2265. begin
  2266.   GraphABCHelper.TextOut(x,y,s,gb);
  2267. end;
  2268.  
  2269. function ExtFloodFill(hdc: IntPtr; x,y: integer; color: integer; filltype: integer): boolean; external 'Gdi32.dll' name 'ExtFloodFill';
  2270. function SelectObject(hdc, hgdiobj: IntPtr): IntPtr; external 'Gdi32.dll' name 'SelectObject';
  2271. function CreateSolidBrush(c: integer): IntPtr; external 'Gdi32.dll' name 'CreateSolidBrush';
  2272. function DeleteObject(obj: IntPtr): integer; external 'Gdi32.dll' name 'DeleteObject';
  2273. function CreateCompatibleDC(obj: IntPtr): IntPtr; external 'Gdi32.dll' name 'CreateCompatibleDC';
  2274.  
  2275. procedure Picture.FloodFill(x,y: integer; c: Color);  
  2276. var hdc,hBrush,hOldBrush: IntPtr;
  2277. begin
  2278.   var borderColor: Color := GetPixel(x,y);
  2279.  
  2280.   var bc := ColorTranslator.ToWin32(borderColor);
  2281.   var cc := ColorTranslator.ToWin32(c);
  2282.  
  2283.   Monitor.Enter(f);
  2284.  
  2285.   hdc := gbmp.GetHDC();
  2286.   hBrush := CreateSolidBrush(cc);
  2287.  
  2288.   hOldBrush := SelectObject(hdc, hBrush);
  2289.   ExtFloodFill(hdc, x, y, bc, 1);
  2290.   SelectObject(hdc, holdBrush);
  2291.  
  2292.   DeleteObject(hBrush);
  2293.  
  2294.   gbmp.ReleaseHdc();
  2295.  
  2296.   DeleteObject(hdc);
  2297.  
  2298.   Monitor.Exit(f);
  2299. end;
  2300.  
  2301. procedure Picture.Clear;
  2302. begin
  2303.   Monitor.Enter(f);
  2304.   gb.FillRectangle(Brushes.White,0,0,WindowWidth,WindowHeight);
  2305.   Monitor.Exit(f);
  2306. end;
  2307.  
  2308. procedure Picture.Clear(c: Color);
  2309. begin
  2310.   Monitor.Enter(f);
  2311.   gb.FillRectangle(new SolidBrush(c),0,0,WindowWidth,WindowHeight);
  2312.   Monitor.Exit(f);
  2313. end;
  2314.  
  2315. // ABCControl
  2316. function ABCControl.IsInputKey(keyData: Keys): boolean;
  2317. begin
  2318.   Result := True;
  2319. end;
  2320.  
  2321. procedure InitBMP;
  2322. begin
  2323.   var ww := ScreenWidth;
  2324.   var hh := ScreenHeight;
  2325.   bmp := new Bitmap(ww,hh,gr);
  2326.   gbmp := Graphics.FromImage(bmp);
  2327.   __buffer := bmp;
  2328.   gbmp.FillRectangle(Brushes.White,0,0,ww,hh);
  2329. end;
  2330.  
  2331. procedure ABCControl.Init;
  2332. begin
  2333.   BackColor := System.Drawing.Color.White;
  2334.   Dock := DockStyle.Fill;
  2335.  
  2336.   Paint += OnPaint;
  2337.   MouseDown += OnMouseDown;
  2338.   MouseUp += OnMouseUp;
  2339.   MouseMove += OnMouseMove;
  2340.   Resize += OnResize;
  2341.   KeyDown += OnKeyDown;
  2342.   KeyUp += OnKeyUp;
  2343.   KeyPress += OnKeyPress;
  2344.  
  2345. // These Events must be initialised in main form
  2346. //  FormClosing += OnClosing;
  2347.  
  2348. // Initialization of global vars
  2349.  
  2350.   Pen.NETPen := new System.Drawing.Pen(System.Drawing.Color.Black);
  2351.   _GraphABC.Font.NETFont := new System.Drawing.Font('Arial',10);
  2352.  
  2353.   PixelBrush := new SolidBrush(System.Drawing.Color.Black);
  2354.   CurrentSolidBrush := new SolidBrush(System.Drawing.Color.White);
  2355.   CurrentHatchBrush := new HatchBrush(HatchStyle.Cross,System.Drawing.Color.Black,System.Drawing.Color.White);
  2356.   CurrentGradientBrush := new LinearGradientBrush(new Point(0,0), new Point(600,600),System.Drawing.Color.Black,System.Drawing.Color.White);
  2357.   Brush.NETBrush := CurrentSolidBrush;
  2358.  
  2359. //  CurrentWriteFont := new System.Drawing.Font('Courier New',10);
  2360.  
  2361.   NotLockDrawing := True;
  2362.   DrawInBuffer := True;
  2363.   RedrawProc := nil;
  2364. end;
  2365.  
  2366. constructor ABCControl.Create(w,h: integer);
  2367. begin
  2368.   ClientSize := new System.Drawing.Size(w,h);
  2369.   Init;
  2370. end;
  2371.  
  2372. procedure ABCControl.OnPaint(sender: object; e: PaintEventArgs);
  2373. begin
  2374.   Monitor.Enter(f);
  2375.   if (e <> nil) and NotLockDrawing then
  2376.   begin
  2377.     if RedrawProc<>nil then
  2378.       RedrawProc
  2379.     else e.Graphics.DrawImage(bmp,0,0);
  2380.   end;  
  2381.   Monitor.Exit(f);
  2382. end;
  2383.  
  2384. procedure ABCControl.OnClosing(sender: object; e: FormClosingEventArgs);
  2385. begin
  2386.   if _GraphABC.OnClose<>nil then  
  2387.     _GraphABC.OnClose;
  2388.   NotLockDrawing := False;
  2389.   //Sleep(0);
  2390.   Halt;
  2391. end;
  2392.  
  2393. procedure ABCControl.OnMouseDown(sender: Object; e: MouseEventArgs);
  2394. type MouseButtons = System.Windows.Forms.MouseButtons;
  2395. var mb: integer;
  2396. begin
  2397.   if e.Button = MouseButtons.Left then
  2398.     mb := 1
  2399.   else if e.Button = MouseButtons.Right then
  2400.     mb := 2;
  2401.   if _GraphABC.OnMouseDown<>nil then  
  2402.     _GraphABC.OnMouseDown(e.x,e.y,mb);
  2403. end;
  2404.  
  2405. procedure ABCControl.OnMouseUp(sender: Object; e: MouseEventArgs);
  2406. type MouseButtons = System.Windows.Forms.MouseButtons;
  2407. var mb: integer;
  2408. begin
  2409.   if e.Button = MouseButtons.Left then
  2410.     mb := 1
  2411.   else if e.Button = MouseButtons.Right then
  2412.     mb := 2;
  2413.   if _GraphABC.OnMouseUp<>nil then  
  2414.     _GraphABC.OnMouseUp(e.x,e.y,mb);  
  2415. end;
  2416.  
  2417. procedure ABCControl.OnMouseMove(sender: Object; e: MouseEventArgs);
  2418. type MouseButtons = System.Windows.Forms.MouseButtons;
  2419. var mb: integer;
  2420. begin
  2421.   if e.Button = MouseButtons.Left then
  2422.     mb := 1
  2423.   else if e.Button = MouseButtons.Right then
  2424.     mb := 2;
  2425.   if _GraphABC.OnMouseMove<>nil then  
  2426.     _GraphABC.OnMouseMove(e.x,e.y,mb);  
  2427. end;
  2428.  
  2429. procedure ABCControl.OnKeyDown(sender: Object; e: KeyEventArgs);
  2430. begin
  2431.   if _GraphABC.OnKeyDown<>nil then  
  2432.     _GraphABC.OnKeyDown(integer(e.KeyCode));
  2433. end;
  2434.  
  2435. procedure ABCControl.OnKeyUp(sender: Object; e: KeyEventArgs);
  2436. begin
  2437.   if _GraphABC.OnKeyUp<>nil then  
  2438.     _GraphABC.OnKeyUp(integer(e.KeyCode));
  2439. end;
  2440.  
  2441. procedure ABCControl.OnKeyPress(sender: Object; e: KeyPressEventArgs);
  2442. begin
  2443.   if _GraphABC.OnKeyPress<>nil then  
  2444.     _GraphABC.OnKeyPress(e.KeyChar);
  2445. end;
  2446.  
  2447. procedure ResizeHelper;
  2448. begin
  2449.   Monitor.Enter(f);
  2450.   var t := gr.SmoothingMode;
  2451.   var m := gr.Transform;
  2452.   gr := Graphics.FromHwnd(f.Handle);
  2453.   gr.Transform := m;
  2454.   gr.SmoothingMode := t;
  2455.   Monitor.Exit(f);
  2456. end;
  2457.  
  2458. procedure ABCControl.OnResize(sender: Object; e: EventArgs);
  2459. begin
  2460.   ResizeHelper;
  2461.   if _GraphABC.OnResize<>nil then  
  2462.     _GraphABC.OnResize;
  2463. end;
  2464.  
  2465. // Extension methods
  2466. {procedure System.Drawing.Rectangle.MoveTo(x,y: integer);
  2467. begin
  2468.   Self.X := x;
  2469.   Self.Y := y;
  2470. end;}
  2471.  
  2472. {function operator implicit(Self: Point): (integer,integer); extensionmethod;
  2473. begin
  2474.   Result := (Self.X,Self.Y)
  2475. end;}
  2476.  
  2477. {function operator implicit(Self: (integer,integer)): Point; extensionmethod;
  2478. begin
  2479.   Result := new Point(Self[0],Self[1])
  2480. end;}
  2481.  
  2482. // Primitives
  2483. procedure SetPixel(x,y: integer; c: Color);
  2484. var b: boolean;
  2485. begin
  2486.   lock f do begin
  2487.     if NotLockDrawing then begin
  2488.       b := SmoothingIsOn;
  2489.       SetSmoothingOff;
  2490.       PixelBrush.Color := c;  
  2491.       gr.FillRectangle(PixelBrush,x,y,1,1);
  2492.       SetSmoothing(b);  
  2493.     end;
  2494.     if DrawInBuffer then  
  2495.       bmp.SetPixel(x,y,c);
  2496.   end;
  2497. end;
  2498.  
  2499. procedure PutPixel(x,y: integer; c: Color);
  2500. var b: boolean;
  2501. begin
  2502.   Monitor.Enter(f);
  2503.   b := SmoothingIsOn;
  2504.   SetSmoothingOff;
  2505.   PixelBrush.Color := c;
  2506.   if NotLockDrawing then
  2507.     gr.FillRectangle(PixelBrush,x,y,1,1);
  2508.   if DrawInBuffer then  
  2509.     gbmp.FillRectangle(PixelBrush,x,y,1,1);
  2510.   SetSmoothing(b);  
  2511.   Monitor.Exit(f);
  2512. end;
  2513.  
  2514. function GetPixel(x,y: integer): Color;
  2515. begin
  2516.   Monitor.Enter(f);
  2517.   Result := bmp.GetPixel(x,y);
  2518.   Monitor.Exit(f);
  2519. end;
  2520.  
  2521. procedure MoveTo(x,y: integer);
  2522. begin
  2523.   x_coord := x;
  2524.   y_coord := y;
  2525. end;
  2526.  
  2527. procedure MoveRel(dx,dy: integer);
  2528. begin
  2529.   x_coord += dx;
  2530.   y_coord += dy;
  2531. end;
  2532.  
  2533. procedure LineTo(x,y: integer);
  2534. begin
  2535.   Line(x_coord,y_coord,x,y);
  2536.   x_coord := x;
  2537.   y_coord := y;
  2538. end;
  2539.  
  2540. procedure LineTo(x,y: integer; c: Color);
  2541. begin
  2542.   Line(x_coord,y_coord,x,y,c);
  2543.   x_coord := x;
  2544.   y_coord := y;
  2545. end;
  2546.  
  2547. procedure LineRel(dx,dy: integer);
  2548. begin
  2549.   LineTo(x_coord + dx,y_coord + dy);
  2550. end;
  2551.  
  2552. procedure LineRel(dx,dy: integer; c: Color);
  2553. begin
  2554.   LineTo(x_coord + dx,y_coord + dy,c);
  2555. end;
  2556.  
  2557. procedure Line(x1,y1,x2,y2: integer; c: Color);
  2558. begin
  2559.   Monitor.Enter(f);
  2560.   if NotLockDrawing then
  2561.     Line(x1,y1,x2,y2,c,gr);
  2562.   if DrawInBuffer then  
  2563.     Line(x1,y1,x2,y2,c,gbmp);
  2564.   Monitor.Exit(f);
  2565. end;
  2566.  
  2567. procedure Line(p1,p2: Point; c: Color);
  2568. begin
  2569.   Line(p1.X,p1.Y,p2.X,p2.Y,c)
  2570. end;
  2571.  
  2572. procedure Line(x1,y1,x2,y2: integer);
  2573. begin
  2574.   Monitor.Enter(f);
  2575.   if NotLockDrawing then
  2576.     Line(x1,y1,x2,y2,gr);
  2577.   if DrawInBuffer then  
  2578.     Line(x1,y1,x2,y2,gbmp);
  2579.   Monitor.Exit(f);
  2580. end;
  2581.  
  2582. procedure Line(p1,p2: Point);
  2583. begin
  2584.   Line(p1.X,p1.Y,p2.X,p2.Y)
  2585. end;
  2586.  
  2587. procedure FillCircle(x,y,r: integer);
  2588. begin
  2589. // SSM 14.5.10
  2590.   FillEllipse(x-r,y-r,x+r+1,y+r+1);
  2591. end;
  2592.  
  2593. procedure DrawCircle(x,y,r: integer);
  2594. begin
  2595. // SSM 14.5.10
  2596.   DrawEllipse(x-r,y-r,x+r+1,y+r+1);
  2597. end;
  2598.  
  2599. procedure Circle(x,y,r: integer);
  2600. begin
  2601. // SSM 14.5.10
  2602.   Ellipse(x-r,y-r,x+r+1,y+r+1);
  2603. end;
  2604.  
  2605. procedure FillEllipse(x1,y1,x2,y2: integer);
  2606. begin
  2607.   Monitor.Enter(f);
  2608.   if NotLockDrawing then
  2609.     FillEllipse(x1,y1,x2,y2,gr);
  2610.   if DrawInBuffer then  
  2611.     FillEllipse(x1,y1,x2,y2,gbmp);
  2612.   Monitor.Exit(f);
  2613. end;
  2614.  
  2615. procedure DrawEllipse(x1,y1,x2,y2: integer);
  2616. begin
  2617.   Monitor.Enter(f);
  2618.   if NotLockDrawing then
  2619.     DrawEllipse(x1,y1,x2,y2,gr);
  2620.   if DrawInBuffer then  
  2621.     DrawEllipse(x1,y1,x2,y2,gbmp);
  2622.   Monitor.Exit(f);
  2623. end;
  2624.  
  2625. procedure Ellipse(x1,y1,x2,y2: integer);
  2626. begin
  2627.   if Brush.NETBrush <> nil then
  2628.     FillEllipse(x1,y1,x2,y2);
  2629.   if Pen.NETPen.DashStyle <> DashStyle.Custom then
  2630.     DrawEllipse(x1,y1,x2,y2);
  2631. end;
  2632.  
  2633. procedure FillRectangle(x1,y1,x2,y2: integer);
  2634. begin
  2635.   Monitor.Enter(f);
  2636.   if NotLockDrawing then
  2637.     FillRectangle(x1,y1,x2,y2,gr);
  2638.   if DrawInBuffer then  
  2639.     FillRectangle(x1,y1,x2,y2,gbmp);
  2640.   Monitor.Exit(f);
  2641. end;
  2642.  
  2643. procedure DrawRectangle(x1,y1,x2,y2: integer);
  2644. begin
  2645.   Monitor.Enter(f);
  2646.   if NotLockDrawing then
  2647.     DrawRectangle(x1,y1,x2,y2,gr);
  2648.   if DrawInBuffer then  
  2649.     DrawRectangle(x1,y1,x2,y2,gbmp);
  2650.   Monitor.Exit(f);
  2651. end;
  2652.  
  2653. procedure Rectangle(x1,y1,x2,y2: integer);
  2654. begin
  2655.   if x1>x2 then
  2656.     Swap(x1,x2);
  2657.   if y1>y2 then
  2658.     Swap(y1,y2);
  2659.   if Brush.NETBrush <> nil then
  2660.     FillRectangle(x1,y1,x2-1,y2-1);
  2661.   if Pen.NETPen.DashStyle <> DashStyle.Custom then
  2662.     DrawRectangle(x1,y1,x2,y2);
  2663. end;
  2664.  
  2665. procedure DrawRoundRect(x1,y1,x2,y2,w,h: integer);
  2666. begin
  2667.   Monitor.Enter(f);
  2668.   if NotLockDrawing then
  2669.     DrawRoundRect(x1,y1,x2,y2,w,h,gr);
  2670.   if DrawInBuffer then  
  2671.     DrawRoundRect(x1,y1,x2,y2,w,h,gbmp);
  2672.   Monitor.Exit(f);
  2673. end;
  2674.  
  2675. procedure FillRoundRect(x1,y1,x2,y2,w,h: integer);
  2676. begin
  2677.   Monitor.Enter(f);
  2678.   if NotLockDrawing then
  2679.     FillRoundRect(x1,y1,x2,y2,w,h,gr);
  2680.   if DrawInBuffer then  
  2681.     FillRoundRect(x1,y1,x2,y2,w,h,gbmp);
  2682.   Monitor.Exit(f);
  2683. end;
  2684.  
  2685. procedure RoundRect(x1,y1,x2,y2,w,h: integer);
  2686. begin
  2687.   if Brush.NETBrush <> nil then
  2688.     FillRoundRect(x1,y1,x2,y2,w,h);
  2689.   if Pen.NETPen.DashStyle <> DashStyle.Custom then
  2690.     DrawRoundRect(x1,y1,x2,y2,w,h);
  2691. end;
  2692.  
  2693. procedure Arc(x,y,r,a1,a2: integer);
  2694. begin
  2695.   Monitor.Enter(f);
  2696.   if NotLockDrawing then
  2697.     Arc(x,y,r,a1,a2,gr);
  2698.   if DrawInBuffer then  
  2699.     Arc(x,y,r,a1,a2,gbmp);
  2700.   Monitor.Exit(f);
  2701. end;
  2702.  
  2703. procedure FillPie(x,y,r,a1,a2: integer);
  2704. begin
  2705.   Monitor.Enter(f);
  2706.   if NotLockDrawing then
  2707.     FillPie(x,y,r,a1,a2,gr);
  2708.   if DrawInBuffer then  
  2709.     FillPie(x,y,r,a1,a2,gbmp);
  2710.   Monitor.Exit(f);
  2711. end;
  2712.  
  2713. procedure DrawPie(x,y,r,a1,a2: integer);
  2714. begin
  2715.   Monitor.Enter(f);
  2716.   if NotLockDrawing then
  2717.     DrawPie(x,y,r,a1,a2,gr);
  2718.   if DrawInBuffer then  
  2719.     DrawPie(x,y,r,a1,a2,gbmp);
  2720.   Monitor.Exit(f);
  2721. end;
  2722.  
  2723. procedure Pie(x,y,r,a1,a2: integer);
  2724. begin
  2725.   if Brush.NETBrush <> nil then
  2726.     FillPie(x,y,r,a1,a2);
  2727.   if Pen.NETPen.DashStyle <> DashStyle.Custom then
  2728.     DrawPie(x,y,r,a1,a2);
  2729. end;
  2730.  
  2731. procedure TextOut(x,y: integer; s: string);
  2732. begin
  2733.   Monitor.Enter(f);
  2734.   if NotLockDrawing then
  2735.     TextOut(x,y,s,gr);
  2736.   if DrawInBuffer then  
  2737.     TextOut(x,y,s,gbmp);
  2738.   Monitor.Exit(f);
  2739. end;
  2740.  
  2741. procedure TextOut(x,y: integer; n: integer);
  2742. begin
  2743.   TextOut(x,y,n.ToString);
  2744. end;
  2745.  
  2746. procedure TextOut(x,y: integer; r: real);
  2747. begin
  2748.   var nfi := new System.Globalization.NumberFormatInfo();
  2749.   nfi.NumberGroupSeparator := '.';
  2750.  
  2751.   TextOut(x,y,r.ToString(nfi));
  2752. end;
  2753.  
  2754. procedure DrawTextCentered(x,y,x1,y1: integer; s: string);
  2755. begin
  2756.   Monitor.Enter(f);
  2757.   if NotLockDrawing then
  2758.     DrawTextCentered(x,y,x1,y1,s,gr);
  2759.   if DrawInBuffer then  
  2760.     DrawTextCentered(x,y,x1,y1,s,gbmp);
  2761.   Monitor.Exit(f);
  2762. end;
  2763.  
  2764. procedure DrawTextCentered(x,y,x1,y1: integer; n: integer);
  2765. begin
  2766.   DrawTextCentered(x,y,x1,y1,n.ToString);  
  2767. end;
  2768.  
  2769. procedure DrawTextCentered(x,y,x1,y1: integer; r: real);
  2770. begin
  2771.   var nfi := new System.Globalization.NumberFormatInfo();
  2772.   nfi.NumberGroupSeparator := '.';
  2773.  
  2774.   DrawTextCentered(x,y,x1,y1,r.ToString(nfi));  
  2775. end;
  2776.  
  2777. procedure DrawTextCentered(x,y: integer; s: string);
  2778. begin
  2779.   Monitor.Enter(f);
  2780.   if NotLockDrawing then
  2781.     DrawTextCentered(x,y,s,gr);
  2782.   if DrawInBuffer then  
  2783.     DrawTextCentered(x,y,s,gbmp);
  2784.   Monitor.Exit(f);
  2785. end;
  2786.  
  2787. procedure DrawTextCentered(x,y: integer; n: integer);
  2788. begin
  2789.   DrawTextCentered(x,y,n.ToString);  
  2790. end;
  2791.  
  2792. procedure DrawTextCentered(x,y: integer; r: real);
  2793. begin
  2794.   var nfi := new System.Globalization.NumberFormatInfo();
  2795.   nfi.NumberGroupSeparator := '.';
  2796.  
  2797.   DrawTextCentered(x,y,r.ToString(nfi));  
  2798. end;
  2799.  
  2800.  
  2801. function Pnt(x,y: integer): Point;
  2802. begin
  2803.   Result := new Point(x,y);
  2804. end;
  2805.  
  2806. procedure DrawPolygon(points: array of Point);
  2807. begin
  2808.   Monitor.Enter(f);
  2809.   if NotLockDrawing then
  2810.     DrawPolygon(points,gr);
  2811.   if DrawInBuffer then  
  2812.     DrawPolygon(points,gbmp);
  2813.   Monitor.Exit(f);
  2814. end;
  2815.  
  2816. procedure DrawPolygon(params points: array of (integer,integer));
  2817. begin
  2818.   var pnts := points.Select(p -> Pnt(p[0],p[1]));
  2819.   DrawPolygon(pnts.ToArray);
  2820. end;
  2821.  
  2822. procedure FillPolygon(points: array of Point);
  2823. begin
  2824.   Monitor.Enter(f);
  2825.   if NotLockDrawing then
  2826.     FillPolygon(points,gr);
  2827.   if DrawInBuffer then  
  2828.     FillPolygon(points,gbmp);
  2829.   Monitor.Exit(f);
  2830. end;
  2831.  
  2832. procedure FillPolygon(params points: array of (integer,integer));
  2833. begin
  2834.   var pnts := points.Select(p -> Pnt(p[0],p[1]));
  2835.   FillPolygon(pnts.ToArray);
  2836. end;
  2837.  
  2838. procedure Polygon(points: array of Point);
  2839. begin
  2840.   if Brush.NETBrush <> nil then
  2841.     FillPolygon(points);
  2842.   if Pen.NETPen.DashStyle <> DashStyle.Custom then
  2843.     DrawPolygon(points);
  2844. end;
  2845.  
  2846. procedure Polygon(params points: array of (integer,integer));
  2847. begin
  2848.   var pnts := points.Select(p -> Pnt(p[0],p[1]));
  2849.   Polygon(pnts.ToArray);
  2850. end;
  2851.  
  2852. procedure Polyline(points: array of Point);
  2853. begin
  2854.   Monitor.Enter(f);
  2855.   if NotLockDrawing then
  2856.     Polyline(points,gr);
  2857.   if DrawInBuffer then  
  2858.     Polyline(points,gbmp);
  2859.   Monitor.Exit(f);
  2860. end;
  2861.  
  2862. procedure Polyline(params points: array of (integer,integer));
  2863. begin
  2864.   var pnts := points.Select(p -> Pnt(p[0],p[1]));
  2865.   Polyline(pnts.ToArray);
  2866. end;
  2867.  
  2868. procedure Curve(points: array of Point);
  2869. begin
  2870.   Monitor.Enter(f);
  2871.   if NotLockDrawing then
  2872.     Curve(points,gr);
  2873.   if DrawInBuffer then  
  2874.     Curve(points,gbmp);
  2875.   Monitor.Exit(f);
  2876. end;
  2877.  
  2878. procedure Curve(params points: array of (integer,integer));
  2879. begin
  2880.   var pnts := points.Select(p -> Pnt(p[0],p[1]));
  2881.   Curve(pnts.ToArray);
  2882. end;
  2883.  
  2884. procedure DrawClosedCurve(points: array of Point);
  2885. begin
  2886.   Monitor.Enter(f);
  2887.   if NotLockDrawing then
  2888.     DrawClosedCurve(points,gr);
  2889.   if DrawInBuffer then  
  2890.     DrawClosedCurve(points,gbmp);
  2891.   Monitor.Exit(f);
  2892. end;
  2893.  
  2894. procedure DrawClosedCurve(params points: array of (integer,integer));
  2895. begin
  2896.   var pnts := points.Select(p -> Pnt(p[0],p[1]));
  2897.   DrawClosedCurve(pnts.ToArray);
  2898. end;
  2899.  
  2900. procedure FillClosedCurve(points: array of Point);
  2901. begin
  2902.   Monitor.Enter(f);
  2903.   if NotLockDrawing then
  2904.     FillClosedCurve(points,gr);
  2905.   if DrawInBuffer then  
  2906.     FillClosedCurve(points,gbmp);
  2907.   Monitor.Exit(f);
  2908. end;
  2909.  
  2910. procedure FillClosedCurve(params points: array of (integer,integer));
  2911. begin
  2912.   var pnts := points.Select(p -> Pnt(p[0],p[1]));
  2913.   FillClosedCurve(pnts.ToArray);
  2914. end;
  2915.  
  2916. procedure ClosedCurve(points: array of Point);
  2917. begin
  2918.   Monitor.Enter(f);
  2919.   if NotLockDrawing then
  2920.     ClosedCurve(points,gr);
  2921.   if DrawInBuffer then  
  2922.     ClosedCurve(points,gbmp);
  2923.   Monitor.Exit(f);
  2924. end;
  2925.  
  2926. procedure ClosedCurve(params points: array of (integer,integer));
  2927. begin
  2928.   var pnts := points.Select(p -> Pnt(p[0],p[1]));
  2929.   ClosedCurve(pnts.ToArray);
  2930. end;
  2931.  
  2932. // Fills
  2933. procedure FloodFill(x,y: integer; c: Color);
  2934. var hdc,hBrush,hOldBrush: IntPtr;
  2935. begin
  2936.   var borderColor: Color := GetPixel(x,y);
  2937. //  var bc: integer := integer(borderColor.R) + (integer(borderColor.G) shl 8) + (integer(borderColor.B) shl 16);
  2938. //  var cc: integer := integer(c.R) + (integer(c.G) shl 8) + (integer(c.B) shl 16);
  2939.  
  2940.   var bc := ColorTranslator.ToWin32(borderColor);
  2941.   var cc := ColorTranslator.ToWin32(c);
  2942.  
  2943.   Monitor.Enter(f);
  2944.  
  2945.   hdc := gr.GetHDC();
  2946.   hBrush := CreateSolidBrush(cc);
  2947.  
  2948.   hOldBrush := SelectObject(hdc, hBrush);
  2949.   ExtFloodFill(hdc, x, y, bc, 1);
  2950.   SelectObject(hdc, holdBrush);
  2951.  
  2952.   var hbmp := bmp.GetHbitmap(); // Создается GDI Bitmap
  2953.   var memdc: IntPtr := CreateCompatibleDC(hdc);
  2954.   SelectObject(memdc,hbmp);
  2955.  
  2956.   hOldBrush := SelectObject(memdc, hBrush);
  2957.   ExtFloodFill(memdc, x, y, bc, 1);
  2958.   SelectObject(hdc, holdBrush);
  2959.  
  2960.   var bmp1 := Bitmap.FromHbitmap(hbmp);
  2961.   gbmp.DrawImage(bmp1,0,0);
  2962.  
  2963.   bmp1.Dispose();
  2964. //  bmp := Bitmap.FromHbitmap(hbmp);
  2965.  
  2966.   DeleteObject(memdc);
  2967.   DeleteObject(hbmp);
  2968.   DeleteObject(hBrush);
  2969.  
  2970.   gr.ReleaseHdc();
  2971.  
  2972.   DeleteObject(hdc);
  2973.  
  2974.   Monitor.Exit(f);
  2975. end;
  2976.  
  2977. procedure FillRect(x1,y1,x2,y2: integer);
  2978. begin
  2979.   FillRectangle(x1,y1,x2,y2);
  2980. end;
  2981.  
  2982. // Colors
  2983. function RGB(r,g,b: byte): Color;
  2984. begin
  2985.   Result := System.Drawing.Color.FromArgb(r,g,b);
  2986. end;
  2987.  
  2988. //------------------------------------------------------------------------------
  2989. // Color from component
  2990. //------------------------------------------------------------------------------
  2991. const AlphaBase = $FF000000;
  2992.  
  2993. function RedColor(r: byte): Color;
  2994. begin
  2995.   Result := System.Drawing.Color.FromArgb(AlphaBase or (r shl 16));
  2996. end;
  2997.  
  2998. function GreenColor(g: byte): Color;
  2999. begin
  3000.   Result := System.Drawing.Color.FromArgb(AlphaBase or (g shl 8));
  3001. end;
  3002.  
  3003. function BlueColor(b: byte): Color;
  3004. begin
  3005.   Result := System.Drawing.Color.FromArgb(AlphaBase or b);
  3006. end;
  3007. //------------------------------------------------------------------------------
  3008.  
  3009. function ARGB(a,r,g,b: byte) : Color;
  3010. begin
  3011.   Result := System.Drawing.Color.FromArgb(a,r,g,b);
  3012. //  Result := ((((r shl 16) or (g shl 8)) or b) or (a shl 24)) and -1;
  3013. end;
  3014.  
  3015. function clRandom: Color;
  3016. begin
  3017.   Result:=System.Drawing.Color.FromArgb(255,PABCSystem.Random(255),PABCSystem.Random(255),PABCSystem.Random(255));
  3018. end;
  3019.  
  3020. function GetRed(c: Color): integer;
  3021. begin
  3022.   Result := c.R;
  3023. //  Result := (c shr 16) and 255;
  3024. end;
  3025.  
  3026. function GetGreen(c: Color): integer;
  3027. begin
  3028.   Result := c.G;
  3029. //  Result := (c shr 8) and 255;
  3030. end;
  3031.  
  3032. function GetBlue(c: Color): integer;
  3033. begin
  3034.   Result := c.B;
  3035. //  Result := c and 255;
  3036. end;
  3037.  
  3038. function GetAlpha(c: Color): integer;
  3039. begin
  3040.   Result := c.A;
  3041. end;
  3042.  
  3043. // Pens
  3044. procedure SetPenColor(c: Color);
  3045. begin
  3046.   //if Pen.NETPen.Color <> c then
  3047.     lock f do
  3048.       Pen.NETPen.Color := c;
  3049. end;
  3050.  
  3051. function PenColor: Color;
  3052. begin
  3053.   Result := Pen.NETPen.Color;
  3054. end;
  3055.  
  3056. procedure SetPenWidth(Width: integer);
  3057. begin
  3058.   lock f do
  3059.   begin
  3060.     Pen.NETPen.Width := Width;
  3061.     _ColorLinePen.Width := Width;
  3062.   end;  
  3063. end;
  3064.  
  3065. function PenWidth: integer;
  3066. begin
  3067.   Result := round(Pen.NETPen.Width);
  3068. end;
  3069.  
  3070. procedure SetPenStyle(style: DashStyle);
  3071. begin
  3072.   LockGraphics;
  3073. //  try
  3074.   case style of
  3075.     psSolid:          Pen.NETPen.DashStyle := DashStyle.Solid;
  3076.     psClear:        Pen.NETPen.DashStyle := DashStyle.Custom;
  3077.     psDash:           Pen.NETPen.DashStyle := DashStyle.Dash;
  3078.     psDot:            Pen.NETPen.DashStyle := DashStyle.Dot;
  3079.     psDashDot:      Pen.NETPen.DashStyle := DashStyle.DashDot;
  3080.     psDashDotDot:   Pen.NETPen.DashStyle := DashStyle.DashDotDot;
  3081.   end;  
  3082. {    except
  3083.       on e: System.InvalidOperationException do
  3084.         writeln(e);
  3085.     end;}
  3086.   UnLockGraphics;
  3087. end;
  3088.  
  3089. function PenStyle: DashStyle;
  3090. begin
  3091.   case Pen.NETPen.DashStyle of
  3092.     DashStyle.Solid:      Result := psSolid;
  3093.     DashStyle.Dash:       Result := psDash;
  3094.     DashStyle.Dot:        Result := psDot;
  3095.     DashStyle.DashDot:    Result := psDashDot;
  3096.     DashStyle.DashDotDot: Result := psDashDotDot;
  3097.     DashStyle.Custom:     Result := psClear;
  3098.   end;  
  3099. end;
  3100.  
  3101. procedure SetPenMode(m: integer);
  3102. begin
  3103. // TODO  
  3104. end;
  3105.  
  3106. function PenMode: integer;
  3107. begin
  3108.   result := -1;
  3109. // TODO
  3110. end;
  3111.  
  3112.  
  3113. //2015.01>
  3114. procedure SetPenRoundCap(isRoundCap: boolean);
  3115. var lCap: LineCap;
  3116. begin
  3117.   if isRoundCap then
  3118.     lCap := LineCap.Round
  3119.   else
  3120.     lCap := LineCap.Flat;
  3121.   lock f do
  3122.   begin  
  3123.     Pen.NETPen.StartCap := lCap;
  3124.     Pen.NETPen.EndCap := lCap;
  3125.   end;
  3126. end;
  3127. function PenRoundCap: boolean;
  3128. begin
  3129.   Result := (Pen.NETPen.StartCap = LineCap.Round)
  3130.     and (Pen.NETPen.EndCap = LineCap.Round);
  3131. end;
  3132. //2015.01<    
  3133.  
  3134.  
  3135. function PenX: integer;
  3136. begin
  3137.   Result := x_coord;
  3138. end;
  3139.  
  3140. function PenY: integer;
  3141. begin
  3142.   Result := y_coord;
  3143. end;
  3144.  
  3145.  
  3146. // Brushes
  3147. procedure SetBrushColor(c: Color);
  3148. begin
  3149.   LockGraphics;
  3150.   if Brush.NETBrush = CurrentHatchBrush then
  3151.   begin
  3152.     CurrentHatchBrush := new HatchBrush(CurrentHatchBrush.HatchStyle,c,CurrentHatchBrush.BackgroundColor);
  3153.     Brush.NETBrush := CurrentHatchBrush;
  3154.   end  
  3155.   else
  3156.   begin
  3157. //    try
  3158.     CurrentSolidBrush.Color := c;
  3159. {    except
  3160.       on e: System.InvalidOperationException do
  3161.         writeln(e.StackTrace);
  3162.     end;}
  3163.     CurrentGradientBrush.LinearColors[0] := CurrentSolidBrush.Color;
  3164.   end;
  3165.   UnLockGraphics;  
  3166. end;
  3167.  
  3168. function BrushColor: Color;
  3169. begin
  3170.   if Brush.NETBrush = CurrentHatchBrush then
  3171.     Result := CurrentHatchBrush.ForegroundColor
  3172.   else Result := CurrentSolidBrush.Color;
  3173. end;
  3174.  
  3175. procedure SetBrushStyle(bs: BrushStyleType);
  3176. begin
  3177.   lock f do
  3178.     case bs of
  3179.       bsSolid:  Brush.NETBrush := CurrentSolidBrush;
  3180.       bsClear:  Brush.NETBrush := nil;
  3181.       bsHatch:  Brush.NETBrush := CurrentHatchBrush;
  3182.       bsGradient:   Brush.NETBrush := CurrentGradientBrush;
  3183.     end;
  3184. end;
  3185.  
  3186. function BrushStyle: BrushStyleType;
  3187. begin
  3188.   Result := bsNone; // Если кисть устанавливалась явным присваиванием NETBrush
  3189.   if Brush.NETBrush = CurrentSolidBrush then
  3190.     Result := bsSolid
  3191.   else if Brush.NETBrush = nil then
  3192.     Result := bsClear
  3193.   else if Brush.NETBrush = CurrentHatchBrush then
  3194.     Result := bsHatch
  3195.   else if Brush.NETBrush = CurrentGradientBrush then
  3196.     Result := bsGradient;
  3197. end;
  3198.  
  3199. procedure SetBrushHatch(bh: HatchStyle);
  3200. begin
  3201.   lock f do
  3202.   begin
  3203.     var flag := CurrentHatchBrush = Brush.NETBrush;
  3204.     CurrentHatchBrush := new HatchBrush(HatchStyle(bh),CurrentHatchBrush.ForegroundColor,CurrentHatchBrush.BackgroundColor);
  3205.     if flag then
  3206.       Brush.NETBrush := CurrentHatchBrush;
  3207.   end;    
  3208. end;
  3209.  
  3210. function BrushHatch: HatchStyle;
  3211. begin
  3212.   Result := CurrentHatchBrush.HatchStyle;
  3213. end;
  3214.  
  3215. procedure SetHatchBrushBackgroundColor(c: Color);
  3216. var flag: boolean;
  3217. begin
  3218.   lock f do
  3219.   begin
  3220.     flag := CurrentHatchBrush = Brush.NETBrush;
  3221.     CurrentHatchBrush := new HatchBrush(CurrentHatchBrush.HatchStyle,CurrentHatchBrush.ForegroundColor,c);
  3222.     if flag then
  3223.       Brush.NETBrush := CurrentHatchBrush;
  3224.   end;    
  3225. end;
  3226.  
  3227. function HatchBrushBackgroundColor: Color;
  3228. begin
  3229.   Result := CurrentHatchBrush.BackgroundColor;
  3230. end;
  3231.  
  3232. procedure SetGradientBrushSecondColor(c: Color);
  3233. begin
  3234.   lock f do
  3235.     CurrentGradientBrush.LinearColors[1] := c;
  3236. end;
  3237.  
  3238. function GradientBrushSecondColor: Color;
  3239. begin
  3240.   Result := CurrentGradientBrush.LinearColors[1];
  3241. end;
  3242.  
  3243. // Fonts
  3244. procedure SetFontSize(size: integer);
  3245. begin
  3246.   Font.NETFont := new System.Drawing.Font(Font.NETFont.Name,Convert.ToSingle(size),Font.NETFont.Style);
  3247. end;
  3248.  
  3249. function FontSize: integer;
  3250. begin
  3251.   Result := round(Font.NETFont.SizeInPoints);
  3252. end;
  3253.  
  3254. procedure SetFontName(name: string);
  3255. begin
  3256.   lock f do
  3257.     Font.NETFont := new System.Drawing.Font(name,Font.NETFont.SizeInPoints,Font.NETFont.Style);
  3258. end;
  3259.  
  3260. function FontName: string;
  3261. begin
  3262.   Result := Font.NETFont.Name;
  3263. end;
  3264.  
  3265. procedure SetFontColor(c: Color);
  3266. begin
  3267.   lock f do
  3268.     _CurrentTextBrush.Color := c;
  3269. end;
  3270.  
  3271. function FontColor: Color;
  3272. begin
  3273.   Result := _CurrentTextBrush.Color;
  3274. end;
  3275.  
  3276. procedure SetFontStyle(fs: FontStyleType);
  3277. begin
  3278.   lock f do
  3279.     Font.NETFont := new System.Drawing.Font(Font.NETFont.name,Font.NETFont.SizeInPoints,System.Drawing.FontStyle(integer(fs)));
  3280. end;
  3281.  
  3282. function FontStyle: FontStyleType;
  3283. begin
  3284.   Result := FontStyleType(integer(Font.NETFont.Style));
  3285. end;
  3286.  
  3287. function TextWidth(s: string): integer;
  3288. begin
  3289. // добавил 1. Без нее рисует, занимая 1 лишний пиксел
  3290.   Result := round(gr.MeasureString(s,Font.NETFont,0,sf).Width) + 1;
  3291. end;
  3292.  
  3293. function TextHeight(s: string): integer;
  3294. begin
  3295.   Result := round(gr.MeasureString(s,Font.NETFont).Height);
  3296. end;
  3297.  
  3298. // Window
  3299. procedure ClearWindow;
  3300. begin
  3301.   ClearWindow(clWhite);
  3302. end;
  3303.  
  3304. procedure ClearWindow(c: Color);
  3305. var i: Color;
  3306. begin
  3307.   Monitor.Enter(f);
  3308.   i := BrushColor;
  3309.   SetBrushColor(c);
  3310.   var m := gr.Transform;
  3311.   gr.ResetTransform;
  3312.   gbmp.ResetTransform;
  3313.   FillRect(0,0,GraphABCControl.Width,GraphABCControl.Height);
  3314.   gr.Transform := m;
  3315.   gbmp.Transform := m;
  3316.   SetBrushColor(i);
  3317.   Monitor.Exit(f);
  3318. end;
  3319.  
  3320. function WindowLeft: integer;
  3321. begin
  3322.   Result := MainForm.Left;
  3323. end;
  3324.  
  3325. function WindowTop: integer;
  3326. begin
  3327.   Result := MainForm.Top;
  3328. end;
  3329.  
  3330. function WindowCenter: Point;
  3331. begin
  3332.   Result := new Point(WindowWidth div 2,WindowHeight div 2);
  3333. end;
  3334.  
  3335. function WindowIsFixedSize: boolean;
  3336. begin
  3337.   Result := (MainForm.FormBorderStyle = FormBorderStyle.FixedSingle) and (MainForm.MaximizeBox = False);
  3338. end;
  3339.  
  3340. function WindowWidth: integer;
  3341. begin
  3342. //  Result := MainForm.ClientSize.Width;
  3343.   Result := f.Width;
  3344. end;
  3345.  
  3346. function WindowHeight: integer;
  3347. begin
  3348. //  Result := MainForm.ClientSize.Height;
  3349.   Result := f.Height;
  3350. end;
  3351.  
  3352. procedure SetWindowWidth(w: integer);
  3353. begin
  3354. //  SetWindowSize(w,MainForm.ClientSize.Height);
  3355.   SetWindowSize(w,WindowHeight);
  3356. end;
  3357.  
  3358. procedure SetWindowHeight(h: integer);
  3359. begin
  3360. //  SetWindowSize(MainForm.ClientSize.Width,h);
  3361.   SetWindowSize(WindowWidth,h);
  3362. end;  
  3363.  
  3364. procedure SetWindowLeft(l: integer);
  3365. begin
  3366.   SetWindowPos(l,MainForm.Top);
  3367. end;
  3368.  
  3369. procedure SetWindowTop(t: integer);
  3370. begin
  3371.   SetWindowPos(MainForm.Left,t);
  3372. end;
  3373.  
  3374. procedure SetMaximizeBoxInternal(b: boolean);
  3375. begin
  3376.   MainForm.MaximizeBox := b;
  3377. end;
  3378.  
  3379. procedure SetBorderStyleInternal(st : FormBorderStyle);
  3380. begin
  3381.   MainForm.FormBorderStyle := st;
  3382. end;
  3383.  
  3384. procedure SetWindowIsFixedSize(b: boolean);
  3385. var p : Proc1Boolean;
  3386.     q : Proc1BorderStyle;
  3387. begin
  3388.   p := SetMaximizeBoxInternal;
  3389.   q := SetBorderStyleInternal;
  3390.   if b then
  3391.     MainForm.Invoke(q,FormBorderStyle.FixedSingle)
  3392.   else MainForm.Invoke(q,FormBorderStyle.Sizable);
  3393.   MainForm.Invoke(p,not b);
  3394. end;
  3395.  
  3396. procedure ChangeFormPos(l,t: integer); // вспомогательная
  3397. begin
  3398.   MainForm.Left := l;
  3399.   MainForm.Top := t;
  3400. end;
  3401.  
  3402. procedure SetWindowPos(l,t: integer);
  3403. begin
  3404.   f.Invoke(ChangeFormPos,l,t);
  3405. end;
  3406.  
  3407. procedure ChangeFormClientSize(w,h: integer); // вспомогательная
  3408. begin
  3409.   MainForm.ClientSize := new System.Drawing.Size(w,h);
  3410.   ResizeHelper;
  3411. end;
  3412.  
  3413. procedure SetWindowSize(w,h: integer);
  3414. begin
  3415.   f.Invoke(ChangeFormClientSize,w,h);
  3416. end;
  3417.  
  3418. function GraphBoxWidth: integer;
  3419. begin
  3420.   Result := f.Width;
  3421. end;
  3422.  
  3423. function GraphBoxHeight: integer;
  3424. begin
  3425.   Result := f.Height;
  3426. end;
  3427.  
  3428. function GraphBoxLeft: integer;
  3429. begin
  3430.   Result := f.Left;
  3431. end;
  3432.  
  3433. function GraphBoxTop: integer;
  3434. begin
  3435.   Result := f.Top;
  3436. end;
  3437.  
  3438. function WindowCaption: string;
  3439. begin
  3440.   Result := MainForm.Text;
  3441. end;
  3442.  
  3443. function WindowTitle: string;
  3444. begin
  3445.   Result := MainForm.Text;
  3446. end;
  3447.  
  3448. procedure InitWindow(Left,Top,Width,Height: integer; BackColor: Color);
  3449. begin
  3450.   SetWindowSize(Width, Height);
  3451.   SetWindowPos(Left, Top);
  3452.   SetBrushColor(BackColor);
  3453.   FillRectangle(0, 0, Width, Height);
  3454. end;
  3455.  
  3456. procedure ChangeFormTitle(s: string);
  3457. begin
  3458.   MainForm.Text := s;
  3459. end;
  3460.  
  3461. procedure SetWindowTitle(s: string);
  3462. begin
  3463.   f.Invoke(ChangeFormTitle,s);
  3464. end;
  3465.  
  3466. procedure SetWindowCaption(s: string);
  3467. begin
  3468.   SetWindowTitle(s);
  3469. end;
  3470.  
  3471. procedure SaveWindow(fname: string);
  3472. begin
  3473.   var tempbmp := GetView(bmp,new System.Drawing.Rectangle(0,0,Window.Width,Window.Height));
  3474.   tempbmp.Save(fname);
  3475.   tempbmp.Dispose;
  3476. end;
  3477.  
  3478. procedure LoadWindow(fname: string);
  3479. //2015.01>
  3480. var
  3481.   b: Bitmap;
  3482.   tmp: Image;
  3483.   fs: System.IO.FileStream;
  3484. //2015.01<
  3485. begin
  3486. //2015.01>
  3487. //  var b: Bitmap := new Bitmap(fname);
  3488.   try
  3489.     fs := new System.IO.FileStream(fname, System.IO.FileMode.Open);
  3490.     tmp := Image.FromStream(fs);
  3491.     b := new Bitmap(tmp);
  3492.     fs.Flush;
  3493.     fs.Close;
  3494.     tmp.Dispose;
  3495.   except on ex: System.ArgumentException do
  3496.     raise new System.IO.FileNotFoundException(string.Format(FILE_NOT_FOUND_MESSAGE,fname));
  3497.   end;
  3498. //2015.01<
  3499.   SetWindowSize(b.Width,b.Height);
  3500.   Monitor.Enter(f);
  3501.   gr.DrawImage(b,0,0);  
  3502.   gbmp.DrawImage(b,0,0);  
  3503.   Monitor.Exit(f);
  3504. end;
  3505.  
  3506. procedure FillWindow(fname: string);
  3507. begin
  3508.   Monitor.Enter(f);
  3509.   var b: System.Drawing.Brush := Brush.NETBrush;
  3510.   Brush.NETBrush := new TextureBrush(Bitmap.FromFile(fname));
  3511.   FillRect(0,0,GraphABCControl.Width,GraphABCControl.Height);
  3512.   Brush.NETBrush := b;
  3513.   Monitor.Exit(f);
  3514. end;
  3515.  
  3516. procedure CloseWindow;
  3517. begin
  3518. //  MainForm.Close;
  3519.   Halt;
  3520. end;
  3521.  
  3522. function ScreenWidth: integer;
  3523. begin
  3524.   Result := Screen.PrimaryScreen.Bounds.Width;
  3525. end;
  3526.  
  3527. function ScreenHeight: integer;
  3528. begin
  3529.   Result := Screen.PrimaryScreen.Bounds.Height;
  3530. end;
  3531.  
  3532. procedure CenterWindow;
  3533. begin
  3534.   SetWindowPos((ScreenWidth - MainForm.Width) div 2, (ScreenHeight - MainForm.Height) div 2);
  3535. end;
  3536.  
  3537. procedure _MaximizeWindow;
  3538. begin
  3539.   _MainForm.WindowState := FormWindowState.Maximized;
  3540. end;
  3541.  
  3542. procedure _MinimizeWindow;
  3543. begin
  3544.   _MainForm.WindowState := FormWindowState.Minimized;
  3545. end;
  3546.  
  3547. procedure _NormalizeWindow;
  3548. begin
  3549.   _MainForm.WindowState := FormWindowState.Normal
  3550. end;
  3551.  
  3552. procedure MaximizeWindow;
  3553. begin
  3554.   _MainForm.Invoke(_MaximizeWindow);
  3555. end;
  3556.  
  3557. procedure MinimizeWindow;
  3558. begin
  3559.   _MainForm.Invoke(_MinimizeWindow);
  3560. end;
  3561.  
  3562. procedure NormalizeWindow;
  3563. begin
  3564.   _MainForm.Invoke(_NormalizeWindow);
  3565. end;
  3566.  
  3567. // BufferedDraw
  3568. procedure Redraw;
  3569. var tempbmp: Bitmap;
  3570. begin
  3571.   if IsUnix then
  3572.     exit;
  3573.   //TODO Без этого падает если свернуто
  3574.   if MainForm.WindowState=FormWindowState.Minimized then
  3575.     exit;
  3576.   tempbmp := GetView(bmp,new System.Drawing.Rectangle(0,0,WindowWidth,WindowHeight));
  3577.   tempbmp.SetResolution(gr.DpiX,gr.DpiY);
  3578.   Monitor.Enter(f);
  3579.   if gr<>nil then
  3580.   begin
  3581.     var m := gr.Transform;
  3582.     gr.ResetTransform;
  3583.     gr.DrawImage(tempbmp,0,0);
  3584.     gr.Transform := m;
  3585.   end;  
  3586.   Monitor.Exit(f);
  3587. end;
  3588.  
  3589. procedure FullRedraw;
  3590. begin
  3591.   if IsUnix then
  3592.     exit;
  3593.   Monitor.Enter(f);
  3594.   if gr<>nil then
  3595.     gr.DrawImage(bmp,0,0);
  3596.   Monitor.Exit(f);
  3597. end;
  3598.  
  3599. procedure LockDrawing;
  3600. begin
  3601.   if IsUnix then
  3602.     exit;
  3603.   NotLockDrawing := False;
  3604. end;
  3605.  
  3606. procedure UnlockDrawing;
  3607. begin
  3608.   NotLockDrawing := True;
  3609.   Redraw;
  3610. end;
  3611.  
  3612. function RobotUnitUsed: boolean;
  3613. var t: &Type;
  3614. begin
  3615.   t := System.Reflection.Assembly.GetExecutingAssembly.GetType('Robot.Robot');
  3616.   if t=nil then
  3617.     result := false
  3618.   else
  3619.     result := t.GetField('__IS_ROBOT_UNIT') <> nil;
  3620. end;
  3621.  
  3622. procedure HideForm;
  3623. begin
  3624.   _MainForm.Hide;
  3625. end;
  3626.  
  3627. procedure CreatePicture(var p: Picture; w,h: integer);
  3628. begin
  3629.   p := new Picture(w,h);
  3630. end;
  3631.  
  3632. function Window: GraphABCWindow;
  3633. begin
  3634.   Result := _Window;
  3635. end;
  3636.  
  3637. function MainForm: Form;
  3638. begin
  3639.   Result := _MainForm;
  3640. end;
  3641.  
  3642. function GraphABCControl: ABCControl;
  3643. begin
  3644.   Result := _GraphABCControl;
  3645. end;
  3646.  
  3647. function Pen: GraphABCPen;
  3648. begin
  3649.   Result := _Pen;
  3650. end;
  3651.  
  3652. function Brush: GraphABCBrush;
  3653. begin
  3654.   Result := _Brush;
  3655. end;
  3656.  
  3657. function Font: GraphABCFont;
  3658. begin
  3659.   Result := _Font;
  3660. end;
  3661.  
  3662. function Coordinate: GraphABCCoordinate;
  3663. begin
  3664.   Result := _Coordinate;
  3665. end;
  3666.  
  3667. function StatusBar: GraphABCStatus;
  3668. begin
  3669.   Result := _StatusBar;
  3670. end;
  3671.  
  3672. procedure GraphABCWindow.SetLeft(l: integer);
  3673. begin
  3674.   SetWindowLeft(l);
  3675. end;
  3676.  
  3677. function GraphABCWindow.GetLeft: integer;
  3678. begin
  3679.   Result := WindowLeft;
  3680. end;
  3681.  
  3682. procedure GraphABCWindow.SetTop(t: integer);
  3683. begin
  3684.   SetWindowTop(t);
  3685. end;
  3686.  
  3687. function GraphABCWindow.GetTop: integer;
  3688. begin
  3689.   Result := WindowTop;
  3690. end;
  3691.  
  3692. procedure GraphABCWindow.SetWidth(w: integer);
  3693. begin
  3694.   SetWindowWidth(w);
  3695. end;
  3696.  
  3697. function GraphABCWindow.GetWidth: integer;
  3698. begin
  3699.   Result := WindowWidth;
  3700. end;
  3701.  
  3702. procedure GraphABCWindow.SetHeight(h: integer);
  3703. begin
  3704.   SetWindowHeight(h);
  3705. end;
  3706.  
  3707. function GraphABCWindow.GetHeight: integer;
  3708. begin
  3709.   Result := WindowHeight;
  3710. end;
  3711.  
  3712. procedure GraphABCWindow.SetCaption(c: string);
  3713. begin
  3714.   SetWindowCaption(c);
  3715. end;
  3716.  
  3717. function GraphABCWindow.GetCaption: string;
  3718. begin
  3719.   Result := WindowCaption;
  3720. end;
  3721.  
  3722. procedure GraphABCWindow.SetIsFixedSize(b: boolean);
  3723. begin
  3724.   SetWindowIsFixedSize(b);
  3725. end;
  3726.  
  3727. function GraphABCWindow.GetIsFixedSize: boolean;
  3728. begin
  3729.   Result := WindowIsFixedSize;
  3730. end;
  3731.  
  3732. procedure GraphABCWindow.Clear;
  3733. begin
  3734.   ClearWindow;
  3735. end;
  3736.  
  3737. procedure GraphABCWindow.Clear(c: Color);
  3738. begin
  3739.   ClearWindow(c);
  3740. end;
  3741.  
  3742. procedure GraphABCWindow.SetSize(w,h: integer);
  3743. begin
  3744.   SetWindowSize(w,h)
  3745. end;
  3746.  
  3747. procedure GraphABCWindow.SetPos(l,t: integer);
  3748. begin
  3749.   SetWindowPos(l,t)
  3750. end;
  3751.  
  3752. procedure GraphABCWindow.Init(Left,Top,Width,Height: integer; BackColor: Color);
  3753. begin
  3754.   InitWindow(Left,Top,Width,Height,BackColor);
  3755. end;
  3756.  
  3757. procedure GraphABCWindow.Save(fname: string);
  3758. begin
  3759.   SaveWindow(fname);
  3760. end;
  3761.  
  3762. procedure GraphABCWindow.Load(fname: string);
  3763. begin
  3764.   LoadWindow(fname);
  3765. end;
  3766.  
  3767. procedure GraphABCWindow.Fill(fname: string);
  3768. begin
  3769.   FillWindow(fname);
  3770. end;
  3771.  
  3772. procedure GraphABCWindow.Close;
  3773. begin
  3774.   CloseWindow
  3775. end;
  3776.  
  3777. procedure GraphABCWindow.Minimize;
  3778. begin
  3779.   MinimizeWindow
  3780. end;
  3781.  
  3782. procedure GraphABCWindow.Maximize;
  3783. begin
  3784.   MaximizeWindow;
  3785. end;
  3786.  
  3787. procedure GraphABCWindow.Normalize;
  3788. begin
  3789.   NormalizeWindow;
  3790. end;
  3791.  
  3792. procedure GraphABCWindow.CenterOnScreen;
  3793. begin
  3794.   CenterWindow;
  3795. end;
  3796.  
  3797. function GraphABCWindow.Center: Point;
  3798. begin
  3799.   Result := WindowCenter;
  3800. end;
  3801.  
  3802. function Rect(x1,y1,x2,y2: integer): System.Drawing.Rectangle;
  3803. begin
  3804.   Result := new System.Drawing.Rectangle(x1,y1,x2-x1,y2-y1);
  3805. end;
  3806.  
  3807. function ClientRectangle: System.Drawing.Rectangle;
  3808. begin
  3809.   Result := MainForm.ClientRectangle
  3810. end;
  3811.  
  3812. type FS = auto class
  3813.   mx,my,a,min,max: real;
  3814.   x1,y1: integer;
  3815.   f: real -> real;
  3816.  
  3817.   function Apply(x: real): Point;
  3818.   begin
  3819.     Result := Pnt(x1+Round(mx*(x-a)),y1+Round(my*(max-f(x))));
  3820.   end;
  3821.  
  3822.   function RealToScreenX(x: real): integer := Round(x1 + mx * (x-a));
  3823.  
  3824.   function RealToScreenY(y: real): integer := Round(y1 - my * (y+min));
  3825. end;
  3826.  
  3827. procedure Draw(f: real -> real; a,b,min,max: real; x1,y1,x2,y2: integer);
  3828. begin
  3829.   var coefx := (x2-x1)/(b-a);
  3830.   var coefy := (y2-y1)/(max-min);
  3831.  
  3832.   Pen.Color := Color.Black;
  3833.   Rectangle(x1,y1,x2+1,y2+1);
  3834.  
  3835.   var fso := new FS(coefx,coefy,a,min,max,x1,y1,f);
  3836.  
  3837.   // Линии
  3838.   {Pen.Color := Color.LightGray;
  3839.  
  3840.   var hx := 1.0;
  3841.   var xx := hx;
  3842.   while xx<b do
  3843.   begin
  3844.     var x0 := fso.RealToScreenX(xx);
  3845.     Line(x0,y1,x0,y2);
  3846.     xx += hx
  3847.   end;
  3848.  
  3849.   xx := -hx;
  3850.   while xx>a do
  3851.   begin
  3852.     var x0 := fso.RealToScreenX(xx);
  3853.     Line(x0,y1,x0,y2);
  3854.     xx -= hx
  3855.   end;
  3856.  
  3857.   var hy := 1.0;
  3858.   var yy := hy;
  3859.   while yy<max do
  3860.   begin
  3861.     var y0 := fso.RealToScreenY(yy);
  3862.     Line(x1,y0,x2,y0);
  3863.     yy += hy
  3864.   end;
  3865.  
  3866.   yy := -hy;
  3867.   while yy>min do
  3868.   begin
  3869.     var y0 := fso.RealToScreenY(yy);
  3870.     Line(x1,y0,x2,y0);
  3871.     yy -= hy
  3872.   end;
  3873.  
  3874.   // Оси
  3875.   Pen.Color := Color.Blue;
  3876.  
  3877.   var x0 := fso.RealToScreenX(0);
  3878.   var y0 := fso.RealToScreenY(0);
  3879.  
  3880.   Line(x0,y1,x0,y2);
  3881.   Line(x1,y0,x2,y0);}
  3882.  
  3883.   // График
  3884.  
  3885.   Pen.Color := Color.Black;
  3886.   var n := (x2-x1) div 3;
  3887.   Polyline(Range(a,b,n).Select(fso.Apply).ToArray);
  3888. end;
  3889.  
  3890. procedure Draw(f: real -> real; a,b,min,max: real; r: System.Drawing.Rectangle);
  3891. var x1 := r.X; y1 := r.Y;
  3892.     x2 := r.X+r.Width-1;
  3893.     y2 := r.Y+r.Height-1;
  3894. begin
  3895.   Draw(f,a,b,min,max,x1,y1,x2,y2);  
  3896. end;
  3897.  
  3898. procedure Draw(f: real -> real; a,b,min,max: real);
  3899. begin
  3900.   Draw(f,a,b,min,max,ClientRectangle);
  3901. end;
  3902.  
  3903. procedure Draw(f: real -> real; a,b: real; x1,y1,x2,y2: integer);
  3904. begin
  3905.   var n := (x2-x1) div 3;
  3906.   Draw(f,a,b,Range(a,b,n).Min(f),Range(a,b,n).Max(f),x1,y1,x2,y2)
  3907. end;
  3908.  
  3909. procedure Draw(f: real -> real; a,b: real; r: System.Drawing.Rectangle);
  3910. var x1 := r.X; y1 := r.Y;
  3911.     x2 := r.X+r.Width-1;
  3912.     y2 := r.Y+r.Height-1;
  3913. begin
  3914.   Draw(f,a,b,x1,y1,x2,y2);
  3915. end;
  3916.  
  3917. procedure Draw(f: real -> real; r: System.Drawing.Rectangle);
  3918. begin
  3919.   Draw(f,-5,5,r);
  3920. end;
  3921.  
  3922. procedure Draw(f: real -> real; a,b: real);
  3923. var x1 := 0; y1 := 0;
  3924.     x2 := Window.Width-1;
  3925.     y2 := Window.Height-1;
  3926. begin
  3927.   Draw(f,a,b,x1,y1,x2,y2);
  3928. end;
  3929.  
  3930. procedure Draw(f: real -> real);
  3931. begin
  3932.   Draw(f,-5,5);
  3933. end;
  3934.  
  3935. var dpic := new Dictionary<string,Picture>;
  3936.  
  3937. procedure Draw(fname: string; x,y: integer);
  3938. begin
  3939.   if not dpic.ContainsKey(fname) then
  3940.     dpic[fname] := new Picture(fname);
  3941.   dpic[fname].Draw(x,y);
  3942. end;
  3943.  
  3944. procedure Draw(fname: string; x,y,w,h: integer);
  3945. begin
  3946.   if not dpic.ContainsKey(fname) then
  3947.     dpic[fname] := new Picture(fname);
  3948.   dpic[fname].Draw(x,y,w,h);
  3949. end;
  3950.  
  3951. procedure Draw(fname: string; x,y: integer; Scale: real);
  3952. begin
  3953.   if not dpic.ContainsKey(fname) then
  3954.     dpic[fname] := new Picture(fname);
  3955.   var d := dpic[fname];
  3956.   var w := Round(d.Width * Scale);
  3957.   var h := Round(d.Height * Scale);
  3958.   dpic[fname].Draw(x,y,w,h);
  3959. end;
  3960.  
  3961. var firstcall := True;
  3962.  
  3963. procedure ReadlnTextBoxKeyDown(Sender: object; e: KeyEventArgs);
  3964. begin
  3965.   if IOPanel.Visible = False then
  3966.     Exit;
  3967.   if e.KeyCode = Keys.Return then
  3968.   begin
  3969.     readbuffer := ed.Text + Environment.NewLine;
  3970.     IOPanel.Invoke(SetIOPanelInVisible);
  3971.     MainThread.Resume;
  3972.   end;
  3973. end;
  3974.  
  3975. procedure EnterButtonClick(Sender: object; e: EventArgs);
  3976. begin
  3977.   if IOPanel.Visible = False then
  3978.     Exit;
  3979.   readbuffer := ed.Text + Environment.NewLine;
  3980.   IOPanel.Invoke(SetIOPanelInVisible);
  3981.   MainThread.Resume;
  3982. end;
  3983.  
  3984. procedure InitForm;
  3985. begin
  3986.   _CurrentTextBrush := new SolidBrush(System.Drawing.Color.Black);
  3987.   _ColorLinePen := new System.Drawing.Pen(System.Drawing.Color.Black);
  3988.  
  3989.   f := new ABCControl(defaultWindowWidth,defaultWindowHeight);
  3990.   _MainForm := new Form;
  3991.   _MainForm.Text := '_GraphABC.NET';
  3992.   _MainForm.ClientSize := new Size(defaultWindowWidth,defaultWindowHeight);
  3993.   _MainForm.BackColor := Color.White;
  3994.   _MainForm.Controls.Add(f);
  3995.   _MainForm.TopMost := True;
  3996.   _MainForm.StartPosition := FormStartPosition.CenterScreen;
  3997.   _MainForm.FormClosing += f.OnClosing;
  3998.   // Поле ввода
  3999.   IOPanel := new Panel();
  4000.   IOPanel.Dock := DockStyle.Bottom;
  4001.   ed := new TextBox();
  4002.   ed.Dock := DockStyle.Fill;
  4003.   ed.Top := defaultWindowHeight;
  4004.   EnterButton := new Button();
  4005.   EnterButton.Text := BUTTON_ENTER_TEXT;
  4006.   EnterButton.Dock := DockStyle.Right;
  4007.   EnterButton.Click += EnterButtonClick;
  4008.  
  4009.   IOPanel.Visible := False;
  4010.   IOPanel.Size := new Size(defaultWindowWidth,ed.Height);
  4011.   IOPanel.Controls.Add(ed);
  4012.   IOPanel.Controls.Add(EnterButton);
  4013.   _MainForm.KeyPreview := True;
  4014.   _MainForm.KeyDown += ReadlnTextBoxKeyDown;
  4015.   _MainForm.Controls.Add(IOPanel);
  4016.  
  4017.   gr := Graphics.FromHwnd(f.Handle);
  4018.  
  4019.   if (System.Environment.OSVersion.Version.Major >= 6) then SetProcessDPIAware();
  4020.   InitBMP;
  4021.  
  4022. end;  
  4023.  
  4024. procedure InitForm0;
  4025. begin
  4026.   InitForm;
  4027.   StartIsComplete := True;
  4028.   Application.Run(MainForm);
  4029. end;
  4030.  
  4031. procedure InitGraphABC;
  4032. begin
  4033.   if not firstcall then exit;
  4034.   sf := new StringFormat(StringFormat.GenericTypographic);
  4035.   sf.FormatFlags := StringFormatFlags.MeasureTrailingSpaces;
  4036.   firstcall := False;
  4037.   clMoneyGreen := RGB(192,220,192);
  4038.   StartIsComplete := False;
  4039.   MainFormThread := new System.Threading.Thread(InitForm0);
  4040.   MainFormThread.Start;
  4041.   while not StartIsComplete do
  4042.     Sleep(30);
  4043.   Sleep(30);
  4044.   SetSmoothingOn;
  4045.   _GraphABCControl := f;
  4046.   CurrentIOSystem := new IOGraphABCSystem;
  4047. end;
  4048.  
  4049. procedure SetConsoleIO;
  4050. begin
  4051.   CurrentIOSystem := new IOStandardSystem;
  4052. end;
  4053.  
  4054. procedure SetGraphABCIO;
  4055. begin
  4056.   CurrentIOSystem := new IOGraphABCSystem;
  4057. end;
  4058.  
  4059. procedure __InitModule;
  4060. begin
  4061.   MainThread := Thread.CurrentThread;
  4062.   InitGraphABC;
  4063. end;
  4064.  
  4065. var __initialized := false;
  4066.  
  4067. procedure __InitModule__;
  4068. begin
  4069.   if not __initialized then
  4070.   begin
  4071.     __initialized := true;
  4072.     GraphABCHelper.__InitModule__;
  4073.     __InitModule;
  4074.   end;
  4075. end;
  4076.  
  4077.  
  4078. initialization
  4079.   __InitModule;
  4080. finalization
  4081. //  Application.Run(MainWindow);
  4082. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement