2022-09-17 09:13:04 +03:00
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
2015-06-27 19:33:50 +03:00
2015-12-28 14:25:15 +03:00
///Модуль предоставляет константы, типы, процедуры, функции и классы для рисования в графическом окне
2015-05-14 22:35:07 +03:00
unit GraphABC;
//ne udaljat, IB 7.10.08
2015-12-28 14:25:15 +03:00
//с дополнениями 2015.01 (mabr)
2015-05-14 22:35:07 +03:00
{$apptype windows}
2017-04-22 18:21:13 +03:00
{$reference '%GAC%\System.Windows.Forms.dll'}
{$reference '%GAC%\System.Drawing.dll'}
2015-05-14 22:35:07 +03:00
interface
uses
System,
System. Drawing,
System. Windows. Forms,
System. Drawing. Drawing2D;
2017-08-06 13:35:29 +03:00
type
/// Тип цвета
2015-05-14 22:35:07 +03:00
Color = System. Drawing. Color;
2017-08-06 13:35:29 +03:00
/// Тип стиля штриховки кисти
2015-05-14 22:35:07 +03:00
HatchStyle = System. Drawing. Drawing2D. HatchStyle;
2017-08-06 13:35:29 +03:00
/// Тип стиля штриховки пера
2015-05-14 22:35:07 +03:00
DashStyle = System. Drawing. Drawing2D. DashStyle;
2017-08-06 13:35:29 +03:00
/// Тип исключения GraphABC
2015-05-14 22:35:07 +03:00
GraphABCException = class( Exception) end ;
2017-08-06 13:35:29 +03:00
/// Тип точки
2015-05-14 22:35:07 +03:00
Point = System. Drawing. Point;
2017-08-06 13:35:29 +03:00
var
2015-05-14 22:35:07 +03:00
clMoneyGreen: Color;
2017-08-06 13:35:29 +03:00
const
2015-05-14 22:35:07 +03:00
// Default graph window size
defaultWindowWidth = 6 4 0 ;
defaultWindowHeight = 4 8 0 ;
// Color constants
2023-12-18 22:37:49 +03:00
clAquamarine = Color. Aquamarine;
clAzure = Color. Azure;
clBeige = Color. Beige;
clBisque = Color. Bisque;
clBlack = Color. Black;
clBlanchedAlmond = Color. BlanchedAlmond;
clBlue = Color. Blue;
clBlueViolet = Color. BlueViolet;
clBrown = Color. Brown;
clBurlyWood = Color. BurlyWood;
clCadetBlue = Color. CadetBlue;
clChartreuse = Color. Chartreuse;
clChocolate = Color. Chocolate;
clCoral = Color. Coral;
clCornflowerBlue = Color. CornflowerBlue;
clCornsilk = Color. Cornsilk;
clCrimson = Color. Crimson;
clCyan = Color. Cyan;
clDarkBlue = Color. DarkBlue;
clDarkCyan = Color. DarkCyan;
clDarkGoldenrod = Color. DarkGoldenrod;
clDarkGray = Color. DarkGray;
clDarkGreen = Color. DarkGreen;
clDarkKhaki = Color. DarkKhaki;
clDarkMagenta = Color. DarkMagenta;
clDarkOliveGreen = Color. DarkOliveGreen;
clDarkOrange = Color. DarkOrange;
clDarkOrchid = Color. DarkOrchid;
clDarkRed = Color. DarkRed;
clDarkTurquoise = Color. DarkTurquoise;
clDarkSeaGreen = Color. DarkSeaGreen;
clDarkSlateBlue = Color. DarkSlateBlue;
clDarkSlateGray = Color. DarkSlateGray;
clDarkViolet = Color. DarkViolet;
clDeepPink = Color. DeepPink;
clDarkSalmon = Color. DarkSalmon;
clDeepSkyBlue = Color. DeepSkyBlue;
clDimGray = Color. DimGray;
clDodgerBlue = Color. DodgerBlue;
clFirebrick = Color. Firebrick;
clFloralWhite = Color. FloralWhite;
clForestGreen = Color. ForestGreen;
clFuchsia = Color. Fuchsia;
clGainsboro = Color. Gainsboro;
clGhostWhite = Color. GhostWhite;
clGold = Color. Gold;
clGoldenrod = Color. Goldenrod;
clGray = Color. Gray;
clGreen = Color. Green;
clGreenYellow = Color. GreenYellow;
clHoneydew = Color. Honeydew;
clHotPink = Color. HotPink;
clIndianRed = Color. IndianRed;
clIndigo = Color. Indigo;
clIvory = Color. Ivory;
clKhaki = Color. Khaki;
clLavender = Color. Lavender;
clLavenderBlush = Color. LavenderBlush;
clLawnGreen = Color. LawnGreen;
clLemonChiffon = Color. LemonChiffon;
clLightBlue = Color. LightBlue;
clLightCoral = Color. LightCoral;
clLightCyan = Color. LightCyan;
clLightGray = Color. LightGray;
clLightGreen = Color. LightGreen;
clLightGoldenrodYellow = Color. LightGoldenrodYellow;
clLightPink = Color. LightPink;
clLightSalmon = Color. LightSalmon;
clLightSeaGreen = Color. LightSeaGreen;
clLightSkyBlue = Color. LightSkyBlue;
clLightSlateGray = Color. LightSlateGray;
clLightSteelBlue = Color. LightSteelBlue;
clLightYellow = Color. LightYellow;
clLime = Color. Lime;
clLimeGreen = Color. LimeGreen;
clLinen = Color. Linen;
clMagenta = Color. Magenta;
clMaroon = Color. Maroon;
clMediumBlue = Color. MediumBlue;
clMediumOrchid = Color. MediumOrchid;
clMediumAquamarine = Color. MediumAquamarine;
clMediumPurple = Color. MediumPurple;
clMediumSeaGreen = Color. MediumSeaGreen;
clMediumSlateBlue = Color. MediumSlateBlue;
clPlum = Color. Plum;
clMistyRose = Color. MistyRose;
clNavy = Color. Navy;
clMidnightBlue = Color. MidnightBlue;
clMintCream = Color. MintCream;
clMediumSpringGreen = Color. MediumSpringGreen;
clMoccasin = Color. Moccasin;
clNavajoWhite = Color. NavajoWhite;
clMediumTurquoise = Color. MediumTurquoise;
clOldLace = Color. OldLace;
clOlive = Color. Olive;
clOliveDrab = Color. OliveDrab;
clOrange = Color. Orange;
clOrangeRed = Color. OrangeRed;
clOrchid = Color. Orchid;
clPaleGoldenrod = Color. PaleGoldenrod;
clPaleGreen = Color. PaleGreen;
clPaleTurquoise = Color. PaleTurquoise;
clPaleVioletRed = Color. PaleVioletRed;
clPapayaWhip = Color. PapayaWhip;
clPeachPuff = Color. PeachPuff;
clPeru = Color. Peru;
clPink = Color. Pink;
clMediumVioletRed = Color. MediumVioletRed;
clPowderBlue = Color. PowderBlue;
clPurple = Color. Purple;
clRed = Color. Red;
clRosyBrown = Color. RosyBrown;
clRoyalBlue = Color. RoyalBlue;
clSaddleBrown = Color. SaddleBrown;
clSalmon = Color. Salmon;
clSandyBrown = Color. SandyBrown;
clSeaGreen = Color. SeaGreen;
clSeaShell = Color. SeaShell;
clSienna = Color. Sienna;
clSilver = Color. Silver;
clSkyBlue = Color. SkyBlue;
clSlateBlue = Color. SlateBlue;
clSlateGray = Color. SlateGray;
clSnow = Color. Snow;
clSpringGreen = Color. SpringGreen;
clSteelBlue = Color. SteelBlue;
clTan = Color. Tan;
clTeal = Color. Teal;
clThistle = Color. Thistle;
clTomato = Color. Tomato;
clTransparent = Color. Transparent;
clTurquoise = Color. Turquoise;
clViolet = Color. Violet;
clWheat = Color. Wheat;
clWhite = Color. White;
clWhiteSmoke = Color. WhiteSmoke;
clYellow = Color. Yellow;
clYellowGreen = Color. YellowGreen;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
// Virtual Key Codes
2023-12-18 22:37:49 +03:00
VK_Back = 8 ;
VK_Tab = 9 ;
VK_LineFeed = 1 0 ;
VK_Enter = 1 3 ;
VK_Return = 1 3 ;
VK_ShiftKey = 1 6 ;
VK_ControlKey = 1 7 ;
VK_Menu = 1 8 ;
VK_Pause = 1 9 ;
VK_CapsLock = 2 0 ;
2015-05-14 22:35:07 +03:00
VK_Capital = 2 0 ;
VK_Escape = 2 7 ;
VK_Space = 3 2 ;
2023-12-18 22:37:49 +03:00
VK_Prior = 3 3 ;
VK_PageUp = 3 3 ;
VK_PageDown = 3 4 ;
VK_Next = 3 4 ;
VK_End = 3 5 ;
VK_Home = 3 6 ;
VK_Left = 3 7 ;
VK_Up = 3 8 ;
VK_Right = 3 9 ;
VK_Down = 4 0 ;
VK_Select = 4 1 ;
VK_Print = 4 2 ;
VK_Snapshot = 4 4 ;
VK_PrintScreen = 4 4 ;
VK_Insert = 4 5 ;
VK_Delete = 4 6 ;
VK_Help = 4 7 ;
VK_A = 6 5 ;
VK_B = 6 6 ;
VK_C = 6 7 ;
VK_D = 6 8 ;
VK_E = 6 9 ;
VK_F = 7 0 ;
VK_G = 7 1 ;
VK_H = 7 2 ;
VK_I = 7 3 ;
VK_J = 7 4 ;
VK_K = 7 5 ;
VK_L = 7 6 ;
VK_M = 7 7 ;
VK_N = 7 8 ;
VK_O = 7 9 ;
VK_P = 8 0 ;
VK_Q = 8 1 ;
VK_R = 8 2 ;
VK_S = 8 3 ;
VK_T = 8 4 ;
VK_U = 8 5 ;
VK_V = 8 6 ;
VK_W = 8 7 ;
VK_X = 8 8 ;
VK_Y = 8 9 ;
VK_Z = 9 0 ;
VK_LWin = 9 1 ;
VK_RWin = 9 2 ;
VK_Apps = 9 3 ;
VK_Sleep = 9 5 ;
VK_NumPad0 = 9 6 ;
VK_NumPad1 = 9 7 ;
VK_NumPad2 = 9 8 ;
VK_NumPad3 = 9 9 ;
VK_NumPad4 = 1 0 0 ;
VK_NumPad5 = 1 0 1 ;
VK_NumPad6 = 1 0 2 ;
VK_NumPad7 = 1 0 3 ;
VK_NumPad8 = 1 0 4 ;
VK_NumPad9 = 1 0 5 ;
VK_Multiply = 1 0 6 ;
VK_Add = 1 0 7 ;
VK_Separator = 1 0 8 ;
VK_Subtract = 1 0 9 ;
VK_Decimal = 1 1 0 ;
VK_Divide = 1 1 1 ;
VK_F1 = 1 1 2 ;
VK_F2 = 1 1 3 ;
VK_F3 = 1 1 4 ;
VK_F4 = 1 1 5 ;
VK_F5 = 1 1 6 ;
VK_F6 = 1 1 7 ;
VK_F7 = 1 1 8 ;
VK_F8 = 1 1 9 ;
VK_F9 = 1 2 0 ;
VK_F10 = 1 2 1 ;
VK_F11 = 1 2 2 ;
VK_F12 = 1 2 3 ;
VK_NumLock = 1 4 4 ;
VK_Scroll = 1 4 5 ;
VK_LShiftKey = 1 6 0 ;
VK_RShiftKey = 1 6 1 ;
VK_LControlKey = 1 6 2 ;
VK_RControlKey = 1 6 3 ;
VK_LMenu = 1 6 4 ;
2015-05-14 22:35:07 +03:00
VK_RMenu = 1 6 5 ;
2023-12-18 22:37:49 +03:00
VK_KeyCode = 6 5 5 3 5 ;
VK_Shift = 6 5 5 3 6 ;
VK_Control = 1 3 1 0 7 2 ;
VK_Alt = 2 6 2 1 4 4 ;
VK_Modifiers = - 6 5 5 3 6 ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
// Pen style constants
2015-05-14 22:35:07 +03:00
psSolid = DashStyle. Solid;
psClear = DashStyle. Custom;
psDash = DashStyle. Dash;
psDot = DashStyle. Dot;
psDashDot = DashStyle. DashDot;
psDashDotDot = DashStyle. DashDotDot;
2017-08-06 13:35:29 +03:00
// Pen mode constants
2015-05-14 22:35:07 +03:00
pmCopy = 0 ;
pmNot = 1 ;
2017-08-06 13:35:29 +03:00
// Brush hatch type constants
2015-05-14 22:35:07 +03:00
bhHorizontal = HatchStyle. Horizontal;
bhMin = HatchStyle. Min;
bhVertical = HatchStyle. Vertical;
bhForwardDiagonal = HatchStyle. ForwardDiagonal;
bhBackwardDiagonal = HatchStyle. BackwardDiagonal;
bhCross = HatchStyle. Cross;
bhLargeGrid = HatchStyle. LargeGrid;
bhMax = HatchStyle. Max;
bhDiagonalCross = HatchStyle. DiagonalCross;
bhPercent05 = HatchStyle. Percent05;
bhPercent10 = HatchStyle. Percent10;
bhPercent20 = HatchStyle. Percent20;
bhPercent25 = HatchStyle. Percent25;
bhPercent30 = HatchStyle. Percent30;
bhPercent40 = HatchStyle. Percent40;
bhPercent50 = HatchStyle. Percent50;
bhPercent60 = HatchStyle. Percent60;
bhPercent70 = HatchStyle. Percent70;
bhPercent75 = HatchStyle. Percent75;
bhPercent80 = HatchStyle. Percent80;
bhPercent90 = HatchStyle. Percent90;
bhLightDownwardDiagonal = HatchStyle. LightDownwardDiagonal;
bhLightUpwardDiagonal = HatchStyle. LightUpwardDiagonal;
bhDarkDownwardDiagonal = HatchStyle. DarkDownwardDiagonal;
bhDarkUpwardDiagonal = HatchStyle. DarkUpwardDiagonal;
bhWideDownwardDiagonal = HatchStyle. WideDownwardDiagonal;
bhWideUpwardDiagonal = HatchStyle. WideUpwardDiagonal;
bhLightVertical = HatchStyle. LightVertical;
bhLightHorizontal = HatchStyle. LightHorizontal;
bhNarrowVertical = HatchStyle. NarrowVertical;
bhNarrowHorizontal = HatchStyle. NarrowHorizontal;
bhDarkVertical = HatchStyle. DarkVertical;
bhDarkHorizontal = HatchStyle. DarkHorizontal;
bhDashedDownwardDiagonal = HatchStyle. DashedDownwardDiagonal;
bhDashedUpwardDiagonal = HatchStyle. DashedUpwardDiagonal;
bhDashedHorizontal = HatchStyle. DashedHorizontal;
bhDashedVertical = HatchStyle. DashedVertical;
bhSmallConfetti = HatchStyle. SmallConfetti;
bhLargeConfetti = HatchStyle. LargeConfetti;
bhZigZag = HatchStyle. ZigZag;
bhWave = HatchStyle. Wave;
bhDiagonalBrick = HatchStyle. DiagonalBrick;
bhHorizontalBrick = HatchStyle. HorizontalBrick;
bhWeave = HatchStyle. Weave;
bhPlaid = HatchStyle. Plaid;
bhDivot = HatchStyle. Divot;
bhDottedGrid = HatchStyle. DottedGrid;
bhDottedDiamond = HatchStyle. DottedDiamond;
bhShingle = HatchStyle. Shingle;
bhTrellis = HatchStyle. Trellis;
bhSphere = HatchStyle. Sphere;
bhSmallGrid = HatchStyle. SmallGrid;
bhSmallCheckerBoard = HatchStyle. SmallCheckerBoard;
bhLargeCheckerBoard = HatchStyle. LargeCheckerBoard;
bhOutlinedDiamond = HatchStyle. OutlinedDiamond;
bhSolidDiamond = HatchStyle. SolidDiamond;
// Font & Brush style constants
2017-08-06 13:35:29 +03:00
type
2015-05-14 22:35:07 +03:00
FontStyleType = ( fsNormal, fsBold, fsItalic, fsBoldItalic, fsUnderline, fsBoldUnderline, fsItalicUnderline, fsBoldItalicUnderline) ;
BrushStyleType = ( bsSolid, bsClear, bsHatch, bsGradient, bsNone) ;
2015-12-28 14:25:15 +03:00
/// Закрашивает пиксел с координатами (x,y) цветом c
2017-08-06 13:35:29 +03:00
procedure SetPixel( x, y: integer ; c: Color) ;
2015-12-28 14:25:15 +03:00
/// Закрашивает пиксел с координатами (x,y) цветом c
2017-08-06 13:35:29 +03:00
procedure PutPixel( x, y: integer ; c: Color) ;
2015-12-28 14:25:15 +03:00
/// Возвращает цвет пиксела с координатами (x,y)
2017-08-06 13:35:29 +03:00
function GetPixel( x, y: integer ) : Color;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Устанавливает текущую позицию рисования в точку (x,y)
2017-08-06 13:35:29 +03:00
procedure MoveTo( x, y: integer ) ;
2016-12-17 17:31:09 +03:00
/// Перемещает текущую позицию рисования на вектор (dx,dy)
2017-08-06 13:35:29 +03:00
procedure MoveRel( dx, dy: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует отрезок от текущей позиции до точки (x,y). Текущая позиция переносится в точку (x,y)
2017-08-06 13:35:29 +03:00
procedure LineTo( x, y: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует отрезок от текущей позиции до точки (x,y) цветом c. Текущая позиция переносится в точку (x,y)
2017-08-06 13:35:29 +03:00
procedure LineTo( x, y: integer ; c: Color) ;
2016-12-17 17:31:09 +03:00
/// Рисует отрезок от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку
2017-08-06 13:35:29 +03:00
procedure LineRel( dx, dy: integer ) ;
2016-12-17 17:31:09 +03:00
/// Рисует отрезок цветом c от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку
2017-08-06 13:35:29 +03:00
procedure LineRel( dx, dy: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Рисует отрезок от точки (x1,y1) до точки (x2,y2)
2017-08-06 13:35:29 +03:00
procedure Line( x1, y1, x2, y2: integer ) ;
2016-04-04 20:02:29 +03:00
/// Рисует отрезок от точки p1 до точки p2
2017-08-06 13:35:29 +03:00
procedure Line( p1, p2: Point) ;
2015-12-28 14:25:15 +03:00
/// Рисует отрезок от точки (x1,y1) до точки (x2,y2) цветом c
2017-08-06 13:35:29 +03:00
procedure Line( x1, y1, x2, y2: integer ; c: Color) ;
2016-04-04 20:02:29 +03:00
/// Рисует отрезок от точки p1 до точки p2 цветом c
2017-08-06 13:35:29 +03:00
procedure Line( p1, p2: Point; c: Color) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Заполняет внутренность окружности с центром (x,y) и радиусом r
2017-08-06 13:35:29 +03:00
procedure FillCircle( x, y, r: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует окружность с центром (x,y) и радиусом r
2017-08-06 13:35:29 +03:00
procedure DrawCircle( x, y, r: integer ) ;
2015-12-28 14:25:15 +03:00
/// Заполняет внутренность эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure FillEllipse( x1, y1, x2, y2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует границу эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure DrawEllipse( x1, y1, x2, y2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Заполняет внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure FillRectangle( x1, y1, x2, y2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Заполняет внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure FillRect( x1, y1, x2, y2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует границу прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure DrawRectangle( x1, y1, x2, y2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Заполняет внутренность прямоугольника с о скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
2017-08-06 13:35:29 +03:00
procedure FillRoundRect( x1, y1, x2, y2, w, h: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует границу прямоугольника с о скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
2017-08-06 13:35:29 +03:00
procedure DrawRoundRect( x1, y1, x2, y2, w, h: integer ) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Рисует заполненную окружность с центром (x,y) и радиусом r
2017-08-06 13:35:29 +03:00
procedure Circle( x, y, r: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует заполненный эллипс, ограниченный прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure Ellipse( x1, y1, x2, y2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует заполненный прямоугольник, заданный координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure Rectangle( x1, y1, x2, y2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует заполненный прямоугольник с о скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
2017-08-06 13:35:29 +03:00
procedure RoundRect( x1, y1, x2, y2, w, h: integer ) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Рисует дугу окружности с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
2017-08-06 13:35:29 +03:00
procedure Arc( x, y, r, a1, a2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Заполняет внутренность сектора окружности, ограниченного дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
2017-08-06 13:35:29 +03:00
procedure FillPie( x, y, r, a1, a2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
2017-08-06 13:35:29 +03:00
procedure DrawPie( x, y, r, a1, a2: integer ) ;
2015-12-28 14:25:15 +03:00
/// Рисует заполненный сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
2017-08-06 13:35:29 +03:00
procedure Pie( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Возвращает точку на плоскости с координатами (x,y)
2017-08-06 13:35:29 +03:00
function Pnt( x, y: integer ) : Point;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Рисует замкнутую ломаную по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure DrawPolygon( points: array of Point) ;
2016-04-04 20:02:29 +03:00
/// Рисует замкнутую ломаную по точкам, координаты которых заданы в массиве points
2017-08-06 13:35:29 +03:00
procedure DrawPolygon( params points: array of ( integer , integer ) ) ;
2015-12-28 14:25:15 +03:00
/// Заполняет многоугольник, координаты вершин которого заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure FillPolygon( points: array of Point) ;
2016-04-04 20:02:29 +03:00
/// Заполняет многоугольник, координаты вершин которого заданы в массиве points
2017-08-06 13:35:29 +03:00
procedure FillPolygon( params points: array of ( integer , integer ) ) ;
2015-12-28 14:25:15 +03:00
/// Рисует заполненный многоугольник, координаты вершин которого заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure Polygon( points: array of Point) ;
2016-04-04 20:02:29 +03:00
/// Рисует заполненный многоугольник, координаты вершин которого заданы в массиве points
2017-08-06 13:35:29 +03:00
procedure Polygon( params points: array of ( integer , integer ) ) ;
2015-12-28 14:25:15 +03:00
/// Рисует ломаную по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure Polyline( points: array of Point) ;
2016-04-04 20:02:29 +03:00
/// Рисует ломаную по точкам, координаты которых заданы в массиве points
2017-08-06 13:35:29 +03:00
procedure Polyline( params points: array of ( integer , integer ) ) ;
2015-12-28 14:25:15 +03:00
/// Рисует кривую по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure Curve( points: array of Point) ;
2016-04-04 20:02:29 +03:00
/// Рисует кривую по точкам, координаты которых заданы в массиве points
2017-08-06 13:35:29 +03:00
procedure Curve( params points: array of ( integer , integer ) ) ;
2015-12-28 14:25:15 +03:00
/// Рисует замкнутую кривую по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure DrawClosedCurve( points: array of Point) ;
2016-04-04 20:02:29 +03:00
/// Рисует замкнутую кривую по точкам, координаты которых заданы в массиве points
2017-08-06 13:35:29 +03:00
procedure DrawClosedCurve( params points: array of ( integer , integer ) ) ;
2015-12-28 14:25:15 +03:00
/// Заполняет замкнутую кривую по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure FillClosedCurve( points: array of Point) ;
2016-04-04 20:02:29 +03:00
/// Заполняет замкнутую кривую по точкам, координаты которых заданы в массиве points
2017-08-06 13:35:29 +03:00
procedure FillClosedCurve( params points: array of ( integer , integer ) ) ;
2015-12-28 14:25:15 +03:00
/// Рисует заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure ClosedCurve( points: array of Point) ;
2016-04-04 20:02:29 +03:00
/// Рисует заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
2017-08-06 13:35:29 +03:00
procedure ClosedCurve( params points: array of ( integer , integer ) ) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Выводит строку s в прямоугольник к координатами левого верхнего угла (x,y)
2017-08-06 13:35:29 +03:00
procedure TextOut( x, y: integer ; s: string ) ;
2015-12-28 14:25:15 +03:00
/// Выводит целое n в прямоугольник к координатами левого верхнего угла (x,y)
2017-08-06 13:35:29 +03:00
procedure TextOut( x, y: integer ; n: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит вещественное r в прямоугольник к координатами левого верхнего угла (x,y)
2017-08-06 13:35:29 +03:00
procedure TextOut( x, y: integer ; r: real ) ;
2015-12-28 14:25:15 +03:00
/// Выводит строку s, отцентрированную в прямоугольнике с координатами (x,y,x1,y1)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y, x1, y1: integer ; s: string ) ;
2015-12-28 14:25:15 +03:00
/// Выводит целое значение n, отцентрированное в прямоугольнике с координатами (x,y,x1,y1)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y, x1, y1: integer ; n: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит вещественное значение r, отцентрированное в прямоугольнике с координатами (x,y,x1,y1)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y, x1, y1: integer ; r: real ) ;
2016-06-15 00:36:38 +03:00
/// Выводит строку s, отцентрированное по точке с координатами (x,y)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y: integer ; s: string ) ;
2016-06-15 00:36:38 +03:00
/// Выводит целое n, отцентрированное по точке с координатами (x,y)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y: integer ; n: integer ) ;
2016-06-15 00:36:38 +03:00
/// Выводит вещественное r, отцентрированное по точке с координатами (x,y)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y: integer ; r: real ) ;
2015-12-28 14:25:15 +03:00
/// Заливает область одного цвета цветом c, начиная с точки (x,y).
2017-08-06 13:35:29 +03:00
procedure FloodFill( x, y: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
{ procedure FillCircle( x, y, r: integer ; c: Color) ;
procedure DrawCircle( x, y, r: integer ; c: Color) ;
procedure FillEllipse( x1, y1, x2, y2: integer ; c: Color) ;
procedure DrawEllipse( x1, y1, x2, y2: integer ; c: Color) ;
procedure FillRectangle( x1, y1, x2, y2: integer ; c: Color) ;
procedure FillRect( x1, y1, x2, y2: integer ; c: Color) ;
procedure DrawRectangle( x1, y1, x2, y2: integer ; c: Color) ;
procedure DrawRoundRect( x1, y1, x2, y2, w, h: integer ; c: Color) ;
procedure FillRoundRect( x1, y1, x2, y2, w, h: integer ; c: Color) ;
procedure Circle( x, y, r: integer ; c: Color) ;
procedure Ellipse( x1, y1, x2, y2: integer ; c: Color) ;
procedure Rectangle( x1, y1, x2, y2: integer ; c: Color) ;
procedure RoundRect( x1, y1, x2, y2, w, h: integer ; c: Color) ;
procedure Arc( x, y, r, a1, a2: integer ; c: Color) ;
procedure FillPie( x, y, r, a1, a2: integer ; c: Color) ;
procedure DrawPie( x, y, r, a1, a2: integer ; c: Color) ;
procedure Pie( x, y, r, a1, a2: integer ; c: Color) ;
procedure DrawPolygon( a: array of Point; c: Color) ;
procedure FillPolygon( a: array of Point; c: Color) ;
procedure Polygon( a: array of Point; c: Color) ;
procedure Polyline( a: array of Point; c: Color) ; }
//--------------------------------------------
2015-12-28 14:25:15 +03:00
//// Цвета
2015-05-14 22:35:07 +03:00
//--------------------------------------------
2015-12-28 14:25:15 +03:00
/// Возвращает цвет, который содержит красную (r), зеленую (g) и синюю (b) составляющие (r,g и b - в диапазоне от 0 до 255)
2017-08-06 13:35:29 +03:00
function RGB( r, g, b: byte ) : Color;
2015-12-28 14:25:15 +03:00
/// Возвращает цвет, который содержит красную (r), зеленую (g) и синюю (b) составляющие и прозрачность (a) (a,r,g,b - в диапазоне от 0 до 255)
2017-08-06 13:35:29 +03:00
function ARGB( a, r, g, b: byte ) : Color;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Возвращает красный цвет с интенсивностью r (r - в диапазоне от 0 до 255)
2015-05-14 22:35:07 +03:00
function RedColor( r: byte ) : Color;
2015-12-28 14:25:15 +03:00
/// Возвращает зеленый цвет с интенсивностью g (g - в диапазоне от 0 до 255)
2015-05-14 22:35:07 +03:00
function GreenColor( g: byte ) : Color;
2015-12-28 14:25:15 +03:00
/// Возвращает синий цвет с интенсивностью b (b - в диапазоне от 0 до 255)
2015-05-14 22:35:07 +03:00
function BlueColor( b: byte ) : Color;
2015-12-28 14:25:15 +03:00
/// Возвращает случайный цвет
2015-05-14 22:35:07 +03:00
function clRandom: Color;
2015-12-28 14:25:15 +03:00
/// Возвращает красную составляющую цвета
2015-05-14 22:35:07 +03:00
function GetRed( c: Color) : integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает зеленую составляющую цвета
2015-05-14 22:35:07 +03:00
function GetGreen( c: Color) : integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает синюю составляющую цвета
2015-05-14 22:35:07 +03:00
function GetBlue( c: Color) : integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает составляющую прозрачности цвета
2015-05-14 22:35:07 +03:00
function GetAlpha( c: Color) : integer ;
//--------------------------------------------
2015-12-28 14:25:15 +03:00
//// Перья
2015-05-14 22:35:07 +03:00
//--------------------------------------------
2015-12-28 14:25:15 +03:00
/// Устанавливает цвет текущего пера
2017-08-06 13:35:29 +03:00
procedure SetPenColor( c: Color) ;
2015-12-28 14:25:15 +03:00
/// Возвращает цвет текущего пера
2015-05-14 22:35:07 +03:00
function PenColor: Color;
2015-12-28 14:25:15 +03:00
/// Устанавливает ширину текущего пера
2015-05-14 22:35:07 +03:00
procedure SetPenWidth( Width: integer ) ;
2015-12-28 14:25:15 +03:00
/// Возвращает ширину текущего пера
2015-05-14 22:35:07 +03:00
function PenWidth: integer ;
2015-12-28 14:25:15 +03:00
/// Устанавливает стиль текущего пера
2015-05-14 22:35:07 +03:00
procedure SetPenStyle( style: DashStyle) ;
2015-12-28 14:25:15 +03:00
/// Возвращает стиль текущего пера
2015-05-14 22:35:07 +03:00
function PenStyle: DashStyle;
2015-12-28 14:25:15 +03:00
/// Устанавливает режим текущего пера
2015-05-14 22:35:07 +03:00
procedure SetPenMode( m: integer ) ;
2015-12-28 14:25:15 +03:00
/// Возвращает режим текущего пера
2015-05-14 22:35:07 +03:00
function PenMode: integer ;
//2015.01>
2015-12-28 14:25:15 +03:00
/// Устанавливает или отменяет режим закругленных концов линий
2015-05-14 22:35:07 +03:00
procedure SetPenRoundCap( isRoundCap: boolean ) ;
2015-12-28 14:25:15 +03:00
/// Возвращает truе , если установлен режим закругленных концов линий
2015-05-14 22:35:07 +03:00
function PenRoundCap: boolean ;
//2015.01<
2015-12-28 14:25:15 +03:00
/// Возвращают x-координату текущей позиции рисования
2015-05-14 22:35:07 +03:00
function PenX: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращают y-координату текущей позиции рисования
2015-05-14 22:35:07 +03:00
function PenY: integer ;
//--------------------------------------------
2015-12-28 14:25:15 +03:00
//// Кисти
2015-05-14 22:35:07 +03:00
//--------------------------------------------
2015-12-28 14:25:15 +03:00
/// Устанавливает цвет текущей кисти
2015-05-14 22:35:07 +03:00
procedure SetBrushColor( c: Color) ;
2015-12-28 14:25:15 +03:00
/// Возвращает цвет текущей кисти
2015-05-14 22:35:07 +03:00
function BrushColor: Color;
2015-12-28 14:25:15 +03:00
/// Устанавливает цвет текущей кисти
2015-05-14 22:35:07 +03:00
procedure SetBrushStyle( bs: BrushStyleType) ;
2015-12-28 14:25:15 +03:00
/// Возвращает цвет текущей кисти
2015-05-14 22:35:07 +03:00
function BrushStyle: BrushStyleType;
2015-12-28 14:25:15 +03:00
/// Устанавливает штриховку текущей кисти
2015-05-14 22:35:07 +03:00
procedure SetBrushHatch( bh: HatchStyle) ;
2015-12-28 14:25:15 +03:00
/// Возвращает штриховку текущей кисти
2015-05-14 22:35:07 +03:00
function BrushHatch: HatchStyle;
2015-12-28 14:25:15 +03:00
/// Устанавливает цвет заднего плана текущей штриховой кисти
2015-05-14 22:35:07 +03:00
procedure SetHatchBrushBackgroundColor( c: Color) ;
2015-12-28 14:25:15 +03:00
/// Возвращает цвет заднего плана текущей штриховой кисти
2015-05-14 22:35:07 +03:00
function HatchBrushBackgroundColor: Color;
2015-12-28 14:25:15 +03:00
/// Устанавливает второй цвет текущей градиентной кисти
2015-05-14 22:35:07 +03:00
procedure SetGradientBrushSecondColor( c: Color) ;
2015-12-28 14:25:15 +03:00
/// Возвращает второй цвет текущей градиентной кисти
2015-05-14 22:35:07 +03:00
function GradientBrushSecondColor: Color;
//--------------------------------------------
2015-12-28 14:25:15 +03:00
//// Шрифты
2015-05-14 22:35:07 +03:00
//--------------------------------------------
2015-12-28 14:25:15 +03:00
/// Устанавливает размер текущего шрифта в пунктах
2015-05-14 22:35:07 +03:00
procedure SetFontSize( size: integer ) ;
2015-12-28 14:25:15 +03:00
/// Возвращает размер текущего шрифта в пунктах
2015-05-14 22:35:07 +03:00
function FontSize: integer ;
2015-12-28 14:25:15 +03:00
/// Устанавливает имя текущего шрифта
2015-05-14 22:35:07 +03:00
procedure SetFontName( name : string ) ;
2015-12-28 14:25:15 +03:00
/// Возвращает имя текущего шрифта
2015-05-14 22:35:07 +03:00
function FontName: string ;
2015-12-28 14:25:15 +03:00
/// Устанавливает цвет текущего шрифта
2015-05-14 22:35:07 +03:00
procedure SetFontColor( c: Color) ;
2015-12-28 14:25:15 +03:00
/// Возвращает цвет текущего шрифта
2015-05-14 22:35:07 +03:00
function FontColor: Color;
2015-12-28 14:25:15 +03:00
/// Устанавливает стиль текущего шрифта
2015-05-14 22:35:07 +03:00
procedure SetFontStyle( fs: FontStyleType) ;
2015-12-28 14:25:15 +03:00
/// Возвращает стиль текущего шрифта
2015-05-14 22:35:07 +03:00
function FontStyle: FontStyleType;
2015-12-28 14:25:15 +03:00
/// Возвращает ширину строки s в пикселях при текущих настройках шрифта
2015-05-14 22:35:07 +03:00
function TextWidth( s: string ) : integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает высоту строки s в пикселях при текущих настройках шрифта
2015-05-14 22:35:07 +03:00
function TextHeight( s: string ) : integer ;
//--------------------------------------------
2015-12-28 14:25:15 +03:00
//// Графическое окно
2015-05-14 22:35:07 +03:00
//--------------------------------------------
2015-12-28 14:25:15 +03:00
/// Очищает графическое окно белым цветом
2015-05-14 22:35:07 +03:00
procedure ClearWindow;
2015-12-28 14:25:15 +03:00
/// Очищает графическое окно цветом c
2015-05-14 22:35:07 +03:00
procedure ClearWindow( c: Color) ;
2015-12-28 14:25:15 +03:00
/// Возвращает ширину клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
function WindowWidth: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает высоту клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
function WindowHeight: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает отступ графического окна от левого края экрана в пикселах
2015-05-14 22:35:07 +03:00
function WindowLeft: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает отступ графического окна от верхнего края экрана в пикселах
2015-05-14 22:35:07 +03:00
function WindowTop: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает центр графического окна
2015-05-14 22:35:07 +03:00
function WindowCenter: Point;
2015-12-28 14:25:15 +03:00
/// Возвращает True, если графическое окно имеет фиксированный размер, и False в противном случае
2015-05-14 22:35:07 +03:00
function WindowIsFixedSize: boolean ;
2015-12-28 14:25:15 +03:00
/// Устанавливает ширину клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
procedure SetWindowWidth( w: integer ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает высоту клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
procedure SetWindowHeight( h: integer ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает отступ графического окна от левого края экрана в пикселах
2015-05-14 22:35:07 +03:00
procedure SetWindowLeft( l: integer ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает отступ графического окна от верхнего края экрана в пикселах
2015-05-14 22:35:07 +03:00
procedure SetWindowTop( t: integer ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает, имеет ли графическое окно фиксированный размер
2015-05-14 22:35:07 +03:00
procedure SetWindowIsFixedSize( b: boolean ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает размеры клиентской части графического окна в пикселах
2017-08-06 13:35:29 +03:00
procedure SetWindowSize( w, h: integer ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает отступ графического окна от левого верхнего края экрана в пикселах
2017-08-06 13:35:29 +03:00
procedure SetWindowPos( l, t: integer ) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Возвращает ширину графического компонента в пикселах (по умолчанию совпадает с WindowWidth)
2015-05-14 22:35:07 +03:00
function GraphBoxWidth: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает высоту графического компонента в пикселах (по умолчанию совпадает с WindowHeight)
2015-05-14 22:35:07 +03:00
function GraphBoxHeight: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает отступ графического компонента от левого края окна в пикселах
2015-05-14 22:35:07 +03:00
function GraphBoxLeft: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает отступ графического компонента от верхнего края окна в пикселах
2015-05-14 22:35:07 +03:00
function GraphBoxTop: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает заголовок графического окна
2015-05-14 22:35:07 +03:00
function WindowCaption: string ;
2015-12-28 14:25:15 +03:00
/// Возвращает заголовок графического окна
2015-05-14 22:35:07 +03:00
function WindowTitle: string ;
2015-12-28 14:25:15 +03:00
/// Устанавливает заголовок графического окна
2015-05-14 22:35:07 +03:00
procedure SetWindowCaption( s: string ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает заголовок графического окна
2015-05-14 22:35:07 +03:00
procedure SetWindowTitle( s: string ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает ширину и высоту клиентской части графического окна в пикселах
2017-08-06 13:35:29 +03:00
procedure InitWindow( Left, Top, Width, Height: integer ; BackColor: Color : = clWhite) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Сохраняет содержимое графического окна в файл с именем fname
2015-05-14 22:35:07 +03:00
procedure SaveWindow( fname: string ) ;
2015-12-28 14:25:15 +03:00
/// Восстанавливает содержимое графического окна из файла с именем fname
2015-05-14 22:35:07 +03:00
procedure LoadWindow( fname: string ) ;
2015-12-28 14:25:15 +03:00
/// Заполняет содержимое графического окна обоями из файла с именем fname
2015-05-14 22:35:07 +03:00
procedure FillWindow( fname: string ) ;
2015-12-28 14:25:15 +03:00
/// Закрывает графическое окно и завершает приложение
2015-05-14 22:35:07 +03:00
procedure CloseWindow;
2015-12-28 14:25:15 +03:00
/// Возвращает ширину экрана в пикселях
2015-05-14 22:35:07 +03:00
function ScreenWidth: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает высоту экрана в пикселях
2015-05-14 22:35:07 +03:00
function ScreenHeight: integer ;
2015-12-28 14:25:15 +03:00
/// Центрирует графическое окно по центру экрана
2015-05-14 22:35:07 +03:00
procedure CenterWindow;
2015-12-28 14:25:15 +03:00
/// Максимизирует графическое окно
2015-05-14 22:35:07 +03:00
procedure MaximizeWindow;
2015-12-28 14:25:15 +03:00
/// Сворачивает графическое окно
2015-05-14 22:35:07 +03:00
procedure MinimizeWindow;
2015-12-28 14:25:15 +03:00
/// Возвращает графическое окно к нормальному размеру
2015-05-14 22:35:07 +03:00
procedure NormalizeWindow;
//--------------------------------------------
2015-12-28 14:25:15 +03:00
//// Буферизация рисования
2015-05-14 22:35:07 +03:00
//--------------------------------------------
2015-12-28 14:25:15 +03:00
/// Перерисовывает содержимое графического окна. Вызывается в паре с LockDrawing
2015-05-14 22:35:07 +03:00
procedure Redraw;
///--
procedure FullRedraw;
2015-12-28 14:25:15 +03:00
/// Блокирует рисование на графическом окне. Перерисовка графического окна выполняется с помощью Redraw
2015-05-14 22:35:07 +03:00
procedure LockDrawing;
2015-12-28 14:25:15 +03:00
/// Снимает блокировку рисования на графическом окне и осуществляет е г о перерисовку
2015-05-14 22:35:07 +03:00
procedure UnlockDrawing;
//--------------------------------------------
2015-12-28 14:25:15 +03:00
//// Сглаживание
2015-05-14 22:35:07 +03:00
//--------------------------------------------
2015-12-28 14:25:15 +03:00
/// Устанавливает режим сглаживания
2015-05-14 22:35:07 +03:00
procedure SetSmoothing( sm: boolean ) ;
2015-12-28 14:25:15 +03:00
/// Включает режим сглаживания
2015-05-14 22:35:07 +03:00
procedure SetSmoothingOn;
2015-12-28 14:25:15 +03:00
/// Выключает режим сглаживания
2015-05-14 22:35:07 +03:00
procedure SetSmoothingOff;
2015-12-28 14:25:15 +03:00
/// Возвращает True, если режим сглаживания установлен
2015-05-14 22:35:07 +03:00
function SmoothingIsOn: boolean ;
//--------------------------------------------
2015-12-28 14:25:15 +03:00
//// Вспомогательные подпрограммы
2015-05-14 22:35:07 +03:00
//--------------------------------------------
2015-12-28 14:25:15 +03:00
/// Блокирует прорисовку графики. Вызывается для синхронизации
2015-05-14 22:35:07 +03:00
procedure LockGraphics;
2015-12-28 14:25:15 +03:00
/// Разблокирует прорисовку графики. Вызывается для синхронизации
2015-05-14 22:35:07 +03:00
procedure UnLockGraphics;
//------------------------------------------------------------
2015-12-28 14:25:15 +03:00
//// Подпрограммы для работы с системой координат
2015-05-14 22:35:07 +03:00
//------------------------------------------------------------
2015-12-28 14:25:15 +03:00
/// Устанавливает начало координат в точку (x0,y0)
2017-08-06 13:35:29 +03:00
procedure SetCoordinateOrigin( x0, y0: integer ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает масштаб системы координат
2017-08-06 13:35:29 +03:00
procedure SetCoordinateScale( sx, sy: real ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает поворот системы координат
2015-05-14 22:35:07 +03:00
procedure SetCoordinateAngle( a: real ) ;
//----------------------------------------
2015-12-28 14:25:15 +03:00
//// Сервисные подпрограммы
2015-05-14 22:35:07 +03:00
//----------------------------------------
2015-12-28 14:25:15 +03:00
/// Возвращает прямоугольник, заданный координатами противоположных вершин
2017-08-06 13:35:29 +03:00
function Rect( x1, y1, x2, y2: integer ) : System. Drawing. Rectangle;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Возвращает прямоугольник клиентской части главного окна
2015-05-14 22:35:07 +03:00
function ClientRectangle: System. Drawing. Rectangle;
2019-01-28 03:30:18 +03:00
/// Коэффициент масштабирования экрана
function ScreenScale: real ;
/// Размер экрана в пикселах
function ScreenSize: System. Drawing. Size;
2015-05-14 22:35:07 +03:00
//------------------------------------------
2015-12-28 14:25:15 +03:00
//// Рисование графиков функций
2015-05-14 22:35:07 +03:00
//------------------------------------------
2016-01-01 23:41:25 +03:00
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b, min, max: real ; x1, y1, x2, y2: integer ) ;
2016-01-05 13:10:24 +03:00
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b, min, max: real ; r: System. Drawing. Rectangle) ;
2016-01-05 13:10:24 +03:00
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b, min, max: real ) ;
2016-01-01 23:41:25 +03:00
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b: real ; x1, y1, x2, y2: integer ) ;
2016-01-01 23:41:25 +03:00
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике r
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b: real ; r: System. Drawing. Rectangle) ;
2016-01-01 23:41:25 +03:00
/// Рисует график функции f, заданной на отрезке [-5,5], в прямоугольнике r
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; r: System. Drawing. Rectangle) ;
2016-01-01 23:41:25 +03:00
/// Рисует график функции f, заданной на отрезке [a,b], на полное графическое окно
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b: real ) ;
2016-01-01 23:41:25 +03:00
/// Рисует график функции f, заданной на отрезке [-5,5], на полное графическое окно
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ) ;
2015-05-14 22:35:07 +03:00
//------------------------------------------
2015-12-28 14:25:15 +03:00
//// Рисование изображений
2015-05-14 22:35:07 +03:00
//------------------------------------------
2015-12-28 14:25:15 +03:00
/// Выводит растровое изображение из файла с именем fname в позицию x,y
2015-05-14 22:35:07 +03:00
procedure Draw( fname: string ; x: integer : = 0 ; y: integer : = 0 ) ;
2015-12-28 14:25:15 +03:00
/// Выводит растровое изображение из файла с именем fname в позицию x,y, масштабируя е г о к размеру w на h
2017-08-06 13:35:29 +03:00
procedure Draw( fname: string ; x, y, w, h: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит растровое изображение из файла с именем fname в позицию x,y, масштабируя е г о с коэффициентом Scale
2017-08-06 13:35:29 +03:00
procedure Draw( fname: string ; x, y: integer ; Scale: real ) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Инициализирует графическое окно. Используется для внутренних целей
2015-05-14 22:35:07 +03:00
procedure InitGraphABC;
2017-08-06 13:35:29 +03:00
type
/// Тип пера GraphABC
2015-05-14 22:35:07 +03:00
GraphABCPen = class
2023-12-18 22:37:49 +03:00
private
2015-05-14 22:35:07 +03:00
_NETPen: System. Drawing. Pen;
procedure SetColor( c: GraphABC. Color) ;
function GetColor: GraphABC. Color;
procedure SetWidth( w: integer ) ;
function GetWidth: integer ;
procedure SetStyle( st: DashStyle) ;
function GetStyle: DashStyle;
procedure SetMode( m: integer ) ;
function GetMode: integer ;
procedure SetNETPen( p: System. Drawing. Pen) ;
function GetX: integer ;
function GetY: integer ;
2017-08-06 13:35:29 +03:00
//2015.01>
2015-05-14 22:35:07 +03:00
procedure SetRoundCap( isRoundCap: boolean ) ;
function GetRoundCap: boolean ;
2017-08-06 13:35:29 +03:00
//2015.01<
public
2015-12-28 14:25:15 +03:00
/// Текущее перо .NET
2015-05-14 22:35:07 +03:00
property NETPen: System. Drawing. Pen read _NETPen write SetNETPen;
2015-12-28 14:25:15 +03:00
/// Цвет пера
2015-05-14 22:35:07 +03:00
property Color: GraphABC. Color read GetColor write SetColor;
2015-12-28 14:25:15 +03:00
/// Ширина пера
2015-05-14 22:35:07 +03:00
property Width: integer read GetWidth write SetWidth;
2015-12-28 14:25:15 +03:00
/// Стиль пера
2015-05-14 22:35:07 +03:00
property Style: DashStyle read GetStyle write SetStyle;
2015-12-28 14:25:15 +03:00
/// Режим пера
2015-05-14 22:35:07 +03:00
property Mode: integer read GetMode write SetMode;
2015-12-28 14:25:15 +03:00
/// X-координата текущей позиции пера
2015-05-14 22:35:07 +03:00
property X: integer read GetX;
2015-12-28 14:25:15 +03:00
/// Y-координата текущей позиции пера
2015-05-14 22:35:07 +03:00
property Y: integer read GetY;
2017-08-06 13:35:29 +03:00
//2015.01>
/// Режим закругленных концов линий
2015-05-14 22:35:07 +03:00
property RoundCap: boolean read GetRoundCap write SetRoundCap;
2017-08-06 13:35:29 +03:00
//2015.01<
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
/// Тип кисти GraphABC
2015-05-14 22:35:07 +03:00
GraphABCBrush = class
2023-12-18 22:37:49 +03:00
private
2015-05-14 22:35:07 +03:00
_NETBrush: System. Drawing. Brush;
procedure SetNETBrush( b: System. Drawing. Brush) ;
procedure SetColor( c: GraphABC. Color) ;
function GetColor: GraphABC. Color;
procedure SetStyle( st: BrushStyleType) ;
function GetStyle: BrushStyleType;
procedure SetHatch( h: HatchStyle) ;
function GetHatch: HatchStyle;
procedure SetHatchBackgroundColor( c: GraphABC. Color) ;
function GetHatchBackgroundColor: GraphABC. Color;
procedure SetGradientSecondColor( c: GraphABC. Color) ;
function GetGradientSecondColor: GraphABC. Color;
2017-08-06 13:35:29 +03:00
public
/// Текущая кисть .NET
2015-05-14 22:35:07 +03:00
property NETBrush: System. Drawing. Brush read _NETBrush write SetNETBrush;
2017-08-06 13:35:29 +03:00
/// Цвет кисти
2015-05-14 22:35:07 +03:00
property Color: GraphABC. Color read GetColor write SetColor;
2017-08-06 13:35:29 +03:00
/// Стиль кисти
2015-05-14 22:35:07 +03:00
property Style: BrushStyleType read GetStyle write SetStyle;
2017-08-06 13:35:29 +03:00
/// Штриховка кисти
2015-05-14 22:35:07 +03:00
property Hatch: HatchStyle read GetHatch write SetHatch;
2017-08-06 13:35:29 +03:00
/// Цвет заднего плана штриховой кисти
2015-05-14 22:35:07 +03:00
property HatchBackgroundColor: GraphABC. Color read GetHatchBackgroundColor write SetHatchBackgroundColor;
2017-08-06 13:35:29 +03:00
/// Второй цвет градиентной кисти
2015-05-14 22:35:07 +03:00
property GradientSecondColor: GraphABC. Color read GetGradientSecondColor write SetGradientSecondColor;
end ;
2017-08-06 13:35:29 +03:00
/// Тип шрифта GraphABC
2015-05-14 22:35:07 +03:00
GraphABCFont = class
2023-12-18 22:37:49 +03:00
private
2015-05-14 22:35:07 +03:00
_NETFont: System. Drawing. Font;
procedure SetNETFont( f: System. Drawing. Font) ;
procedure SetColor( c: GraphABC. Color) ;
function GetColor: GraphABC. Color;
procedure SetStyle( st: FontStyleType) ;
function GetStyle: FontStyleType;
procedure SetSize( sz: integer ) ;
function GetSize: integer ;
procedure SetName( nm: string ) ;
function GetName: string ;
2017-08-06 13:35:29 +03:00
public
/// Текущий шрифт .NET
2015-05-14 22:35:07 +03:00
property NETFont: System. Drawing. Font read _NETFont write SetNETFont;
2015-12-28 14:25:15 +03:00
/// Цвет шрифта
2015-05-14 22:35:07 +03:00
property Color: GraphABC. Color read GetColor write SetColor;
2015-12-28 14:25:15 +03:00
/// Стиль шрифта
2015-05-14 22:35:07 +03:00
property Style: FontStyleType read GetStyle write SetStyle;
2015-12-28 14:25:15 +03:00
/// Размер шрифта в пунктах
2015-05-14 22:35:07 +03:00
property Size: integer read GetSize write SetSize;
2015-12-28 14:25:15 +03:00
/// Наименование шрифта
2015-05-14 22:35:07 +03:00
property Name : string read GetName write SetName;
end ;
GraphABCCoordinate = class
2023-12-18 22:37:49 +03:00
private
2015-05-14 22:35:07 +03:00
coef: integer ;
procedure SetOriginX( x: integer ) ;
procedure SetOriginY( y: integer ) ;
procedure SetOrigin( p: Point) ;
procedure SetAngle( a: real ) ;
procedure SetScaleX( sx: real ) ;
procedure SetScaleY( sy: real ) ;
function GetOriginX: integer ;
function GetOriginY: integer ;
function GetOrigin: Point;
function GetAngle: real ;
function GetScaleX: real ;
function GetScaleY: real ;
function GetMatrix: System. Drawing. Drawing2D. Matrix;
2023-12-18 22:37:49 +03:00
public
2015-05-14 22:35:07 +03:00
constructor ;
2015-12-28 14:25:15 +03:00
/// Устанавливает параметры системы координат
2017-08-06 13:35:29 +03:00
procedure SetTransform( x0, y0, angle, sx, sy: real ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает начало системы координат
2017-08-06 13:35:29 +03:00
procedure SetOrigin( x0, y0: integer ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает масштаб системы координат
2017-08-06 13:35:29 +03:00
procedure SetScale( sx, sy: real ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает масштаб системы координат
2015-05-14 22:35:07 +03:00
procedure SetScale( scale: real ) ;
2015-12-28 14:25:15 +03:00
/// Устанавливает правую систему координат (ось OY направлена вверх, ось OX - вправо)
2015-05-14 22:35:07 +03:00
procedure SetMathematic;
2015-12-28 14:25:15 +03:00
/// Устанавливает левую систему координат (ось OY направлена вниз, ось OX - вправо)
2015-05-14 22:35:07 +03:00
procedure SetStandard;
2016-06-24 23:00:16 +03:00
procedure ScaleOn( scale: real ) ;
2017-08-06 13:35:29 +03:00
procedure Transform( x, y: real ) ;
2016-06-24 23:00:16 +03:00
procedure Rotate( angle: real ) ;
procedure ClearMatrix;
2017-08-06 13:35:29 +03:00
2015-12-28 14:25:15 +03:00
/// X-координата начала координат относительно левого верхнего угла окна
2015-05-14 22:35:07 +03:00
property OriginX: integer read GetOriginX write SetOriginX;
2015-12-28 14:25:15 +03:00
/// Y-координата начала координат относительно левого верхнего угла окна
2015-05-14 22:35:07 +03:00
property OriginY: integer read GetOriginY write SetOriginY;
2015-12-28 14:25:15 +03:00
/// Координаты начала координат относительно левого верхнего угла окна
2015-05-14 22:35:07 +03:00
property Origin: Point read GetOrigin write SetOrigin;
2015-12-28 14:25:15 +03:00
/// Угол поворота системы координат
2015-05-14 22:35:07 +03:00
property Angle: real read GetAngle write SetAngle;
2015-12-28 14:25:15 +03:00
/// Масштаб системы координат по оси X
2015-05-14 22:35:07 +03:00
property ScaleX: real read GetScaleX write SetScaleX;
2015-12-28 14:25:15 +03:00
/// Масштаб системы координат по оси Y
2015-05-14 22:35:07 +03:00
property ScaleY: real read GetScaleY write SetScaleY;
2015-12-28 14:25:15 +03:00
/// Масштаб системы координат по обоим осям
2015-05-14 22:35:07 +03:00
property Scale: real write SetScale;
2015-12-28 14:25:15 +03:00
/// Матрица 3x3 преобразований координат
2015-05-14 22:35:07 +03:00
property Matrix: System. Drawing. Drawing2D. Matrix read GetMatrix;
end ;
GraphABCWindow = class
2023-12-18 22:37:49 +03:00
private
2015-05-14 22:35:07 +03:00
procedure SetLeft( l: integer ) ;
function GetLeft: integer ;
procedure SetTop( t: integer ) ;
function GetTop: integer ;
procedure SetWidth( w: integer ) ;
function GetWidth: integer ;
procedure SetHeight( h: integer ) ;
function GetHeight: integer ;
procedure SetCaption( c: string ) ;
function GetCaption: string ;
procedure SetIsFixedSize( b: boolean ) ;
function GetIsFixedSize: boolean ;
2017-08-06 13:35:29 +03:00
public
/// Отступ графического окна от левого края экрана в пикселах
property Left: integer read GetLeft write SetLeft;
/// Отступ графического окна от верхнего края экрана в пикселах
property Top: integer read GetTop write SetTop;
/// Ширина клиентской части графического окна в пикселах
property Width: integer read GetWidth write SetWidth;
/// Высота клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
property Height: integer read GetHeight write SetHeight;
2017-08-06 13:35:29 +03:00
/// Заголовок графического окна
2015-05-14 22:35:07 +03:00
property Caption: string read GetCaption write SetCaption;
2017-08-06 13:35:29 +03:00
/// Заголовок графического окна
2015-05-14 22:35:07 +03:00
property Title: string read GetCaption write SetCaption;
2017-08-06 13:35:29 +03:00
/// Имеет ли графическое окно фиксированный размер
2015-05-14 22:35:07 +03:00
property IsFixedSize: boolean read GetIsFixedSize write SetIsFixedSize;
2017-08-06 13:35:29 +03:00
/// Очищает графическое окно белым цветом
2015-05-14 22:35:07 +03:00
procedure Clear;
2017-08-06 13:35:29 +03:00
/// Очищает графическое окно цветом c
2015-05-14 22:35:07 +03:00
procedure Clear( c: Color) ;
2017-08-06 13:35:29 +03:00
/// Устанавливает размеры клиентской части графического окна в пикселах
procedure SetSize( w, h: integer ) ;
/// Устанавливает отступ графического окна от левого верхнего края экрана в пикселах
procedure SetPos( l, t: integer ) ;
/// Устанавливает положение, размеры и цвет графического окна
procedure Init( Left, Top, Width, Height: integer ; BackColor: Color : = clWhite) ;
/// Сохраняет содержимое графического окна в файл с именем fname
procedure Save( fname: string ) ;
/// Восстанавливает содержимое графического окна из файла с именем fname
procedure Load( fname: string ) ;
/// Заполняет содержимое графического окна обоями из файла с именем fname
procedure Fill( fname: string ) ;
/// Закрывает графическое окно и завершает приложение
2015-05-14 22:35:07 +03:00
procedure Close;
2017-08-06 13:35:29 +03:00
/// Сворачивает графическое окно
2015-05-14 22:35:07 +03:00
procedure Minimize;
2017-08-06 13:35:29 +03:00
/// Максимизирует графическое окно
2015-05-14 22:35:07 +03:00
procedure Maximize;
2017-08-06 13:35:29 +03:00
/// Возвращает графическое окно к нормальному размеру
2015-05-14 22:35:07 +03:00
procedure Normalize;
2017-08-06 13:35:29 +03:00
/// Центрирует графическое окно по центру экрана
2015-05-14 22:35:07 +03:00
procedure CenterOnScreen;
2017-08-06 13:35:29 +03:00
/// Возвращает центр графического окна
2015-05-14 22:35:07 +03:00
function Center: Point;
end ;
2017-04-23 00:06:33 +03:00
GraphABCStatusPanel = class
2023-12-18 22:37:49 +03:00
private
2017-04-23 00:06:33 +03:00
p: System. Windows. Forms. ToolStripStatusLabel;
procedure SetText( s: string ) ;
function GetText: string ;
2023-12-18 22:37:49 +03:00
public
2017-08-06 13:35:29 +03:00
constructor( pp: System. Windows. Forms. ToolStripStatusLabel) ;
2017-04-23 00:06:33 +03:00
property Text : string read GetText write SetText;
end ;
GraphABCStatus = class
2023-12-18 22:37:49 +03:00
private
2017-04-23 00:06:33 +03:00
procedure SetText( s: string ) ;
function GetText: string ;
procedure SetPanelsCount( n: integer ) ;
function GetPanelsCount: integer ;
function GetItem( i: integer ) : GraphABCStatusPanel;
2023-12-18 22:37:49 +03:00
public
2017-04-23 00:06:33 +03:00
procedure Show;
procedure Hide;
property Text : string read GetText write SetText;
2023-12-18 22:37:49 +03:00
property Items[ i: integer ] : GraphABCStatusPanel read GetItem; default ;
2017-04-23 00:06:33 +03:00
property PanelsCount: integer read GetPanelsCount write SetPanelsCount;
end ;
2017-08-06 13:35:29 +03:00
/// Тип рисунка GraphABC
2015-05-14 22:35:07 +03:00
Picture = class
2023-12-18 22:37:49 +03:00
public
2017-08-06 13:35:29 +03:00
bmp, savedbmp: Bitmap;
2015-05-14 22:35:07 +03:00
gb: Graphics;
istransp: boolean ;
transpcolor: System. Drawing. Color;
procedure SetWidth( w: integer ) ;
function GetWidth: integer ;
procedure SetHeight( h: integer ) ;
function GetHeight: integer ;
procedure SetTransparent( b: boolean ) ;
procedure SetTransparentColor( c: GraphABC. Color) ;
function GetTransparentColor: GraphABC. Color;
2017-08-06 13:35:29 +03:00
public
/// Создает рисунок размера w на h пикселей
constructor Create( w, h: integer ) ;
/// Создает рисунок из файла с именем fname
2015-05-14 22:35:07 +03:00
constructor Create( fname: string ) ;
2017-08-06 13:35:29 +03:00
/// Создает рисунок из прямоугольника r графического окна
constructor Create( r: System. Drawing. Rectangle) ; // Create from screen
/// Загружает рисунок из файла с именем fname
2015-05-14 22:35:07 +03:00
procedure Load( fname: string ) ;
2017-08-06 13:35:29 +03:00
/// Сохраняет рисунок в файл с именем fname
2015-05-14 22:35:07 +03:00
procedure Save( fname: string ) ;
2017-08-06 13:35:29 +03:00
/// Устанавливает размер рисунка w на h пикселей
procedure SetSize( w, h: integer ) ;
/// Ширина рисунка в пикселах
2015-05-14 22:35:07 +03:00
property Width: integer read GetWidth write SetWidth;
2017-08-06 13:35:29 +03:00
/// Высота рисунка в пикселах
2015-05-14 22:35:07 +03:00
property Height: integer read GetHeight write SetHeight;
2017-08-06 13:35:29 +03:00
/// Прозрачность рисунка; прозрачный цвет задается свойством TransparentColor
2015-05-14 22:35:07 +03:00
property Transparent: boolean read istransp write SetTransparent;
2017-08-06 13:35:29 +03:00
/// Прозрачный цвет рисунка. Должна быть установлена прозрачность Transparent := True
2015-05-14 22:35:07 +03:00
property TransparentColor: GraphABC. Color read GetTransparentColor write SetTransparentColor;
2017-08-06 13:35:29 +03:00
/// Возвращает True, если изображение данного рисунка пересекается с изображением рисунка p, и False в противном случае. Белый цвет считается прозрачным
2015-05-14 22:35:07 +03:00
function Intersect( p: Picture) : boolean ;
2017-08-06 13:35:29 +03:00
/// Выводит рисунок в позиции (x,y)
2015-05-14 22:35:07 +03:00
procedure Draw( x: integer : = 0 ; y: integer : = 0 ) ;
2017-08-06 13:35:29 +03:00
/// Выводит рисунок в позиции (x,y) на поверхность рисования g
procedure Draw( x, y: integer ; g: Graphics) ;
/// Выводит рисунок в позиции (x,y), масштабируя е г о к размеру (w,h)
procedure Draw( x, y, w, h: integer ) ;
/// Выводит рисунок в позиции (x,y), масштабируя е г о к размеру (w,h), на поверхность рисования g
procedure Draw( x, y, w, h: integer ; g: Graphics) ;
/// Выводит часть рисунка, заключенную в прямоугольнике r, в позиции (x,y)
procedure Draw( x, y: integer ; r: System. Drawing. Rectangle) ; // r - part of Picture
/// Выводит часть рисунка, заключенную в прямоугольнике r, в позиции (x,y) на поверхность рисования g
procedure Draw( x, y: integer ; r: System. Drawing. Rectangle; g: Graphics) ;
/// Выводит часть рисунка, заключенную в прямоугольнике r, в позиции (x,y), масштабируя е г о к размеру (w,h)
procedure Draw( x, y, w, h: integer ; r: System. Drawing. Rectangle) ; // r - part of Picture
/// Выводит часть рисунка, заключенную в прямоугольнике r, в позиции (x,y), масштабируя е г о к размеру (w,h), на поверхность рисования g
procedure Draw( x, y, w, h: integer ; r: System. Drawing. Rectangle; g: Graphics) ;
/// Выводит рисунок, повернутый на угол rotateAngle, масштабируя е г о к размеру (w,h)
procedure Draw( x, y: integer ; rotateAngle: real ; w, h: integer ) ;
/// Копирует прямоугольник src рисунка p в прямоугольник dst текущего рисунка
2015-05-14 22:35:07 +03:00
procedure CopyRect( dst: System. Drawing. Rectangle; p: Picture; src: System. Drawing. Rectangle) ;
2017-08-06 13:35:29 +03:00
/// Копирует прямоугольник src битового образа bmp в прямоугольник dst текущего рисунка
2015-05-14 22:35:07 +03:00
procedure CopyRect( dst: System. Drawing. Rectangle; bmp: Bitmap; src: System. Drawing. Rectangle) ;
2017-08-06 13:35:29 +03:00
/// Зеркально отображает рисунок относительно горизонтальной оси симметрии
2015-05-14 22:35:07 +03:00
procedure FlipHorizontal;
2017-08-06 13:35:29 +03:00
/// Зеркально отображает рисунок относительно вертикальной оси симметрии
2015-05-14 22:35:07 +03:00
procedure FlipVertical;
2017-08-06 13:35:29 +03:00
/// Закрашивает пиксел (x,y) рисунка цветом c
procedure SetPixel( x, y: integer ; c: Color) ;
/// Закрашивает пиксел (x,y) рисунка цветом c
procedure PutPixel( x, y: integer ; c: Color) ;
/// Возвращает цвет пиксела (x,y) рисунка
function GetPixel( x, y: integer ) : Color;
/// Выводит на рисунке отрезок от точки (x1,y1) до точки (x2,y2)
procedure Line( x1, y1, x2, y2: integer ) ;
/// Выводит на рисунке отрезок от точки (x1,y1) до точки (x2,y2) цветом c
procedure Line( x1, y1, x2, y2: integer ; c: Color) ;
/// Заполняет на рисунке внутренность окружности с центром (x,y) и радиусом r
procedure FillCircle( x, y, r: integer ) ;
/// Выводит на рисунке окружность с центром (x,y) и радиусом r
procedure DrawCircle( x, y, r: integer ) ;
/// Заполняет на рисунке внутренность эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
procedure FillEllipse( x1, y1, x2, y2: integer ) ;
/// Выводит на рисунке границу эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
procedure DrawEllipse( x1, y1, x2, y2: integer ) ;
/// Заполняет на рисунке внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
procedure FillRectangle( x1, y1, x2, y2: integer ) ;
/// Заполняет на рисунке внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
procedure FillRect( x1, y1, x2, y2: integer ) ;
/// Выводит на рисунке границу ы прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
procedure DrawRectangle( x1, y1, x2, y2: integer ) ;
/// Выводит на рисунке заполненную окружность с центром (x,y) и радиусом r
procedure Circle( x, y, r: integer ) ;
/// Выводит на рисунке заполненный эллипс, ограниченный прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
procedure Ellipse( x1, y1, x2, y2: integer ) ;
/// Выводит на рисунке заполненный прямоугольник, заданный координатами противоположных вершин (x1,y1) и (x2,y2)
procedure Rectangle( x1, y1, x2, y2: integer ) ;
/// Выводит на рисунке заполненный прямоугольник с о скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
procedure RoundRect( x1, y1, x2, y2, w, h: integer ) ;
/// Выводит на рисунке дугу окружности с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
procedure Arc( x, y, r, a1, a2: integer ) ;
/// Заполняет на рисунке внутренность сектора окружности, ограниченного дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
procedure FillPie( x, y, r, a1, a2: integer ) ;
/// Выводит на рисунке сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
procedure DrawPie( x, y, r, a1, a2: integer ) ;
/// Выводит на рисунке заполненный сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
procedure Pie( x, y, r, a1, a2: integer ) ;
/// Выводит на рисунке замкнутую ломаную по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure DrawPolygon( points: array of Point) ;
2017-08-06 13:35:29 +03:00
/// Заполняет на рисунке многоугольник, координаты вершин которого заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure FillPolygon( points: array of Point) ;
2017-08-06 13:35:29 +03:00
/// Выводит на рисунке заполненный многоугольник, координаты вершин которого заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure Polygon( points: array of Point) ;
2017-08-06 13:35:29 +03:00
/// Выводит на рисунке ломаную по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure Polyline( points: array of Point) ;
2017-08-06 13:35:29 +03:00
/// Выводит на рисунке кривую по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure Curve( points: array of Point) ;
2017-08-06 13:35:29 +03:00
/// Выводит на рисунке замкнутую кривую по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure DrawClosedCurve( points: array of Point) ;
2017-08-06 13:35:29 +03:00
/// Заполняет на рисунке замкнутую кривую по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure FillClosedCurve( points: array of Point) ;
2017-08-06 13:35:29 +03:00
/// Выводит на рисунке заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
2015-05-14 22:35:07 +03:00
procedure ClosedCurve( points: array of Point) ;
2017-08-06 13:35:29 +03:00
/// Выводит на рисунке строку s в прямоугольник к координатами левого верхнего угла (x,y)
procedure TextOut( x, y: integer ; s: string ) ;
/// Заливает на рисунке область одного цвета цветом c, начиная с точки (x,y).
procedure FloodFill( x, y: integer ; c: Color) ;
/// Очищает рисунок белым цветом
2015-05-14 22:35:07 +03:00
procedure Clear;
2017-08-06 13:35:29 +03:00
/// Очищает рисунок цветом c
2015-05-14 22:35:07 +03:00
procedure Clear( c: Color) ;
end ;
2017-08-06 13:35:29 +03:00
type
2015-05-14 22:35:07 +03:00
ABCControl = class( Control)
2023-12-18 22:37:49 +03:00
private
2015-05-14 22:35:07 +03:00
procedure OnPaint( sender: Object ; e: PaintEventArgs) ;
procedure OnClosing( sender: Object ; e: FormClosingEventArgs) ;
procedure OnMouseDown( sender: Object ; e: MouseEventArgs) ;
procedure OnMouseUp( sender: Object ; e: MouseEventArgs) ;
procedure OnMouseMove( sender: Object ; e: MouseEventArgs) ;
procedure OnKeyDown( sender: Object ; e: KeyEventArgs) ;
procedure OnKeyUp( sender: Object ; e: KeyEventArgs) ;
procedure OnKeyPress( sender: Object ; e: KeyPressEventArgs) ;
procedure OnResize( sender: Object ; e: EventArgs) ;
procedure Init;
2023-12-18 22:37:49 +03:00
protected
2015-05-14 22:35:07 +03:00
function IsInputKey( keyData: Keys) : boolean ; override ;
2017-08-06 13:35:29 +03:00
procedure OnPaintBackground( e: PaintEventArgs) ; override ; begin end ; // сами все перерисовываем!
2015-05-14 22:35:07 +03:00
2023-12-18 22:37:49 +03:00
public
2017-08-06 13:35:29 +03:00
constructor( w, h: integer ) ;
end ;
2015-12-28 14:25:15 +03:00
/// Создает рисунок размера w на h пикселов и записывает е г о в переменную p
2017-08-06 13:35:29 +03:00
procedure CreatePicture( var p: Picture; w, h: integer ) ;
2015-12-28 14:25:15 +03:00
/// Возвращает окно графического приложения
2015-05-14 22:35:07 +03:00
function Window: GraphABCWindow;
2015-12-28 14:25:15 +03:00
/// Возвращает главную форму графического приложения
2015-05-14 22:35:07 +03:00
function MainForm: Form;
2015-12-28 14:25:15 +03:00
/// Возвращает графический компонент
2015-05-14 22:35:07 +03:00
function GraphABCControl: ABCControl;
2015-12-28 14:25:15 +03:00
/// Возвращает текущее перо
2015-05-14 22:35:07 +03:00
function Pen: GraphABCPen;
2015-12-28 14:25:15 +03:00
/// Возвращает текущую кисть
2015-05-14 22:35:07 +03:00
function Brush: GraphABCBrush;
2015-12-28 14:25:15 +03:00
/// Возвращает текущий шрифт
2015-05-14 22:35:07 +03:00
function Font: GraphABCFont;
2015-12-28 14:25:15 +03:00
/// Возвращает систему координат GraphABC
2015-05-14 22:35:07 +03:00
function Coordinate: GraphABCCoordinate;
2017-04-23 00:06:33 +03:00
/// Строка статуса
function StatusBar: GraphABCStatus;
2015-05-14 22:35:07 +03:00
function GraphWindowGraphics: Graphics;
function GraphBufferGraphics: Graphics;
function GraphBufferBitmap: Bitmap;
2015-12-28 14:25:15 +03:00
/// Устанавливает консольный ввод-вывод
2015-05-14 22:35:07 +03:00
procedure SetConsoleIO;
2015-12-28 14:25:15 +03:00
/// Устанавливает ввод-вывод через графическое окно (по умолчанию)
2015-05-14 22:35:07 +03:00
procedure SetGraphABCIO;
2017-08-06 13:35:29 +03:00
var
/// Событие нажатия на кнопку мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 1, если нажата левая кнопка мыши, и 2, если нажата правая кнопка мыши
OnMouseDown: procedure( x, y, mousebutton: integer ) ;
/// Событие отжатия кнопки мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 1, если отжата левая кнопка мыши, и 2, если отжата правая кнопка мыши
OnMouseUp: procedure( x, y, mousebutton: integer ) ;
/// Событие перемещения мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 0, если кнопка мыши не нажата, 1, если нажата левая кнопка мыши, и 2, если нажата правая кнопка мыши
OnMouseMove: procedure( x, y, mousebutton: integer ) ;
/// Событие нажатия клавиши
OnKeyDown: procedure( key: integer ) ;
/// Событие отжатия клавиши
OnKeyUp: procedure( key: integer ) ;
/// Событие нажатия символьной клавиши
OnKeyPress: procedure( ch: char ) ;
/// Событие изменения размера графического окна
2015-05-14 22:35:07 +03:00
OnResize: procedure ;
2017-08-06 13:35:29 +03:00
/// Событие закрытия графического окна
2015-05-14 22:35:07 +03:00
OnClose: procedure ;
2017-08-06 13:35:29 +03:00
/// Процедурная переменная перерисовки графического окна. Если равна nil, то используется стандартная перерисовка
2015-05-14 22:35:07 +03:00
RedrawProc: procedure ;
2017-08-06 13:35:29 +03:00
/// Следует ли рисовать во внеэкранном буфере
2015-05-14 22:35:07 +03:00
DrawInBuffer: boolean ;
///--
procedure __InitModule__;
implementation
uses
System. Threading,
GraphABCHelper;
2017-08-06 13:35:29 +03:00
const
2015-12-28 14:25:15 +03:00
FILE_NOT_FOUND_MESSAGE = 'Файл {0} не найден' ;
BUTTON_ENTER_TEXT = 'Ввести' ;
2017-08-06 13:35:29 +03:00
type
2015-05-14 22:35:07 +03:00
Proc1Integer = procedure( x: integer ) ;
Proc1String = procedure( s: string ) ;
2017-08-06 13:35:29 +03:00
Proc2Integer = procedure( x, y: integer ) ;
2015-05-14 22:35:07 +03:00
Proc1Boolean = procedure( b: boolean ) ;
Proc1BorderStyle = procedure( st: FormBorderStyle) ;
IOGraphABCSystem = class( IOStandardSystem)
2023-12-18 22:37:49 +03:00
public
2015-05-14 22:35:07 +03:00
constructor Create;
2017-08-06 13:35:29 +03:00
// procedure write(p: pointer); override;
2023-12-18 22:37:49 +03:00
procedure write( obj: object ) ; override ;
procedure writeln; override ;
function read_symbol: char ; override ;
function peek: integer ; override ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
2023-12-18 22:37:49 +03:00
var
IsRunningOnMono : = System. Type . GetType( 'Mono.Runtime' ) < > nil ;
2022-07-13 12:11:04 +03:00
2017-08-06 13:35:29 +03:00
function SetProcessDPIAware( ) : boolean ; external 'user32.dll' ;
2019-01-28 03:30:18 +03:00
function operator * ( s: Size; r: real ) : Size; extensionmethod;
begin
2023-12-18 22:37:49 +03:00
Result : = new Size( Round( s. Width * r) , Round( s. Height * r) )
2019-01-28 03:30:18 +03:00
end ;
function operator * ( p: Point; r: real ) : Point; extensionmethod;
begin
2023-12-18 22:37:49 +03:00
Result : = new Point( Round( p. X * r) , Round( p. Y * r) )
2019-01-28 03:30:18 +03:00
end ;
2017-08-06 13:35:29 +03:00
var
2015-12-28 14:25:15 +03:00
// строка-буфер ввода
2015-05-14 22:35:07 +03:00
MainThread: Thread;
2015-12-28 14:25:15 +03:00
// строка-буфер ввода
2015-05-14 22:35:07 +03:00
readbuffer: string ;
_Window: GraphABCWindow : = new GraphABCWindow;
_MainForm: Form;
_GraphABCControl: ABCControl;
_Pen : = new GraphABCPen;
_Brush : = new GraphABCBrush;
_Font : = new GraphABCFont;
_Coordinate : = new GraphABCCoordinate;
2017-04-23 00:06:33 +03:00
_StatusBar : = new GraphABCStatus;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
__buffer: Bitmap;
bmp: Bitmap;
gr: Graphics;
gbmp: Graphics;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
f: ABCControl;
ed: TextBox;
IOPanel: Panel;
EnterButton: Button;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
CurrentSolidBrush: SolidBrush;
CurrentHatchBrush: HatchBrush;
CurrentGradientBrush: LinearGradientBrush;
PixelBrush: SolidBrush;
// For MoveTo, LineTo
2017-08-06 13:35:29 +03:00
x_coord, y_coord: integer ;
2015-05-14 22:35:07 +03:00
NotLockDrawing: boolean ;
StartIsComplete: boolean ;
MainFormThread: System. Threading. Thread;
// coords for write
2017-08-06 13:35:29 +03:00
writecoords: Point : = new Point( 1 , 1 ) ;
// font for write
// CurrentWriteFont: System.Drawing.Font;
// format for TextWidth
2015-05-14 22:35:07 +03:00
sf: StringFormat;
// ------------ IOGraphABCSystem -----------------
constructor IOGraphABCSystem. Create;
begin
lock f do
begin
2017-08-06 13:35:29 +03:00
{ var fnt : = GraphABC. Font. NETFont;
GraphABC. Font. NETFont : = CurrentWriteFont;
GraphABC. Font. NETFont : = fnt; }
2015-05-14 22:35:07 +03:00
readbuffer : = '' ;
end ;
end ;
procedure NextLine;
begin
writecoords. X : = 1 ;
2017-08-06 13:35:29 +03:00
writecoords. Y + = TextHeight( 'a' ) - 1 ;
2015-05-14 22:35:07 +03:00
if writecoords. Y > Window. Height then
begin
writecoords. Y : = 1 ;
end ;
end ;
procedure IOGraphABCSystem. write( obj: object ) ;
2017-08-06 13:35:29 +03:00
function CountSymBeforeDivision( s: string ) : integer ;
begin
var tw : = TextWidth( s) ;
var rem : = Window. Width - writecoords. X;
if rem = 0 then
Result : = 0
else if tw < = rem then // строка влазит полностью
Result : = Length( s)
else
begin
// ns - примерное количество символов до переноса
var ns : = Round( Length( s) * rem / TextWidth( s) ) ;
if ns > Length( s) then
ns : = Length( s) ;
tw : = TextWidth( s. Substring( 0 , ns) ) ;
if tw > rem then
while tw > rem do
begin// начинаем уменьшать ns, пока не влезет
ns - = 1 ;
tw : = TextWidth( s. Substring( 0 , ns) ) ;
end
else if tw = rem then
begin
// ничего не делать
end
else
begin// tw < rem
// увеличиваем ns
while ( ns < Length( s) ) and ( tw < rem) do
begin
ns + = 1 ;
tw : = TextWidth( s. Substring( 0 , ns) ) ;
end ;
if tw > rem then
ns - = 1 ;
end ;
Result : = ns;
end ;
end ;
procedure InternalWrite( s: string ) ;
begin
2015-05-14 22:35:07 +03:00
var cs : = CountSymBeforeDivision( s) ;
if cs = Length( s) then
begin
2017-08-06 13:35:29 +03:00
TextOut( writecoords. X - 1 , writecoords. Y - 1 , s) ;
var w : = TextWidth( s) - 1 ;
2015-05-14 22:35:07 +03:00
writecoords. X + = w;
end
else
begin
2017-08-06 13:35:29 +03:00
var srem : = s. Substring( cs, s. Length - cs) ;
s : = s. Substring( 0 , cs) ;
TextOut( writecoords. X - 1 , writecoords. Y - 1 , s) ;
2015-05-14 22:35:07 +03:00
NextLine;
InternalWrite( srem) ;
end ;
2017-08-06 13:35:29 +03:00
end ;
2015-05-14 22:35:07 +03:00
begin
2024-05-07 12:19:23 +03:00
var s : = ObjectToString( obj) ;
2015-05-14 22:35:07 +03:00
lock f do
begin
2017-08-06 13:35:29 +03:00
//var fnt := GraphABC.Font.NETFont;
// GraphABC.Font.NETFont := CurrentWriteFont;
2015-05-14 22:35:07 +03:00
InternalWrite( s) ;
2017-08-06 13:35:29 +03:00
// GraphABC.Font.NETFont := fnt;
2015-05-14 22:35:07 +03:00
end ;
end ;
procedure IOGraphABCSystem. writeln;
begin
NextLine
end ;
procedure SetIOPanelVisible;
begin
ed. Text : = '' ;
IOPanel. Visible : = True ;
MainForm. Height : = MainForm. Height + ed. Height;
MainForm. ActiveControl : = ed;
end ;
procedure SetIOPanelInVisible;
begin
IOPanel. Visible : = False ;
MainForm. ActiveControl : = f;
MainForm. Height : = MainForm. Height - ed. Height;
end ;
function IOGraphABCSystem. read_symbol: char ;
begin
2017-08-06 13:35:29 +03:00
if readbuffer. Length = 0 then
2015-05-14 22:35:07 +03:00
begin
IOPanel. Invoke( SetIOPanelVisible) ;
2015-12-28 14:25:15 +03:00
// приостановить основной поток
2015-05-14 22:35:07 +03:00
MainThread. Suspend;
end ;
Result : = readBuffer[ 1 ] ;
2017-08-06 13:35:29 +03:00
readBuffer : = readBuffer. Remove( 0 , 1 ) ;
2015-05-14 22:35:07 +03:00
end ;
function IOGraphABCSystem. peek: integer ;
begin
2017-08-06 13:35:29 +03:00
if readbuffer. Length = 0 then
2015-05-14 22:35:07 +03:00
begin
IOPanel. Invoke( SetIOPanelVisible) ;
2015-12-28 14:25:15 +03:00
// приостановить основной поток
2015-05-14 22:35:07 +03:00
MainThread. Suspend;
end ;
Result : = integer( readBuffer[ 1 ] ) ;
end ;
// ------------ GraphABCCoordinate -----------------
constructor GraphABCCoordinate. Create;
begin
2015-12-28 14:25:15 +03:00
// 1 - компьютерная система координат (ось OY - вниз)
2017-09-02 22:29:44 +03:00
// -1 - математическия система координат (ось OY - вверх)
2015-05-14 22:35:07 +03:00
coef : = 1 ;
end ;
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetTransform( x0, y0, angle, sx, sy: real ) ;
2015-05-14 22:35:07 +03:00
begin
sx : = abs( sx) ;
sy : = abs( sy) ;
angle : = DegToRad( angle) ;
var m11 : = sx * cos( angle) ;
var m12 : = coef * sx * sin( angle) ;
2017-08-06 13:35:29 +03:00
var m21 : = - sy * sin( angle) ;
2015-05-14 22:35:07 +03:00
var m22 : = coef * sy * cos( angle) ;
2017-08-06 13:35:29 +03:00
var m : = new System. Drawing. Drawing2D. Matrix( m11, m12, m21, m22, x0, y0) ;
2015-05-14 22:35:07 +03:00
lock f do
begin
gr. Transform : = m;
gbmp. Transform : = m;
end ;
end ;
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetOrigin( x0, y0: integer ) : = SetTransform( x0, y0, Angle, ScaleX, ScaleY) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetScale( sx, sy: real ) : = SetTransform( OriginX, OriginY, Angle, sx, sy) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetScale( scale: real ) : = SetScale( scale, scale) ;
2015-05-14 22:35:07 +03:00
procedure GraphABCCoordinate. SetMathematic;
begin
coef : = - 1 ;
2017-08-06 13:35:29 +03:00
SetTransform( OriginX, OriginY, Angle, ScaleX, ScaleY) ;
2015-05-14 22:35:07 +03:00
end ;
procedure GraphABCCoordinate. SetStandard;
begin
coef : = 1 ;
2017-08-06 13:35:29 +03:00
SetTransform( OriginX, OriginY, Angle, ScaleX, ScaleY) ;
2015-05-14 22:35:07 +03:00
end ;
2016-06-24 23:00:16 +03:00
procedure GraphABCCoordinate. ScaleOn( scale: real ) ;
begin
lock f do
begin
2017-08-06 13:35:29 +03:00
gr. ScaleTransform( scale, scale) ;
gbmp. ScaleTransform( scale, scale) ;
2016-06-24 23:00:16 +03:00
end ;
end ;
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. Transform( x, y: real ) ;
2016-06-24 23:00:16 +03:00
begin
lock f do
begin
2017-08-06 13:35:29 +03:00
gr. TranslateTransform( x, y) ;
gbmp. TranslateTransform( x, y)
2016-06-24 23:00:16 +03:00
end ;
end ;
procedure GraphABCCoordinate. Rotate( angle: real ) ;
begin
lock f do
begin
gr. RotateTransform( angle) ;
gbmp. RotateTransform( angle) ;
end ;
end ;
procedure GraphABCCoordinate. ClearMatrix;
begin
lock f do
begin
gr. Transform : = new System. Drawing. Drawing2D. Matrix( ) ;
gbmp. Transform : = new System. Drawing. Drawing2D. Matrix( ) ;
end ;
end ;
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetOriginX( x: integer ) : = SetOrigin( x, OriginY) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetOriginY( y: integer ) : = SetOrigin( OriginX, y) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetOrigin( p: Point) : = SetOrigin( p. x, p. y) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetAngle( a: real ) : = SetTransform( OriginX, OriginY, a, ScaleX, ScaleY) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetScaleX( sx: real ) : = SetScale( sx, ScaleY) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate. SetScaleY( sy: real ) : = SetScale( ScaleX, sy) ;
2015-05-14 22:35:07 +03:00
function GraphABCCoordinate. GetOriginX: integer ;
begin
lock ( f) do
Result : = Round( gr. Transform. OffsetX) ;
end ;
2017-08-06 13:35:29 +03:00
function GraphABCCoordinate. GetOrigin : = new Point( GetOriginX, GetOriginY) ;
2015-05-14 22:35:07 +03:00
function GraphABCCoordinate. GetOriginY: integer ;
begin
lock( f) do
Result : = Round( gr. Transform. OffsetY) ;
end ;
function GraphABCCoordinate. GetAngle: real ;
begin
var a : = Coordinate. Matrix. Elements;
2017-08-06 13:35:29 +03:00
Result : = ArcSin( a[ 1 ] / ScaleY) ;
if a[ 0 ] < 0 then
if a[ 1 ] > 0 then
2015-05-14 22:35:07 +03:00
Result : = Pi - Result
else Result : = - Pi - Result ;
2017-08-06 13:35:29 +03:00
Result * = coef * 1 8 0 / Pi;
2015-05-14 22:35:07 +03:00
end ;
function GraphABCCoordinate. GetScaleX: real ;
begin
var a : = Coordinate. Matrix. Elements;
2017-08-06 13:35:29 +03:00
Result : = sqrt( sqr( a[ 0 ] ) + sqr( a[ 1 ] ) ) ;
2015-05-14 22:35:07 +03:00
end ;
function GraphABCCoordinate. GetScaleY: real ;
begin
var a : = Coordinate. Matrix. Elements;
2017-08-06 13:35:29 +03:00
Result : = sqrt( sqr( a[ 2 ] ) + sqr( a[ 3 ] ) ) ;
2015-05-14 22:35:07 +03:00
end ;
function GraphABCCoordinate. GetMatrix: System. Drawing. Drawing2D. Matrix;
begin
lock ( f) do
Result : = gr. Transform;
end ;
2017-08-06 13:35:29 +03:00
procedure SetCoordinateOrigin( x0, y0: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Coordinate. SetOrigin( x0, y0) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure SetCoordinateScale( sx, sy: real ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Coordinate. SetScale( sx, sy) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure SetCoordinateAngle( a: real ) : = Coordinate. Angle : = a;
2015-05-14 22:35:07 +03:00
{ function CurrentABCWindow: ABCWindow;
begin
Result : = f;
end ; }
2017-08-06 13:35:29 +03:00
procedure LockGraphics : = Monitor. Enter( f) ;
procedure UnLockGraphics : = Monitor. Exit( f) ;
2015-05-14 22:35:07 +03:00
procedure SetSmoothingOn;
begin
gr. SmoothingMode : = SmoothingMode. AntiAlias;
gbmp. SmoothingMode : = SmoothingMode. AntiAlias;
end ;
procedure SetSmoothingOff;
begin
gr. SmoothingMode : = SmoothingMode. None;
gbmp. SmoothingMode : = SmoothingMode. None;
end ;
procedure SetSmoothing( sm: boolean ) ;
begin
if sm then
SetSmoothingOn
else SetSmoothingOff;
end ;
2017-08-06 13:35:29 +03:00
function SmoothingIsOn : = gr. SmoothingMode = SmoothingMode. AntiAlias;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
function GraphWindowGraphics : = gr;
function GraphBufferGraphics : = gbmp;
function GraphBufferBitmap : = bmp;
2015-05-14 22:35:07 +03:00
// Graphics Primitives
// ------------ __MyPen -----------------
procedure GraphABCPen. SetColor( c: GraphABC. Color) ;
begin
SetPenColor( c) ;
end ;
function GraphABCPen. GetColor: GraphABC. Color;
begin
Result : = PenColor;
end ;
procedure GraphABCPen. SetWidth( w: integer ) ;
begin
SetPenWidth( w) ;
end ;
function GraphABCPen. GetWidth: integer ;
begin
Result : = PenWidth;
end ;
procedure GraphABCPen. SetStyle( st: DashStyle) ;
begin
SetPenStyle( st) ;
end ;
function GraphABCPen. GetStyle: DashStyle;
begin
Result : = PenStyle;
end ;
procedure GraphABCPen. SetMode( m: integer ) ;
begin
SetPenMode( m) ;
end ;
function GraphABCPen. GetMode: integer ;
begin
Result : = PenMode;
2017-08-06 13:35:29 +03:00
end ;
2015-05-14 22:35:07 +03:00
procedure GraphABCPen. SetNETPen( p: System. Drawing. Pen) ;
begin
2017-08-06 13:35:29 +03:00
if p = nil then exit;
2015-05-14 22:35:07 +03:00
_NETPen : = p;
end ;
function GraphABCPen. GetX: integer ;
begin
Result : = PenX;
2017-08-06 13:35:29 +03:00
end ;
2015-05-14 22:35:07 +03:00
function GraphABCPen. GetY: integer ;
begin
Result : = PenY;
2017-08-06 13:35:29 +03:00
end ;
2015-05-14 22:35:07 +03:00
//2015.01>
procedure GraphABCPen. SetRoundCap( isRoundCap: boolean ) ;
begin
SetPenRoundCap( isRoundCap) ;
end ;
function GraphABCPen. GetRoundCap: boolean ;
begin
result : = PenRoundCap;
2017-08-06 13:35:29 +03:00
end ;
2015-05-14 22:35:07 +03:00
//2015.01<
//!!!!!!!!!!!!!!!!!!!!
// ------------ GraphABCBrush -----------------
procedure GraphABCBrush. SetNETBrush( b: System. Drawing. Brush) ;
begin
//if b=nil then Exit;
_NETBrush : = b;
end ;
procedure GraphABCBrush. SetColor( c: GraphABC. Color) ;
begin
SetBrushColor( c) ;
end ;
function GraphABCBrush. GetColor: GraphABC. Color;
begin
Result : = BrushColor;
end ;
procedure GraphABCBrush. SetStyle( st: BrushStyleType) ;
begin
SetBrushStyle( st) ;
end ;
function GraphABCBrush. GetStyle: BrushStyleType;
begin
Result : = BrushStyle;
end ;
procedure GraphABCBrush. SetHatch( h: HatchStyle) ;
begin
SetBrushHatch( h) ;
end ;
function GraphABCBrush. GetHatch: HatchStyle;
begin
Result : = BrushHatch;
end ;
procedure GraphABCBrush. SetHatchBackgroundColor( c: GraphABC. Color) ;
begin
SetHatchBrushBackgroundColor( c) ;
end ;
function GraphABCBrush. GetHatchBackgroundColor: GraphABC. Color;
begin
Result : = HatchBrushBackgroundColor;
end ;
procedure GraphABCBrush. SetGradientSecondColor( c: GraphABC. Color) ;
begin
SetGradientBrushSecondColor( c) ;
end ;
function GraphABCBrush. GetGradientSecondColor: GraphABC. Color;
begin
Result : = GradientBrushSecondColor;
end ;
// ------------ GraphABCFont -----------------
procedure GraphABCFont. SetNETFont( f: System. Drawing. Font) ;
begin
2017-08-06 13:35:29 +03:00
if f = nil then Exit;
2015-05-14 22:35:07 +03:00
_NetFont : = f;
end ;
procedure GraphABCFont. SetColor( c: GraphABC. Color) ;
begin
SetFontColor( c) ;
end ;
function GraphABCFont. GetColor: GraphABC. Color;
begin
Result : = FontColor;
end ;
procedure GraphABCFont. SetStyle( st: FontStyleType) ;
begin
SetFontStyle( st) ;
end ;
function GraphABCFont. GetStyle: FontStyleType;
begin
Result : = FontStyle;
end ;
procedure GraphABCFont. SetSize( sz: integer ) ;
begin
SetFontSize( sz) ;
end ;
function GraphABCFont. GetSize: integer ;
begin
Result : = FontSize;
end ;
procedure GraphABCFont. SetName( nm: string ) ;
begin
SetFontName( nm) ;
end ;
function GraphABCFont. GetName: string ;
begin
Result : = FontName;
end ;
2017-08-06 13:35:29 +03:00
var
_StatusStrip: System. Windows. Forms. StatusStrip : = nil ;
2017-04-23 00:06:33 +03:00
procedure AddStatusBarP;
begin
_StatusStrip : = new System. Windows. Forms. StatusStrip;
_StatusStrip. Items. Add( new System. Windows. Forms. ToolStripStatusLabel) ;
_StatusStrip. BackColor : = Color. White;
MainForm. Controls. Add( _StatusStrip) ;
end ;
procedure AddStatusBar;
begin
f. Invoke( AddStatusBarP) ;
end ;
// GraphABCStatusPanel
constructor GraphABCStatusPanel. Create( pp: System. Windows. Forms. ToolStripStatusLabel) ;
begin
p : = pp
end ;
procedure SetTextP( p: System. Windows. Forms. ToolStripStatusLabel; s: string ) ;
begin
p. Text : = s
end ;
procedure GraphABCStatusPanel. SetText( s: string ) ;
begin
2017-08-06 13:35:29 +03:00
f. Invoke( SetTextP, p, s)
2017-04-23 00:06:33 +03:00
end ;
function GraphABCStatusPanel. GetText: string ;
begin
Result : = p. Text
end ;
procedure SetStatusTextP( s: string ) ;
begin
_StatusStrip. Items[ 0 ] . Text : = s
end ;
// GraphABCStatus
procedure GraphABCStatus. SetText( s: string ) ;
begin
2017-08-06 13:35:29 +03:00
if ( _StatusStrip = nil ) or ( _StatusStrip. Visible = False ) then
2017-04-23 00:06:33 +03:00
Show;
2017-08-06 13:35:29 +03:00
f. Invoke( SetStatusTextP, s) ;
2017-04-23 00:06:33 +03:00
end ;
function GraphABCStatus. GetText: string ;
begin
2017-08-06 13:35:29 +03:00
if ( _StatusStrip = nil ) or ( _StatusStrip. Visible = False ) then
2017-04-23 00:06:33 +03:00
Show;
Result : = _StatusStrip. Items[ 0 ] . Text
end ;
procedure SetPanelsCountP( n: integer ) ;
begin
2017-08-06 13:35:29 +03:00
if n < 1 then n : = 1 ;
if n > 1 0 then n : = 1 0 ;
if n > _StatusStrip. Items. Count then
2017-04-23 00:06:33 +03:00
begin
var d : = n - _StatusStrip. Items. Count;
2017-08-06 13:35:29 +03:00
for var i : = 1 to d do
2017-04-23 00:06:33 +03:00
_StatusStrip. Items. Add( new System. Windows. Forms. ToolStripStatusLabel) ;
end ;
end ;
procedure GraphABCStatus. SetPanelsCount( n: integer ) ;
begin
2017-08-06 13:35:29 +03:00
if ( _StatusStrip = nil ) or ( _StatusStrip. Visible = False ) then
2017-04-23 00:06:33 +03:00
Show;
2017-08-06 13:35:29 +03:00
f. Invoke( SetPanelsCountP, n) ;
2017-04-23 00:06:33 +03:00
end ;
function GraphABCStatus. GetPanelsCount : = _StatusStrip. Items. Count;
function GraphABCStatus. GetItem( i: integer ) : GraphABCStatusPanel;
begin
2017-08-06 13:35:29 +03:00
if ( _StatusStrip = nil ) or ( _StatusStrip. Visible = False ) then
2017-04-23 00:06:33 +03:00
Show;
var p : = _StatusStrip. Items[ i] as System. Windows. Forms. ToolStripStatusLabel;
Result : = new GraphABCStatusPanel( p) ;
end ;
procedure GraphABCStatus. Show;
begin
2017-08-06 13:35:29 +03:00
if _StatusStrip < > nil then
_StatusStrip. Visible : = True
else AddStatusBar
2017-04-23 00:06:33 +03:00
end ;
procedure PHide;
begin
_StatusStrip. Visible : = False ;
end ;
procedure GraphABCStatus. Hide;
begin
f. Invoke( PHide) ;
end ;
2015-05-14 22:35:07 +03:00
// Picture
2017-08-06 13:35:29 +03:00
constructor Picture. Create( w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
if ( w < = 0 ) or ( h < = 0 ) then
2015-05-14 22:35:07 +03:00
raise new GraphABCException( 'w or h <= 0' ) ;
2017-08-06 13:35:29 +03:00
bmp : = new Bitmap( w, h) ;
2015-05-14 22:35:07 +03:00
gb : = Graphics. FromImage( bmp) ;
2017-08-06 13:35:29 +03:00
transpcolor : = bmp. GetPixel( 0 , bmp. Height - 1 ) ;
2015-05-14 22:35:07 +03:00
istransp : = false ;
savedbmp : = nil ;
end ;
constructor Picture. Create( fname: string ) ;
begin
try
2017-08-06 13:35:29 +03:00
var fs : = new System. IO. FileStream( fname, System. IO. FileMode. Open) ;
var tmp : = Image. FromStream( fs) ;
2015-05-14 22:35:07 +03:00
bmp : = new Bitmap( tmp) ;
fs. Flush;
fs. Close;
tmp. Dispose;
2017-08-06 13:35:29 +03:00
except
on ex: System. ArgumentException do
raise new System. IO. FileNotFoundException( string . Format( FILE_NOT_FOUND_MESSAGE, fname) ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
gb : = Graphics. FromImage( bmp) ; //!!!
2017-08-06 13:35:29 +03:00
transpcolor : = bmp. GetPixel( 0 , bmp. Height - 1 ) ;
2015-05-14 22:35:07 +03:00
istransp : = false ;
savedbmp : = nil ;
end ;
constructor Picture. Create( r: System. Drawing. Rectangle) ;
// Create from Screen
begin
2017-08-06 13:35:29 +03:00
bmp : = new Bitmap( r. Width, r. Height) ;
2015-05-14 22:35:07 +03:00
gb : = Graphics. FromImage( bmp) ;
2017-08-06 13:35:29 +03:00
gb. CopyFromScreen( r. Left, r. Top, 0 , 0 , r. Size) ;
transpcolor : = bmp. GetPixel( 0 , bmp. Height - 1 ) ;
2015-05-14 22:35:07 +03:00
istransp : = false ;
savedbmp : = nil ;
end ;
procedure Picture. SetWidth( w: integer ) ;
begin
2017-08-06 13:35:29 +03:00
SetSize( w, Height) ;
2015-05-14 22:35:07 +03:00
end ;
function Picture. GetWidth: integer ;
begin
Result : = bmp. Width;
end ;
procedure Picture. SetHeight( h: integer ) ;
begin
2017-08-06 13:35:29 +03:00
SetSize( Width, h) ;
2015-05-14 22:35:07 +03:00
end ;
function Picture. GetHeight: integer ;
begin
Result : = bmp. Height;
end ;
{
2015-12-28 14:25:15 +03:00
// Логика установки прозрачности
2015-05-14 22:35:07 +03:00
// 1. Transparent := True - savedbmp:=bmp; bmp:=bmp.Clone; bmp.MakeTransparent(transpcolor);
// 2. Transparent := False - bmp.Dispose; bmp := savedbmp; savedbmp := nil;
// 3. Transparentcolor := c
2015-12-28 14:25:15 +03:00
// a) Если Transparent = False, то просто присвоить
// б ) Если Transparent = True, то bmp.Dispose; bmp:=savedbmp.Clone; bmp.MakeTransparent(transpcolor);
2015-05-14 22:35:07 +03:00
}
function Picture. GetTransparentColor: Color;
begin
Result : = transpcolor;
end ;
procedure Picture. SetTransparentColor( c: Color) ;
begin
2017-08-06 13:35:29 +03:00
if c = TransparentColor then
2015-05-14 22:35:07 +03:00
Exit;
transpcolor : = c;
if istransp then
begin
bmp. Dispose;
2017-08-06 13:35:29 +03:00
var ob : = savedbmp. Clone;
2015-05-14 22:35:07 +03:00
bmp : = Bitmap( ob) ;
bmp. MakeTransparent( transpcolor) ;
end ;
end ;
procedure Picture. SetTransparent( b: boolean ) ;
begin
if b = istransp then
Exit;
istransp : = b;
if istransp then
begin
savedbmp : = bmp;
2017-08-06 13:35:29 +03:00
var ob : = bmp. Clone;
2015-05-14 22:35:07 +03:00
bmp : = Bitmap( ob) ;
bmp. MakeTransparent( transpcolor) ;
end
else
begin
bmp. Dispose;
bmp : = savedbmp;
savedbmp : = nil ;
end ;
end ;
procedure Picture. Load( fname: string ) ;
begin
bmp. Dispose;
2017-08-06 13:35:29 +03:00
//2015.01>
// bmp := new Bitmap(fname);
2015-05-14 22:35:07 +03:00
try
2017-08-06 13:35:29 +03:00
var fs : = new System. IO. FileStream( fname, System. IO. FileMode. Open) ;
var tmp : = Image. FromStream( fs) ;
2015-05-14 22:35:07 +03:00
bmp : = new Bitmap( tmp) ;
fs. Flush;
fs. Close;
tmp. Dispose;
2017-08-06 13:35:29 +03:00
except
on ex: System. ArgumentException do
raise new System. IO. FileNotFoundException( string . Format( FILE_NOT_FOUND_MESSAGE, fname) ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
//2015.01<
2015-05-14 22:35:07 +03:00
gb : = Graphics. FromImage( bmp) ;
istransp : = False ;
2017-08-06 13:35:29 +03:00
if savedbmp < > nil then
2015-05-14 22:35:07 +03:00
begin
savedbmp. Dispose;
savedbmp : = nil ;
end ;
end ;
procedure Picture. Save( fname: string ) ;
begin
bmp. Save( fname) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. SetSize( w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
var oldbmp : = bmp;
bmp : = new Bitmap( oldbmp, w, h) ;
2015-05-14 22:35:07 +03:00
gb : = Graphics. FromImage( bmp) ;
2017-08-06 13:35:29 +03:00
gb. DrawImage( oldbmp, 0 , 0 ) ;
2015-05-14 22:35:07 +03:00
oldbmp. Dispose;
2017-08-06 13:35:29 +03:00
// TODO не знаю, может, надо что-то делать для прозрачной
{ if istransp then
2015-05-14 22:35:07 +03:00
begin
end }
end ;
function Picture. Intersect( p: Picture) : boolean ;
begin
2017-08-06 13:35:29 +03:00
// bmp.L
2015-05-14 22:35:07 +03:00
result : = false ;
2017-08-06 13:35:29 +03:00
// TODO
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
gr. DrawImage( bmp, x, y, bmp. Width, bmp. Height) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
gbmp. DrawImage( bmp, x, y, bmp. Width, bmp. Height) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y: integer ; g: Graphics) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
g. DrawImage( bmp, x, y, bmp. Width, bmp. Height) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y, w, h: integer ) ;
2015-05-14 22:35:07 +03:00
// Draw bmp scaled to size w,h
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
gr. DrawImage( bmp, x, y, w, h) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
gbmp. DrawImage( bmp, x, y, w, h) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y, w, h: integer ; g: Graphics) ;
2015-05-14 22:35:07 +03:00
// Draw bmp scaled to size w,h
begin
2017-08-06 13:35:29 +03:00
g. DrawImage( bmp, x, y, w, h) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y: integer ; r: System. Drawing. Rectangle) ;
2015-05-14 22:35:07 +03:00
// Draw bmp in rectangle r
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
gr. DrawImage( bmp, x, y, r, GraphicsUnit. Pixel) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
gbmp. DrawImage( bmp, x, y, r, GraphicsUnit. Pixel) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y: integer ; r: System. Drawing. Rectangle; g: Graphics) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
g. DrawImage( bmp, x, y, r, GraphicsUnit. Pixel) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y, w, h: integer ; r: System. Drawing. Rectangle) ;
2015-05-14 22:35:07 +03:00
// Draw rectangle r portion of bmp scaled to size w,h
begin
2017-08-06 13:35:29 +03:00
var r1 : = new System. Drawing. Rectangle( x, y, w, h) ;
var tempbmp : = GetView( bmp, r) ;
2015-05-14 22:35:07 +03:00
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
gr. DrawImage( tempbmp, r1) ;
// gr.DrawImage(bmp,r1,r,GraphicsUnit.Pixel);
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
gbmp. DrawImage( tempbmp, r1) ;
// gbmp.DrawImage(bmp,r1,r,GraphicsUnit.Pixel);
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
tempbmp. Dispose;
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y, w, h: integer ; r: System. Drawing. Rectangle; g: Graphics) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
var tempbmp : = GetView( bmp, r) ;
g. DrawImage( tempbmp, x, y, new System. Drawing. Rectangle( x, y, w, h) , GraphicsUnit. Pixel) ;
2015-05-14 22:35:07 +03:00
tempbmp. Dispose;
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Draw( x, y: integer ; rotateAngle: real ; w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
var phi : = ( rotateAngle / 3 6 0 ) * 2 * Pi; //угол в радианах
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
//размер после поворота
2017-08-06 13:35:29 +03:00
var new_w: integer : = round( w * abs( cos( phi) ) + h * abs( sin( phi) ) ) ;
var new_h: integer : = round( w * abs( sin( phi) ) + h * abs( cos( phi) ) ) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
var newImg: Bitmap : = new Bitmap( new_w, new_h) ;
var g: Graphics : = Graphics. FromImage( newImg) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
g. Clear( Color. FromArgb( 0 , 0 , 0 , 0 ) ) ;
g. TranslateTransform( new_w / 2 , new_h / 2 ) ;
2015-05-14 22:35:07 +03:00
g. RotateTransform( rotateAngle) ;
2017-08-06 13:35:29 +03:00
g. TranslateTransform( - new_w / 2 , - new_h / 2 ) ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
g. DrawImage( bmp, ( new_w - w) / 2 , ( new_h - h) / 2 , w, h) ;
2015-12-28 14:25:15 +03:00
//(x+w/2, y+h/2) - центр масштабированного изображения
//(x+new_w/2, y+new_h/2) - центр масштабированного и повернутого изображения
2015-05-14 22:35:07 +03:00
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
gr. DrawImage( newImg, x - ( new_w - w) / 2 , y - ( new_h - h) / 2 , new_w, new_h) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
gbmp. DrawImage( newImg, x - ( new_w - w) / 2 , y - ( new_h - h) / 2 , new_w, new_h) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
2017-08-06 13:35:29 +03:00
end ;
2015-05-14 22:35:07 +03:00
procedure Picture. CopyRect( dst: System. Drawing. Rectangle; p: Picture; src: System. Drawing. Rectangle) ;
// Copy src portion of p on dst rectangle of this picture
begin
2017-08-06 13:35:29 +03:00
CopyRect( dst, p. bmp, src) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. CopyRect( dst: System. Drawing. Rectangle; bmp: Bitmap; src: System. Drawing. Rectangle) ;
begin
2017-08-06 13:35:29 +03:00
// Copy src portion of bmp on dst rectangle of this picture
2022-09-20 11:43:55 +03:00
//var tempbmp := GetView(bmp, src); // SSM 17/09/22 заменил это сложное - не работает под Linux
2023-12-18 22:37:49 +03:00
var tempbmp : = bmp. Clone( src, bmp. PixelFormat) ;
2017-08-06 13:35:29 +03:00
// gb.DrawImage(bmp,dst,src,GraphicsUnit.Pixel);
gb. DrawImage( tempbmp, dst) ;
2015-05-14 22:35:07 +03:00
tempbmp. Dispose;
end ;
procedure Picture. FlipHorizontal;
begin
bmp. RotateFlip( RotateFlipType. RotateNoneFlipX) ;
end ;
procedure Picture. FlipVertical;
begin
bmp. RotateFlip( RotateFlipType. RotateNoneFlipY) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. SetPixel( x, y: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
bmp. SetPixel( x, y, c) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. PutPixel( x, y: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
bmp. SetPixel( x, y, c) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
function Picture. GetPixel( x, y: integer ) : Color;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Result : = bmp. GetPixel( x, y) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Line( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Line( x1, y1, x2, y2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Line( x1, y1, x2, y2: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Line( x1, y1, x2, y2, c, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. FillCircle( x, y, r: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. FillEllipse( x - r, y - r, x + r, y + r, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. DrawCircle( x, y, r: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. DrawEllipse( x - r, y - r, x + r, y + r, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. FillEllipse( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. FillEllipse( x1, y1, x2, y2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. DrawEllipse( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. DrawEllipse( x1, y1, x2, y2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. FillRectangle( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. FillRectangle( x1, y1, x2, y2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. FillRect( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. FillRectangle( x1, y1, x2, y2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. DrawRectangle( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. DrawRectangle( x1, y1, x2, y2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Circle( x, y, r: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Ellipse( x - r, y - r, x + r, y + r, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Ellipse( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Ellipse( x1, y1, x2, y2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Rectangle( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Rectangle( x1, y1, x2, y2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. RoundRect( x1, y1, x2, y2, w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. RoundRect( x1, y1, x2, y2, w, h, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Arc( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Arc( x, y, r, a1, a2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. FillPie( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. FillPie( x, y, r, a1, a2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. DrawPie( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. DrawPie( x, y, r, a1, a2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. Pie( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Pie( x, y, r, a1, a2, gb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. DrawPolygon( points: array of Point) ;
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. DrawPolygon( points, gb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. FillPolygon( points: array of Point) ;
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. FillPolygon( points, gb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. Polygon( points: array of Point) ;
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Polygon( points, gb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. Polyline( points: array of Point) ;
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Polyline( points, gb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. Curve( points: array of Point) ;
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. Curve( points, gb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. DrawClosedCurve( points: array of Point) ;
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. DrawClosedCurve( points, gb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. FillClosedCurve( points: array of Point) ;
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. FillClosedCurve( points, gb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. ClosedCurve( points: array of Point) ;
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. ClosedCurve( points, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Picture. TextOut( x, y: integer ; s: string ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
GraphABCHelper. TextOut( x, y, s, gb) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
function ExtFloodFill( hdc: IntPtr ; x, y: integer ; color: integer ; filltype: integer ) : boolean ; external 'Gdi32.dll' name 'ExtFloodFill' ;
2015-05-14 22:35:07 +03:00
function SelectObject( hdc, hgdiobj: IntPtr ) : IntPtr ; external 'Gdi32.dll' name 'SelectObject' ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
function CreateSolidBrush( c: integer ) : IntPtr ; external 'Gdi32.dll' name 'CreateSolidBrush' ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
function DeleteObject( obj: IntPtr ) : integer ; external 'Gdi32.dll' name 'DeleteObject' ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
function CreateCompatibleDC( obj: IntPtr ) : IntPtr ; external 'Gdi32.dll' name 'CreateCompatibleDC' ;
2017-08-06 13:35:29 +03:00
procedure Picture. FloodFill( x, y: integer ; c: Color) ;
2024-03-11 20:33:13 +03:00
//var hdc, hBrush, hOldBrush: IntPtr;
2015-05-14 22:35:07 +03:00
begin
2024-03-11 20:33:13 +03:00
{ var borderColor: Color : = GetPixel( x, y) ;
2015-05-14 22:35:07 +03:00
var bc : = ColorTranslator. ToWin32( borderColor) ;
var cc : = ColorTranslator. ToWin32( c) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
hdc : = gbmp. GetHDC( ) ;
hBrush : = CreateSolidBrush( cc) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
hOldBrush : = SelectObject( hdc, hBrush) ;
ExtFloodFill( hdc, x, y, bc, 1 ) ;
SelectObject( hdc, holdBrush) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
DeleteObject( hBrush) ;
gbmp. ReleaseHdc( ) ;
DeleteObject( hdc) ;
2017-08-06 13:35:29 +03:00
2024-03-11 20:33:13 +03:00
Monitor. Exit( f) ; }
var st : = new Stack< Point> ( ) ;
var targetColor : = bmp. GetPixel( x, y) ;
st. Push( Pnt( x, y) ) ;
while st. Count > 0 do
begin
var p : = st. Pop;
if ( p. x < 0 ) or ( p. x > = WindowWidth) or ( p. y < 0 ) or ( p. y > = WindowHeight) then
continue;
if bmp. GetPixel( p. x, p. y) = targetColor then
begin
bmp. SetPixel( p. x, p. y, c) ;
st. Push( Pnt( p. x, p. y- 1 ) ) ;
st. Push( Pnt( p. x, p. y+ 1 ) ) ;
st. Push( Pnt( p. x- 1 , p. y) ) ;
st. Push( Pnt( p. x+ 1 , p. y) ) ;
end ;
end ;
2015-05-14 22:35:07 +03:00
end ;
procedure Picture. Clear;
begin
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
gb. FillRectangle( Brushes. White, 0 , 0 , WindowWidth, WindowHeight) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
procedure Picture. Clear( c: Color) ;
begin
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
gb. FillRectangle( new SolidBrush( c) , 0 , 0 , WindowWidth, WindowHeight) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
// ABCControl
function ABCControl. IsInputKey( keyData: Keys) : boolean ;
begin
Result : = True ;
end ;
procedure InitBMP;
begin
var ww : = ScreenWidth;
var hh : = ScreenHeight;
2017-08-06 13:35:29 +03:00
bmp : = new Bitmap( ww, hh, gr) ;
2015-05-14 22:35:07 +03:00
gbmp : = Graphics. FromImage( bmp) ;
__buffer : = bmp;
2017-08-06 13:35:29 +03:00
gbmp. FillRectangle( Brushes. White, 0 , 0 , ww, hh) ;
2015-05-14 22:35:07 +03:00
end ;
procedure ABCControl. Init;
begin
BackColor : = System. Drawing. Color. White;
Dock : = DockStyle. Fill;
Paint + = OnPaint;
MouseDown + = OnMouseDown;
MouseUp + = OnMouseUp;
MouseMove + = OnMouseMove;
Resize + = OnResize;
KeyDown + = OnKeyDown;
KeyUp + = OnKeyUp;
KeyPress + = OnKeyPress;
2017-08-06 13:35:29 +03:00
// These Events must be initialised in main form
// FormClosing += OnClosing;
// Initialization of global vars
2015-05-14 22:35:07 +03:00
Pen. NETPen : = new System. Drawing. Pen( System. Drawing. Color. Black) ;
2017-08-06 13:35:29 +03:00
GraphABC. Font. NETFont : = new System. Drawing. Font( 'Arial' , 1 0 ) ;
2023-12-18 22:37:49 +03:00
PixelBrush : = new System. Drawing. SolidBrush( System. Drawing. Color. Black) ;
2015-05-14 22:35:07 +03:00
CurrentSolidBrush : = new SolidBrush( System. Drawing. Color. White) ;
2017-08-06 13:35:29 +03:00
CurrentHatchBrush : = new HatchBrush( HatchStyle. Cross, System. Drawing. Color. Black, System. Drawing. Color. White) ;
CurrentGradientBrush : = new LinearGradientBrush( new Point( 0 , 0 ) , new Point( 6 0 0 , 6 0 0 ) , System. Drawing. Color. Black, System. Drawing. Color. White) ;
2015-05-14 22:35:07 +03:00
Brush. NETBrush : = CurrentSolidBrush;
2017-08-06 13:35:29 +03:00
// CurrentWriteFont := new System.Drawing.Font('Courier New',10);
2015-05-14 22:35:07 +03:00
NotLockDrawing : = True ;
DrawInBuffer : = True ;
RedrawProc : = nil ;
end ;
2017-08-06 13:35:29 +03:00
constructor ABCControl. Create( w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
ClientSize : = new System. Drawing. Size( w, h) ;
2015-05-14 22:35:07 +03:00
Init;
end ;
procedure ABCControl. OnPaint( sender: object ; e: PaintEventArgs) ;
begin
Monitor. Enter( f) ;
if ( e < > nil ) and NotLockDrawing then
begin
2017-08-06 13:35:29 +03:00
if RedrawProc < > nil then
2015-05-14 22:35:07 +03:00
RedrawProc
2017-08-06 13:35:29 +03:00
else e. Graphics. DrawImage( bmp, 0 , 0 ) ;
2015-05-14 22:35:07 +03:00
end ;
Monitor. Exit( f) ;
end ;
procedure ABCControl. OnClosing( sender: object ; e: FormClosingEventArgs) ;
begin
2017-08-06 13:35:29 +03:00
if GraphABC. OnClose < > nil then
2015-05-14 22:35:07 +03:00
GraphABC. OnClose;
NotLockDrawing : = False ;
//Sleep(0);
Halt;
end ;
procedure ABCControl. OnMouseDown( sender: Object ; e: MouseEventArgs) ;
2017-08-06 13:35:29 +03:00
type
MouseButtons = System. Windows. Forms. MouseButtons;
var
mb: integer ;
2015-05-14 22:35:07 +03:00
begin
if e. Button = MouseButtons. Left then
mb : = 1
else if e. Button = MouseButtons. Right then
mb : = 2 ;
2017-08-06 13:35:29 +03:00
if GraphABC. OnMouseDown < > nil then
GraphABC. OnMouseDown( e. x, e. y, mb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure ABCControl. OnMouseUp( sender: Object ; e: MouseEventArgs) ;
2017-08-06 13:35:29 +03:00
type
MouseButtons = System. Windows. Forms. MouseButtons;
var
mb: integer ;
2015-05-14 22:35:07 +03:00
begin
if e. Button = MouseButtons. Left then
mb : = 1
else if e. Button = MouseButtons. Right then
mb : = 2 ;
2017-08-06 13:35:29 +03:00
if GraphABC. OnMouseUp < > nil then
GraphABC. OnMouseUp( e. x, e. y, mb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure ABCControl. OnMouseMove( sender: Object ; e: MouseEventArgs) ;
2017-08-06 13:35:29 +03:00
type
MouseButtons = System. Windows. Forms. MouseButtons;
var
mb: integer ;
2015-05-14 22:35:07 +03:00
begin
if e. Button = MouseButtons. Left then
mb : = 1
else if e. Button = MouseButtons. Right then
mb : = 2 ;
2017-08-06 13:35:29 +03:00
if GraphABC. OnMouseMove < > nil then
GraphABC. OnMouseMove( e. x, e. y, mb) ;
2015-05-14 22:35:07 +03:00
end ;
procedure ABCControl. OnKeyDown( sender: Object ; e: KeyEventArgs) ;
begin
2017-08-06 13:35:29 +03:00
if GraphABC. OnKeyDown < > nil then
2015-05-14 22:35:07 +03:00
GraphABC. OnKeyDown( integer( e. KeyCode) ) ;
end ;
procedure ABCControl. OnKeyUp( sender: Object ; e: KeyEventArgs) ;
begin
2017-08-06 13:35:29 +03:00
if GraphABC. OnKeyUp < > nil then
2015-05-14 22:35:07 +03:00
GraphABC. OnKeyUp( integer( e. KeyCode) ) ;
end ;
procedure ABCControl. OnKeyPress( sender: Object ; e: KeyPressEventArgs) ;
begin
2017-08-06 13:35:29 +03:00
if GraphABC. OnKeyPress < > nil then
2015-05-14 22:35:07 +03:00
GraphABC. OnKeyPress( e. KeyChar) ;
end ;
procedure ResizeHelper;
begin
Monitor. Enter( f) ;
2017-04-28 22:41:40 +03:00
var t : = gr. SmoothingMode;
2015-05-14 22:35:07 +03:00
var m : = gr. Transform;
gr : = Graphics. FromHwnd( f. Handle) ;
gr. Transform : = m;
gr. SmoothingMode : = t;
Monitor. Exit( f) ;
end ;
procedure ABCControl. OnResize( sender: Object ; e: EventArgs) ;
begin
ResizeHelper;
2017-08-06 13:35:29 +03:00
if GraphABC. OnResize < > nil then
2015-05-14 22:35:07 +03:00
GraphABC. OnResize;
end ;
// Extension methods
2017-08-06 13:35:29 +03:00
procedure System. Drawing. Rectangle. MoveTo( x, y: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Self. X : = x;
Self. Y : = y;
end ;
2017-08-06 13:35:29 +03:00
function operator implicit( Self: Point) : ( integer , integer ) ; extensionmethod;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
Result : = ( Self. X, Self. Y)
2016-04-04 20:02:29 +03:00
end ;
2017-08-06 13:35:29 +03:00
function operator implicit( Self: ( integer , integer ) ) : Point; extensionmethod;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
Result : = new Point( Self[ 0 ] , Self[ 1 ] )
2016-04-04 20:02:29 +03:00
end ;
2015-05-14 22:35:07 +03:00
// Primitives
2017-08-06 13:35:29 +03:00
procedure SetPixel( x, y: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
begin
2023-12-18 22:37:49 +03:00
PutPixel( x, y, c) ;
2017-09-16 17:38:24 +03:00
{ lock f do
2017-08-06 13:35:29 +03:00
begin
2023-12-18 22:37:49 +03:00
if NotLockDrawing then begin
var b : = SmoothingIsOn;
SetSmoothingOff;
PixelBrush. Color : = c;
gr. FillRectangle( PixelBrush, x, y, 1 , 1 ) ;
SetSmoothing( b) ;
end ;
if DrawInBuffer then
bmp. SetPixel( x, y, c) ;
2017-09-16 17:38:24 +03:00
end ; }
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure PutPixel( x, y: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
2017-09-16 17:38:24 +03:00
var b : = SmoothingIsOn;
2015-05-14 22:35:07 +03:00
SetSmoothingOff;
PixelBrush. Color : = c;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
gr. FillRectangle( PixelBrush, x, y, 1 , 1 ) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
gbmp. FillRectangle( PixelBrush, x, y, 1 , 1 ) ;
2015-05-14 22:35:07 +03:00
SetSmoothing( b) ;
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
function GetPixel( x, y: integer ) : Color;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
Result : = bmp. GetPixel( x, y) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure MoveTo( x, y: integer ) ;
2015-05-14 22:35:07 +03:00
begin
x_coord : = x;
y_coord : = y;
end ;
2017-08-06 13:35:29 +03:00
procedure MoveRel( dx, dy: integer ) ;
2016-12-17 17:31:09 +03:00
begin
x_coord + = dx;
y_coord + = dy;
end ;
2017-08-06 13:35:29 +03:00
procedure LineTo( x, y: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Line( x_coord, y_coord, x, y) ;
2015-05-14 22:35:07 +03:00
x_coord : = x;
y_coord : = y;
end ;
2017-08-06 13:35:29 +03:00
procedure LineTo( x, y: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Line( x_coord, y_coord, x, y, c) ;
2015-05-14 22:35:07 +03:00
x_coord : = x;
y_coord : = y;
end ;
2017-08-06 13:35:29 +03:00
procedure LineRel( dx, dy: integer ) ;
2016-12-17 17:31:09 +03:00
begin
2017-08-06 13:35:29 +03:00
LineTo( x_coord + dx, y_coord + dy) ;
2016-12-17 17:31:09 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure LineRel( dx, dy: integer ; c: Color) ;
2016-12-17 17:31:09 +03:00
begin
2017-08-06 13:35:29 +03:00
LineTo( x_coord + dx, y_coord + dy, c) ;
2016-12-17 17:31:09 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Line( x1, y1, x2, y2: integer ; c: Color) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
Line( x1, y1, x2, y2, c, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
Line( x1, y1, x2, y2, c, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Line( p1, p2: Point; c: Color) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
Line( p1. X, p1. Y, p2. X, p2. Y, c)
2016-04-04 20:02:29 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Line( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
Line( x1, y1, x2, y2, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
Line( x1, y1, x2, y2, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Line( p1, p2: Point) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
Line( p1. X, p1. Y, p2. X, p2. Y)
2016-04-04 20:02:29 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure FillCircle( x, y, r: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
// SSM 14.5.10
FillEllipse( x - r, y - r, x + r + 1 , y + r + 1 ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure DrawCircle( x, y, r: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
// SSM 14.5.10
DrawEllipse( x - r, y - r, x + r + 1 , y + r + 1 ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Circle( x, y, r: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
// SSM 14.5.10
Ellipse( x - r, y - r, x + r + 1 , y + r + 1 ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure FillEllipse( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
FillEllipse( x1, y1, x2, y2, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
FillEllipse( x1, y1, x2, y2, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure DrawEllipse( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawEllipse( x1, y1, x2, y2, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawEllipse( x1, y1, x2, y2, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Ellipse( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2018-12-07 17:53:21 +03:00
Monitor. Enter( f) ;
2015-05-14 22:35:07 +03:00
if Brush. NETBrush < > nil then
2017-08-06 13:35:29 +03:00
FillEllipse( x1, y1, x2, y2) ;
2015-05-14 22:35:07 +03:00
if Pen. NETPen. DashStyle < > DashStyle. Custom then
2017-08-06 13:35:29 +03:00
DrawEllipse( x1, y1, x2, y2) ;
2018-12-07 17:53:21 +03:00
Monitor. Exit( f) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure FillRectangle( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
FillRectangle( x1, y1, x2, y2, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
FillRectangle( x1, y1, x2, y2, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure DrawRectangle( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawRectangle( x1, y1, x2, y2, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawRectangle( x1, y1, x2, y2, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Rectangle( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2018-12-07 17:53:21 +03:00
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
if x1 > x2 then
Swap( x1, x2) ;
if y1 > y2 then
Swap( y1, y2) ;
2015-05-14 22:35:07 +03:00
if Brush. NETBrush < > nil then
2017-08-06 13:35:29 +03:00
FillRectangle( x1, y1, x2 - 1 , y2 - 1 ) ;
2015-05-14 22:35:07 +03:00
if Pen. NETPen. DashStyle < > DashStyle. Custom then
2017-08-06 13:35:29 +03:00
DrawRectangle( x1, y1, x2, y2) ;
2018-12-07 17:53:21 +03:00
Monitor. Exit( f) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure DrawRoundRect( x1, y1, x2, y2, w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawRoundRect( x1, y1, x2, y2, w, h, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawRoundRect( x1, y1, x2, y2, w, h, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure FillRoundRect( x1, y1, x2, y2, w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
FillRoundRect( x1, y1, x2, y2, w, h, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
FillRoundRect( x1, y1, x2, y2, w, h, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure RoundRect( x1, y1, x2, y2, w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
if Brush. NETBrush < > nil then
2017-08-06 13:35:29 +03:00
FillRoundRect( x1, y1, x2, y2, w, h) ;
2015-05-14 22:35:07 +03:00
if Pen. NETPen. DashStyle < > DashStyle. Custom then
2017-08-06 13:35:29 +03:00
DrawRoundRect( x1, y1, x2, y2, w, h) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Arc( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
Arc( x, y, r, a1, a2, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
Arc( x, y, r, a1, a2, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure FillPie( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
FillPie( x, y, r, a1, a2, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
FillPie( x, y, r, a1, a2, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure DrawPie( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawPie( x, y, r, a1, a2, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawPie( x, y, r, a1, a2, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Pie( x, y, r, a1, a2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
if Brush. NETBrush < > nil then
2017-08-06 13:35:29 +03:00
FillPie( x, y, r, a1, a2) ;
2015-05-14 22:35:07 +03:00
if Pen. NETPen. DashStyle < > DashStyle. Custom then
2017-08-06 13:35:29 +03:00
DrawPie( x, y, r, a1, a2) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure TextOut( x, y: integer ; s: string ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
TextOut( x, y, s, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
TextOut( x, y, s, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure TextOut( x, y: integer ; n: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
TextOut( x, y, n. ToString) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure TextOut( x, y: integer ; r: real ) ;
2015-05-14 22:35:07 +03:00
begin
var nfi : = new System. Globalization. NumberFormatInfo( ) ;
nfi. NumberGroupSeparator : = '.' ;
2017-08-06 13:35:29 +03:00
TextOut( x, y, r. ToString( nfi) ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y, x1, y1: integer ; s: string ) ;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawTextCentered( x, y, x1, y1, s, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawTextCentered( x, y, x1, y1, s, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y, x1, y1: integer ; n: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
DrawTextCentered( x, y, x1, y1, n. ToString) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y, x1, y1: integer ; r: real ) ;
2015-05-14 22:35:07 +03:00
begin
var nfi : = new System. Globalization. NumberFormatInfo( ) ;
nfi. NumberGroupSeparator : = '.' ;
2017-08-06 13:35:29 +03:00
DrawTextCentered( x, y, x1, y1, r. ToString( nfi) ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y: integer ; s: string ) ;
2016-06-15 00:36:38 +03:00
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawTextCentered( x, y, s, gr) ;
2016-06-15 00:36:38 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawTextCentered( x, y, s, gbmp) ;
2016-06-15 00:36:38 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y: integer ; n: integer ) ;
2016-06-15 00:36:38 +03:00
begin
2017-08-06 13:35:29 +03:00
DrawTextCentered( x, y, n. ToString) ;
2016-06-15 00:36:38 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered( x, y: integer ; r: real ) ;
2016-06-15 00:36:38 +03:00
begin
var nfi : = new System. Globalization. NumberFormatInfo( ) ;
nfi. NumberGroupSeparator : = '.' ;
2017-08-06 13:35:29 +03:00
DrawTextCentered( x, y, r. ToString( nfi) ) ;
2016-06-15 00:36:38 +03:00
end ;
2017-08-06 13:35:29 +03:00
function Pnt( x, y: integer ) : Point;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Result : = new Point( x, y) ;
2015-05-14 22:35:07 +03:00
end ;
procedure DrawPolygon( points: array of Point) ;
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawPolygon( points, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawPolygon( points, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure DrawPolygon( params points: array of ( integer , integer ) ) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
var pnts : = points. Select( p - > Pnt( p[ 0 ] , p[ 1 ] ) ) ;
2016-04-04 20:02:29 +03:00
DrawPolygon( pnts. ToArray) ;
end ;
2015-05-14 22:35:07 +03:00
procedure FillPolygon( points: array of Point) ;
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
FillPolygon( points, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
FillPolygon( points, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure FillPolygon( params points: array of ( integer , integer ) ) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
var pnts : = points. Select( p - > Pnt( p[ 0 ] , p[ 1 ] ) ) ;
2016-04-04 20:02:29 +03:00
FillPolygon( pnts. ToArray) ;
end ;
2015-05-14 22:35:07 +03:00
procedure Polygon( points: array of Point) ;
begin
if Brush. NETBrush < > nil then
FillPolygon( points) ;
if Pen. NETPen. DashStyle < > DashStyle. Custom then
DrawPolygon( points) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Polygon( params points: array of ( integer , integer ) ) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
var pnts : = points. Select( p - > Pnt( p[ 0 ] , p[ 1 ] ) ) ;
2016-04-04 20:02:29 +03:00
Polygon( pnts. ToArray) ;
end ;
2015-05-14 22:35:07 +03:00
procedure Polyline( points: array of Point) ;
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
Polyline( points, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
Polyline( points, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Polyline( params points: array of ( integer , integer ) ) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
var pnts : = points. Select( p - > Pnt( p[ 0 ] , p[ 1 ] ) ) ;
2016-04-04 20:02:29 +03:00
Polyline( pnts. ToArray) ;
end ;
2015-05-14 22:35:07 +03:00
procedure Curve( points: array of Point) ;
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
Curve( points, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
Curve( points, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure Curve( params points: array of ( integer , integer ) ) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
var pnts : = points. Select( p - > Pnt( p[ 0 ] , p[ 1 ] ) ) ;
2016-04-04 20:02:29 +03:00
Curve( pnts. ToArray) ;
end ;
2015-05-14 22:35:07 +03:00
procedure DrawClosedCurve( points: array of Point) ;
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawClosedCurve( points, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawClosedCurve( points, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure DrawClosedCurve( params points: array of ( integer , integer ) ) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
var pnts : = points. Select( p - > Pnt( p[ 0 ] , p[ 1 ] ) ) ;
2016-04-04 20:02:29 +03:00
DrawClosedCurve( pnts. ToArray) ;
end ;
2015-05-14 22:35:07 +03:00
procedure FillClosedCurve( points: array of Point) ;
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
FillClosedCurve( points, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
FillClosedCurve( points, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure FillClosedCurve( params points: array of ( integer , integer ) ) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
var pnts : = points. Select( p - > Pnt( p[ 0 ] , p[ 1 ] ) ) ;
2016-04-04 20:02:29 +03:00
FillClosedCurve( pnts. ToArray) ;
end ;
2015-05-14 22:35:07 +03:00
procedure ClosedCurve( points: array of Point) ;
begin
Monitor. Enter( f) ;
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
ClosedCurve( points, gr) ;
2015-05-14 22:35:07 +03:00
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
ClosedCurve( points, gbmp) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
2017-08-06 13:35:29 +03:00
procedure ClosedCurve( params points: array of ( integer , integer ) ) ;
2016-04-04 20:02:29 +03:00
begin
2017-08-06 13:35:29 +03:00
var pnts : = points. Select( p - > Pnt( p[ 0 ] , p[ 1 ] ) ) ;
2016-04-04 20:02:29 +03:00
ClosedCurve( pnts. ToArray) ;
end ;
2015-05-14 22:35:07 +03:00
// Fills
2023-12-18 22:37:49 +03:00
{ procedure FloodFill( x, y: integer ; c: Color) ;
2017-08-06 13:35:29 +03:00
var
hdc, hBrush, hOldBrush: IntPtr ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
var borderColor: Color : = GetPixel( x, y) ;
// var bc: integer := integer(borderColor.R) + (integer(borderColor.G) shl 8) + (integer(borderColor.B) shl 16);
// var cc: integer := integer(c.R) + (integer(c.G) shl 8) + (integer(c.B) shl 16);
2015-05-14 22:35:07 +03:00
var bc : = ColorTranslator. ToWin32( borderColor) ;
var cc : = ColorTranslator. ToWin32( c) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
hdc : = gr. GetHDC( ) ;
hBrush : = CreateSolidBrush( cc) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
hOldBrush : = SelectObject( hdc, hBrush) ;
ExtFloodFill( hdc, x, y, bc, 1 ) ;
SelectObject( hdc, holdBrush) ;
2017-08-06 13:35:29 +03:00
2015-12-28 14:25:15 +03:00
var hbmp : = bmp. GetHbitmap( ) ; // Создается GDI Bitmap
2015-05-14 22:35:07 +03:00
var memdc: IntPtr : = CreateCompatibleDC( hdc) ;
2017-08-06 13:35:29 +03:00
SelectObject( memdc, hbmp) ;
2015-05-14 22:35:07 +03:00
hOldBrush : = SelectObject( memdc, hBrush) ;
ExtFloodFill( memdc, x, y, bc, 1 ) ;
SelectObject( hdc, holdBrush) ;
var bmp1 : = Bitmap. FromHbitmap( hbmp) ;
2017-08-06 13:35:29 +03:00
gbmp. DrawImage( bmp1, 0 , 0 ) ;
2015-05-14 22:35:07 +03:00
bmp1. Dispose( ) ;
2017-08-06 13:35:29 +03:00
// bmp := Bitmap.FromHbitmap(hbmp);
2015-05-14 22:35:07 +03:00
DeleteObject( memdc) ;
DeleteObject( hbmp) ;
DeleteObject( hBrush) ;
gr. ReleaseHdc( ) ;
DeleteObject( hdc) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
2023-12-18 22:37:49 +03:00
end ; }
procedure FloodFill( x, y: integer ; c: Color) ;
begin
LockDrawing;
var st : = new Stack< Point> ( ) ;
var targetColor : = GetPixel( x, y) ;
st. Push( Pnt( x, y) ) ;
while st. Count > 0 do
begin
var p : = st. Pop;
if ( p. x < 0 ) or ( p. x > = WindowWidth) or ( p. y < 0 ) or ( p. y > = WindowHeight) then
continue;
if GetPixel( p. x, p. y) = targetColor then
begin
PutPixel( p. x, p. y, c) ;
st. Push( Pnt( p. x, p. y- 1 ) ) ;
st. Push( Pnt( p. x, p. y+ 1 ) ) ;
st. Push( Pnt( p. x- 1 , p. y) ) ;
st. Push( Pnt( p. x+ 1 , p. y) ) ;
end ;
end ;
UnLockDrawing;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure FillRect( x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
FillRectangle( x1, y1, x2, y2) ;
2015-05-14 22:35:07 +03:00
end ;
// Colors
2017-08-06 13:35:29 +03:00
function RGB( r, g, b: byte ) : Color;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Result : = System. Drawing. Color. FromArgb( r, g, b) ;
2015-05-14 22:35:07 +03:00
end ;
//------------------------------------------------------------------------------
// Color from component
//------------------------------------------------------------------------------
2017-08-06 13:35:29 +03:00
const
AlphaBase = $FF000000 ;
2015-05-14 22:35:07 +03:00
function RedColor( r: byte ) : Color;
begin
Result : = System. Drawing. Color. FromArgb( AlphaBase or ( r shl 1 6 ) ) ;
end ;
function GreenColor( g: byte ) : Color;
begin
Result : = System. Drawing. Color. FromArgb( AlphaBase or ( g shl 8 ) ) ;
end ;
function BlueColor( b: byte ) : Color;
begin
Result : = System. Drawing. Color. FromArgb( AlphaBase or b) ;
end ;
//------------------------------------------------------------------------------
2017-08-06 13:35:29 +03:00
function ARGB( a, r, g, b: byte ) : Color;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Result : = System. Drawing. Color. FromArgb( a, r, g, b) ;
// Result := ((((r shl 16) or (g shl 8)) or b) or (a shl 24)) and -1;
2015-05-14 22:35:07 +03:00
end ;
function clRandom: Color;
begin
2017-08-06 13:35:29 +03:00
Result : = System. Drawing. Color. FromArgb( 2 5 5 , PABCSystem. Random( 2 5 5 ) , PABCSystem. Random( 2 5 5 ) , PABCSystem. Random( 2 5 5 ) ) ;
2015-05-14 22:35:07 +03:00
end ;
function GetRed( c: Color) : integer ;
begin
Result : = c. R;
2017-08-06 13:35:29 +03:00
// Result := (c shr 16) and 255;
2015-05-14 22:35:07 +03:00
end ;
function GetGreen( c: Color) : integer ;
begin
Result : = c. G;
2017-08-06 13:35:29 +03:00
// Result := (c shr 8) and 255;
2015-05-14 22:35:07 +03:00
end ;
function GetBlue( c: Color) : integer ;
begin
Result : = c. B;
2017-08-06 13:35:29 +03:00
// Result := c and 255;
2015-05-14 22:35:07 +03:00
end ;
function GetAlpha( c: Color) : integer ;
begin
Result : = c. A;
end ;
// Pens
procedure SetPenColor( c: Color) ;
begin
//if Pen.NETPen.Color <> c then
2017-08-06 13:35:29 +03:00
lock f do
Pen. NETPen. Color : = c;
2015-05-14 22:35:07 +03:00
end ;
function PenColor: Color;
begin
Result : = Pen. NETPen. Color;
end ;
procedure SetPenWidth( Width: integer ) ;
begin
lock f do
2016-11-16 10:00:30 +03:00
begin
2015-05-14 22:35:07 +03:00
Pen. NETPen. Width : = Width;
2016-11-16 10:00:30 +03:00
_ColorLinePen. Width : = Width;
end ;
2015-05-14 22:35:07 +03:00
end ;
function PenWidth: integer ;
begin
Result : = round( Pen. NETPen. Width) ;
end ;
procedure SetPenStyle( style: DashStyle) ;
begin
LockGraphics;
2017-08-06 13:35:29 +03:00
// try
2015-05-14 22:35:07 +03:00
case style of
2023-12-18 22:37:49 +03:00
psSolid: Pen. NETPen. DashStyle : = DashStyle. Solid;
2015-05-14 22:35:07 +03:00
psClear: Pen. NETPen. DashStyle : = DashStyle. Custom;
2023-12-18 22:37:49 +03:00
psDash: Pen. NETPen. DashStyle : = DashStyle. Dash;
psDot: Pen. NETPen. DashStyle : = DashStyle. Dot;
2015-05-14 22:35:07 +03:00
psDashDot: Pen. NETPen. DashStyle : = DashStyle. DashDot;
psDashDotDot: Pen. NETPen. DashStyle : = DashStyle. DashDotDot;
end ;
2017-08-06 13:35:29 +03:00
{ except
on e: System. InvalidOperationException do
writeln( e) ;
end ; }
2015-05-14 22:35:07 +03:00
UnLockGraphics;
end ;
function PenStyle: DashStyle;
begin
case Pen. NETPen. DashStyle of
2023-12-18 22:37:49 +03:00
DashStyle. Solid: Result : = psSolid;
DashStyle. Dash: Result : = psDash;
DashStyle. Dot: Result : = psDot;
DashStyle. DashDot: Result : = psDashDot;
2015-05-14 22:35:07 +03:00
DashStyle. DashDotDot: Result : = psDashDotDot;
2023-12-18 22:37:49 +03:00
DashStyle. Custom: Result : = psClear;
2015-05-14 22:35:07 +03:00
end ;
end ;
procedure SetPenMode( m: integer ) ;
begin
2017-08-06 13:35:29 +03:00
// TODO
2015-05-14 22:35:07 +03:00
end ;
function PenMode: integer ;
begin
result : = - 1 ;
2017-08-06 13:35:29 +03:00
// TODO
2015-05-14 22:35:07 +03:00
end ;
//2015.01>
procedure SetPenRoundCap( isRoundCap: boolean ) ;
2017-08-06 13:35:29 +03:00
var
lCap: LineCap;
2015-05-14 22:35:07 +03:00
begin
if isRoundCap then
lCap : = LineCap. Round
else
lCap : = LineCap. Flat;
lock f do
2017-08-06 13:35:29 +03:00
begin
2015-05-14 22:35:07 +03:00
Pen. NETPen. StartCap : = lCap;
Pen. NETPen. EndCap : = lCap;
end ;
end ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
function PenRoundCap: boolean ;
begin
Result : = ( Pen. NETPen. StartCap = LineCap. Round )
and ( Pen. NETPen. EndCap = LineCap. Round ) ;
end ;
//2015.01<
function PenX: integer ;
begin
Result : = x_coord;
end ;
function PenY: integer ;
begin
Result : = y_coord;
end ;
// Brushes
procedure SetBrushColor( c: Color) ;
begin
LockGraphics;
if Brush. NETBrush = CurrentHatchBrush then
begin
2017-08-06 13:35:29 +03:00
CurrentHatchBrush : = new HatchBrush( CurrentHatchBrush. HatchStyle, c, CurrentHatchBrush. BackgroundColor) ;
2015-05-14 22:35:07 +03:00
Brush. NETBrush : = CurrentHatchBrush;
end
else
begin
2017-08-06 13:35:29 +03:00
// try
2015-05-14 22:35:07 +03:00
CurrentSolidBrush. Color : = c;
2017-08-06 13:35:29 +03:00
{ except
on e: System. InvalidOperationException do
writeln( e. StackTrace) ;
end ; }
2015-05-14 22:35:07 +03:00
CurrentGradientBrush. LinearColors[ 0 ] : = CurrentSolidBrush. Color;
end ;
UnLockGraphics;
end ;
function BrushColor: Color;
begin
if Brush. NETBrush = CurrentHatchBrush then
Result : = CurrentHatchBrush. ForegroundColor
else Result : = CurrentSolidBrush. Color;
end ;
procedure SetBrushStyle( bs: BrushStyleType) ;
begin
lock f do
case bs of
bsSolid: Brush. NETBrush : = CurrentSolidBrush;
bsClear: Brush. NETBrush : = nil ;
bsHatch: Brush. NETBrush : = CurrentHatchBrush;
bsGradient: Brush. NETBrush : = CurrentGradientBrush;
end ;
end ;
function BrushStyle: BrushStyleType;
begin
2015-12-28 14:25:15 +03:00
Result : = bsNone; // Если кисть устанавливалась явным присваиванием NETBrush
2015-05-14 22:35:07 +03:00
if Brush. NETBrush = CurrentSolidBrush then
Result : = bsSolid
else if Brush. NETBrush = nil then
Result : = bsClear
else if Brush. NETBrush = CurrentHatchBrush then
Result : = bsHatch
else if Brush. NETBrush = CurrentGradientBrush then
Result : = bsGradient;
end ;
procedure SetBrushHatch( bh: HatchStyle) ;
begin
lock f do
begin
var flag : = CurrentHatchBrush = Brush. NETBrush;
2017-08-06 13:35:29 +03:00
CurrentHatchBrush : = new HatchBrush( HatchStyle( bh) , CurrentHatchBrush. ForegroundColor, CurrentHatchBrush. BackgroundColor) ;
2015-05-14 22:35:07 +03:00
if flag then
Brush. NETBrush : = CurrentHatchBrush;
end ;
end ;
function BrushHatch: HatchStyle;
begin
Result : = CurrentHatchBrush. HatchStyle;
end ;
procedure SetHatchBrushBackgroundColor( c: Color) ;
2017-08-06 13:35:29 +03:00
var
flag: boolean ;
2015-05-14 22:35:07 +03:00
begin
lock f do
begin
flag : = CurrentHatchBrush = Brush. NETBrush;
2017-08-06 13:35:29 +03:00
CurrentHatchBrush : = new HatchBrush( CurrentHatchBrush. HatchStyle, CurrentHatchBrush. ForegroundColor, c) ;
2015-05-14 22:35:07 +03:00
if flag then
Brush. NETBrush : = CurrentHatchBrush;
end ;
end ;
function HatchBrushBackgroundColor: Color;
begin
Result : = CurrentHatchBrush. BackgroundColor;
end ;
procedure SetGradientBrushSecondColor( c: Color) ;
begin
lock f do
CurrentGradientBrush. LinearColors[ 1 ] : = c;
end ;
function GradientBrushSecondColor: Color;
begin
Result : = CurrentGradientBrush. LinearColors[ 1 ] ;
end ;
// Fonts
procedure SetFontSize( size: integer ) ;
begin
2017-08-06 13:35:29 +03:00
Font. NETFont : = new System. Drawing. Font( Font. NETFont. Name , Convert. ToSingle( size) , Font. NETFont. Style) ;
2015-05-14 22:35:07 +03:00
end ;
function FontSize: integer ;
begin
Result : = round( Font. NETFont. SizeInPoints) ;
end ;
procedure SetFontName( name : string ) ;
begin
lock f do
2017-08-06 13:35:29 +03:00
Font. NETFont : = new System. Drawing. Font( name , Font. NETFont. SizeInPoints, Font. NETFont. Style) ;
2015-05-14 22:35:07 +03:00
end ;
function FontName: string ;
begin
Result : = Font. NETFont. Name ;
end ;
procedure SetFontColor( c: Color) ;
begin
lock f do
_CurrentTextBrush. Color : = c;
end ;
function FontColor: Color;
begin
Result : = _CurrentTextBrush. Color;
end ;
procedure SetFontStyle( fs: FontStyleType) ;
begin
lock f do
2017-08-06 13:35:29 +03:00
Font. NETFont : = new System. Drawing. Font( Font. NETFont. name , Font. NETFont. SizeInPoints, System. Drawing. FontStyle( integer( fs) ) ) ;
2015-05-14 22:35:07 +03:00
end ;
function FontStyle: FontStyleType;
begin
Result : = FontStyleType( integer( Font. NETFont. Style) ) ;
end ;
function TextWidth( s: string ) : integer ;
begin
2017-08-06 13:35:29 +03:00
// добавил 1. Без нее рисует, занимая 1 лишний пиксел
Result : = round( gr. MeasureString( s, Font. NETFont, 0 , sf) . Width) + 1 ;
2015-05-14 22:35:07 +03:00
end ;
function TextHeight( s: string ) : integer ;
begin
2017-08-06 13:35:29 +03:00
Result : = round( gr. MeasureString( s, Font. NETFont) . Height) ;
2015-05-14 22:35:07 +03:00
end ;
// Window
procedure ClearWindow;
begin
ClearWindow( clWhite) ;
end ;
procedure ClearWindow( c: Color) ;
2017-08-06 13:35:29 +03:00
var
i: Color;
2015-05-14 22:35:07 +03:00
begin
Monitor. Enter( f) ;
i : = BrushColor;
SetBrushColor( c) ;
var m : = gr. Transform;
gr. ResetTransform;
gbmp. ResetTransform;
2017-08-06 13:35:29 +03:00
FillRect( 0 , 0 , GraphABCControl. Width, GraphABCControl. Height) ;
2015-05-14 22:35:07 +03:00
gr. Transform : = m;
gbmp. Transform : = m;
SetBrushColor( i) ;
Monitor. Exit( f) ;
end ;
function WindowLeft: integer ;
begin
Result : = MainForm. Left;
end ;
function WindowTop: integer ;
begin
Result : = MainForm. Top;
end ;
function WindowCenter: Point;
begin
2017-08-06 13:35:29 +03:00
Result : = new Point( WindowWidth div 2 , WindowHeight div 2 ) ;
2015-05-14 22:35:07 +03:00
end ;
function WindowIsFixedSize: boolean ;
begin
Result : = ( MainForm. FormBorderStyle = FormBorderStyle. FixedSingle) and ( MainForm. MaximizeBox = False ) ;
end ;
function WindowWidth: integer ;
begin
2017-08-06 13:35:29 +03:00
// Result := MainForm.ClientSize.Width;
2015-05-14 22:35:07 +03:00
Result : = f. Width;
end ;
function WindowHeight: integer ;
begin
2017-08-06 13:35:29 +03:00
// Result := MainForm.ClientSize.Height;
2015-05-14 22:35:07 +03:00
Result : = f. Height;
end ;
procedure SetWindowWidth( w: integer ) ;
begin
2017-08-06 13:35:29 +03:00
// SetWindowSize(w,MainForm.ClientSize.Height);
SetWindowSize( w, WindowHeight) ;
2015-05-14 22:35:07 +03:00
end ;
procedure SetWindowHeight( h: integer ) ;
begin
2017-08-06 13:35:29 +03:00
// SetWindowSize(MainForm.ClientSize.Width,h);
SetWindowSize( WindowWidth, h) ;
end ;
2015-05-14 22:35:07 +03:00
procedure SetWindowLeft( l: integer ) ;
begin
2017-08-06 13:35:29 +03:00
SetWindowPos( l, MainForm. Top) ;
2015-05-14 22:35:07 +03:00
end ;
procedure SetWindowTop( t: integer ) ;
begin
2017-08-06 13:35:29 +03:00
SetWindowPos( MainForm. Left, t) ;
2015-05-14 22:35:07 +03:00
end ;
procedure SetMaximizeBoxInternal( b: boolean ) ;
begin
MainForm. MaximizeBox : = b;
end ;
2017-08-06 13:35:29 +03:00
procedure SetBorderStyleInternal( st: FormBorderStyle) ;
2015-05-14 22:35:07 +03:00
begin
MainForm. FormBorderStyle : = st;
end ;
procedure SetWindowIsFixedSize( b: boolean ) ;
2017-08-06 13:35:29 +03:00
var
p: Proc1Boolean;
q: Proc1BorderStyle;
2015-05-14 22:35:07 +03:00
begin
p : = SetMaximizeBoxInternal;
q : = SetBorderStyleInternal;
if b then
2017-08-06 13:35:29 +03:00
MainForm. Invoke( q, FormBorderStyle. FixedSingle)
else MainForm. Invoke( q, FormBorderStyle. Sizable) ;
MainForm. Invoke( p, not b) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure ChangeFormPos( l, t: integer ) ; // вспомогательная
2015-05-14 22:35:07 +03:00
begin
MainForm. Left : = l;
MainForm. Top : = t;
end ;
2017-08-06 13:35:29 +03:00
procedure SetWindowPos( l, t: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
f. Invoke( ChangeFormPos, l, t) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure ChangeFormClientSize( w, h: integer ) ; // вспомогательная
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
MainForm. ClientSize : = new System. Drawing. Size( w, h) ;
2015-05-14 22:35:07 +03:00
ResizeHelper;
end ;
2017-08-06 13:35:29 +03:00
procedure SetWindowSize( w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
f. Invoke( ChangeFormClientSize, w, h) ;
2015-05-14 22:35:07 +03:00
end ;
function GraphBoxWidth: integer ;
begin
Result : = f. Width;
end ;
function GraphBoxHeight: integer ;
begin
Result : = f. Height;
end ;
function GraphBoxLeft: integer ;
begin
Result : = f. Left;
end ;
function GraphBoxTop: integer ;
begin
Result : = f. Top;
end ;
function WindowCaption: string ;
begin
Result : = MainForm. Text ;
end ;
function WindowTitle: string ;
begin
Result : = MainForm. Text ;
end ;
2017-08-06 13:35:29 +03:00
procedure InitWindow( Left, Top, Width, Height: integer ; BackColor: Color) ;
2015-05-14 22:35:07 +03:00
begin
SetWindowSize( Width, Height) ;
SetWindowPos( Left, Top) ;
SetBrushColor( BackColor) ;
FillRectangle( 0 , 0 , Width, Height) ;
end ;
procedure ChangeFormTitle( s: string ) ;
begin
MainForm. Text : = s;
end ;
procedure SetWindowTitle( s: string ) ;
begin
2017-08-06 13:35:29 +03:00
f. Invoke( ChangeFormTitle, s) ;
2017-04-22 18:21:13 +03:00
end ;
2015-05-14 22:35:07 +03:00
procedure SetWindowCaption( s: string ) ;
begin
SetWindowTitle( s) ;
end ;
procedure SaveWindow( fname: string ) ;
begin
2017-08-06 13:35:29 +03:00
var tempbmp : = GetView( bmp, new System. Drawing. Rectangle( 0 , 0 , Window. Width, Window. Height) ) ;
2015-05-14 22:35:07 +03:00
tempbmp. Save( fname) ;
tempbmp. Dispose;
end ;
procedure LoadWindow( fname: string ) ;
//2015.01>
var
b: Bitmap;
tmp: Image;
fs: System. IO. FileStream;
//2015.01<
begin
2017-08-06 13:35:29 +03:00
//2015.01>
// var b: Bitmap := new Bitmap(fname);
2015-05-14 22:35:07 +03:00
try
fs : = new System. IO. FileStream( fname, System. IO. FileMode. Open) ;
tmp : = Image. FromStream( fs) ;
b : = new Bitmap( tmp) ;
fs. Flush;
fs. Close;
tmp. Dispose;
2017-08-06 13:35:29 +03:00
except
on ex: System. ArgumentException do
raise new System. IO. FileNotFoundException( string . Format( FILE_NOT_FOUND_MESSAGE, fname) ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
//2015.01<
SetWindowSize( b. Width, b. Height) ;
2015-05-14 22:35:07 +03:00
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
gr. DrawImage( b, 0 , 0 ) ;
gbmp. DrawImage( b, 0 , 0 ) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
procedure FillWindow( fname: string ) ;
begin
Monitor. Enter( f) ;
var b: System. Drawing. Brush : = Brush. NETBrush;
Brush. NETBrush : = new TextureBrush( Bitmap. FromFile( fname) ) ;
2017-08-06 13:35:29 +03:00
FillRect( 0 , 0 , GraphABCControl. Width, GraphABCControl. Height) ;
2015-05-14 22:35:07 +03:00
Brush. NETBrush : = b;
Monitor. Exit( f) ;
end ;
procedure CloseWindow;
begin
2017-08-06 13:35:29 +03:00
// MainForm.Close;
2015-05-14 22:35:07 +03:00
Halt;
end ;
2023-12-18 22:37:49 +03:00
var
scale: real : = - 1 ;
2019-01-28 03:30:18 +03:00
function ScreenScale: real ;
begin
if scale < = 0 then
try
2022-09-17 09:13:04 +03:00
var g : = MainForm. CreateGraphics;
var dpiX : = g. DpiX;
2019-01-28 03:30:18 +03:00
scale : = dpiX / 9 6 ;
2022-09-17 09:13:04 +03:00
g. Dispose;
//var dpiXProperty := typeof(System.Windows.SystemParameters).GetProperty('DpiX', System.Reflection.BindingFlags.NonPublic or System.Reflection.BindingFlags.Static);
//var dpiX := integer(dpiXProperty.GetValue(nil, nil));
//scale := dpiX / 96;
2019-01-28 03:30:18 +03:00
except
scale : = 1 ;
end ;
Result : = scale
end ;
function ScreenSize: System. Drawing. Size;
begin
2022-09-17 09:13:04 +03:00
//var (w,h) := (ScreenWidth,ScreenHeight);
//var (w,h) := (System.Windows.SystemParameters.PrimaryScreenWidth,System.Windows.SystemParameters.PrimaryScreenHeight);
//Result := new System.Drawing.Size(Round(w*ScreenScale),Round(h*ScreenScale))
2023-12-18 22:37:49 +03:00
Result : = new Size( ScreenWidth, ScreenHeight)
2019-01-28 03:30:18 +03:00
end ;
2015-05-14 22:35:07 +03:00
function ScreenWidth: integer ;
begin
2019-02-01 15:04:07 +03:00
Result : = Round( Screen. PrimaryScreen. Bounds. Width) ;
2015-05-14 22:35:07 +03:00
end ;
function ScreenHeight: integer ;
begin
2019-02-01 15:04:07 +03:00
Result : = Round( Screen. PrimaryScreen. Bounds. Height) ;
2015-05-14 22:35:07 +03:00
end ;
procedure CenterWindow;
begin
SetWindowPos( ( ScreenWidth - MainForm. Width) div 2 , ( ScreenHeight - MainForm. Height) div 2 ) ;
end ;
procedure _MaximizeWindow;
begin
_MainForm. WindowState : = FormWindowState. Maximized;
end ;
procedure _MinimizeWindow;
begin
_MainForm. WindowState : = FormWindowState. Minimized;
end ;
procedure _NormalizeWindow;
begin
_MainForm. WindowState : = FormWindowState. Normal
end ;
procedure MaximizeWindow;
begin
_MainForm. Invoke( _MaximizeWindow) ;
end ;
procedure MinimizeWindow;
begin
_MainForm. Invoke( _MinimizeWindow) ;
end ;
procedure NormalizeWindow;
begin
_MainForm. Invoke( _NormalizeWindow) ;
end ;
// BufferedDraw
procedure Redraw;
2017-08-06 13:35:29 +03:00
var
tempbmp: Bitmap;
2015-05-14 22:35:07 +03:00
begin
2015-12-31 14:47:14 +03:00
if IsUnix then
exit;
2015-12-28 14:25:15 +03:00
//TODO Без этого падает если свернуто
2017-08-06 13:35:29 +03:00
if MainForm. WindowState = FormWindowState. Minimized then
2015-05-14 22:35:07 +03:00
exit;
2017-08-06 13:35:29 +03:00
tempbmp : = GetView( bmp, new System. Drawing. Rectangle( 0 , 0 , WindowWidth, WindowHeight) ) ;
tempbmp. SetResolution( gr. DpiX, gr. DpiY) ;
2015-05-14 22:35:07 +03:00
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
if gr < > nil then
2015-05-14 22:35:07 +03:00
begin
var m : = gr. Transform;
gr. ResetTransform;
2017-08-06 13:35:29 +03:00
gr. DrawImage( tempbmp, 0 , 0 ) ;
2015-05-14 22:35:07 +03:00
gr. Transform : = m;
end ;
Monitor. Exit( f) ;
2019-04-09 21:33:09 +03:00
tempbmp. Dispose( ) ;
2015-05-14 22:35:07 +03:00
end ;
procedure FullRedraw;
begin
2015-12-31 14:47:14 +03:00
if IsUnix then
exit;
2015-05-14 22:35:07 +03:00
Monitor. Enter( f) ;
2017-08-06 13:35:29 +03:00
if gr < > nil then
gr. DrawImage( bmp, 0 , 0 ) ;
2015-05-14 22:35:07 +03:00
Monitor. Exit( f) ;
end ;
procedure LockDrawing;
begin
2015-12-31 14:47:14 +03:00
if IsUnix then
exit;
2015-05-14 22:35:07 +03:00
NotLockDrawing : = False ;
end ;
procedure UnlockDrawing;
begin
NotLockDrawing : = True ;
Redraw;
end ;
function RobotUnitUsed: boolean ;
2017-08-06 13:35:29 +03:00
var
t: & Type ;
2015-05-14 22:35:07 +03:00
begin
t : = System. Reflection. Assembly. GetExecutingAssembly. GetType( 'Robot.Robot' ) ;
2017-08-06 13:35:29 +03:00
if t = nil then
2015-05-14 22:35:07 +03:00
result : = false
else
result : = t. GetField( '__IS_ROBOT_UNIT' ) < > nil ;
end ;
procedure HideForm;
begin
_MainForm. Hide;
end ;
2017-08-06 13:35:29 +03:00
procedure CreatePicture( var p: Picture; w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
p : = new Picture( w, h) ;
2015-05-14 22:35:07 +03:00
end ;
function Window: GraphABCWindow;
begin
Result : = _Window;
end ;
function MainForm: Form;
begin
Result : = _MainForm;
end ;
function GraphABCControl: ABCControl;
begin
Result : = _GraphABCControl;
end ;
function Pen: GraphABCPen;
begin
Result : = _Pen;
end ;
function Brush: GraphABCBrush;
begin
Result : = _Brush;
end ;
function Font: GraphABCFont;
begin
Result : = _Font;
end ;
function Coordinate: GraphABCCoordinate;
begin
Result : = _Coordinate;
end ;
2017-04-23 00:06:33 +03:00
function StatusBar: GraphABCStatus;
begin
Result : = _StatusBar;
end ;
2015-05-14 22:35:07 +03:00
procedure GraphABCWindow. SetLeft( l: integer ) ;
begin
SetWindowLeft( l) ;
end ;
function GraphABCWindow. GetLeft: integer ;
begin
Result : = WindowLeft;
end ;
procedure GraphABCWindow. SetTop( t: integer ) ;
begin
SetWindowTop( t) ;
end ;
function GraphABCWindow. GetTop: integer ;
begin
Result : = WindowTop;
end ;
procedure GraphABCWindow. SetWidth( w: integer ) ;
begin
SetWindowWidth( w) ;
end ;
function GraphABCWindow. GetWidth: integer ;
begin
Result : = WindowWidth;
end ;
procedure GraphABCWindow. SetHeight( h: integer ) ;
begin
SetWindowHeight( h) ;
end ;
function GraphABCWindow. GetHeight: integer ;
begin
Result : = WindowHeight;
end ;
procedure GraphABCWindow. SetCaption( c: string ) ;
begin
SetWindowCaption( c) ;
end ;
function GraphABCWindow. GetCaption: string ;
begin
Result : = WindowCaption;
end ;
procedure GraphABCWindow. SetIsFixedSize( b: boolean ) ;
begin
SetWindowIsFixedSize( b) ;
end ;
function GraphABCWindow. GetIsFixedSize: boolean ;
begin
Result : = WindowIsFixedSize;
end ;
procedure GraphABCWindow. Clear;
begin
ClearWindow;
end ;
procedure GraphABCWindow. Clear( c: Color) ;
begin
ClearWindow( c) ;
end ;
2017-08-06 13:35:29 +03:00
procedure GraphABCWindow. SetSize( w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
SetWindowSize( w, h)
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure GraphABCWindow. SetPos( l, t: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
SetWindowPos( l, t)
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure GraphABCWindow. Init( Left, Top, Width, Height: integer ; BackColor: Color) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
InitWindow( Left, Top, Width, Height, BackColor) ;
2015-05-14 22:35:07 +03:00
end ;
procedure GraphABCWindow. Save( fname: string ) ;
begin
SaveWindow( fname) ;
end ;
procedure GraphABCWindow. Load( fname: string ) ;
begin
LoadWindow( fname) ;
end ;
procedure GraphABCWindow. Fill( fname: string ) ;
begin
FillWindow( fname) ;
end ;
procedure GraphABCWindow. Close;
begin
CloseWindow
end ;
procedure GraphABCWindow. Minimize;
begin
MinimizeWindow
end ;
procedure GraphABCWindow. Maximize;
begin
MaximizeWindow;
end ;
procedure GraphABCWindow. Normalize;
begin
NormalizeWindow;
end ;
procedure GraphABCWindow. CenterOnScreen;
begin
CenterWindow;
end ;
function GraphABCWindow. Center: Point;
begin
Result : = WindowCenter;
end ;
2017-08-06 13:35:29 +03:00
function Rect( x1, y1, x2, y2: integer ) : System. Drawing. Rectangle;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Result : = new System. Drawing. Rectangle( x1, y1, x2 - x1, y2 - y1) ;
2015-05-14 22:35:07 +03:00
end ;
function ClientRectangle: System. Drawing. Rectangle;
begin
Result : = MainForm. ClientRectangle
end ;
2017-08-06 13:35:29 +03:00
type
FS = auto class
mx, my, a, min, max: real ;
x1, y1: integer ;
f: real - > real ;
function Apply( x: real ) : Point;
begin
Result : = Pnt( x1 + Round( mx * ( x - a) ) , y1 + Round( my * ( max - f( x) ) ) ) ;
end ;
function RealToScreenX( x: real ) : integer : = Round( x1 + mx * ( x - a) ) ;
function RealToScreenY( y: real ) : integer : = Round( y1 - my * ( y + min) ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b, min, max: real ; x1, y1, x2, y2: integer ) ;
2016-01-01 23:41:25 +03:00
begin
2017-08-06 13:35:29 +03:00
var coefx : = ( x2 - x1) / ( b - a) ;
var coefy : = ( y2 - y1) / ( max - min) ;
2016-01-05 13:10:24 +03:00
Pen. Color : = Color. Black;
2017-08-06 13:35:29 +03:00
Rectangle( x1, y1, x2 + 1 , y2 + 1 ) ;
var fso : = new FS( coefx, coefy, a, min, max, x1, y1, f) ;
2016-01-05 13:10:24 +03:00
// Линии
{ Pen. Color : = Color. LightGray;
2017-08-06 13:35:29 +03:00
2016-01-05 13:10:24 +03:00
var hx : = 1.0 ;
var xx : = hx;
while xx< b do
begin
var x0 : = fso. RealToScreenX( xx) ;
Line( x0, y1, x0, y2) ;
xx + = hx
end ;
2017-08-06 13:35:29 +03:00
2016-01-05 13:10:24 +03:00
xx : = - hx;
while xx> a do
begin
var x0 : = fso. RealToScreenX( xx) ;
Line( x0, y1, x0, y2) ;
xx - = hx
end ;
var hy : = 1.0 ;
var yy : = hy;
while yy< max do
begin
var y0 : = fso. RealToScreenY( yy) ;
Line( x1, y0, x2, y0) ;
yy + = hy
end ;
2017-08-06 13:35:29 +03:00
2016-01-05 13:10:24 +03:00
yy : = - hy;
while yy> min do
begin
var y0 : = fso. RealToScreenY( yy) ;
Line( x1, y0, x2, y0) ;
yy - = hy
end ;
2017-08-06 13:35:29 +03:00
2016-01-05 13:10:24 +03:00
// Оси
Pen. Color : = Color. Blue;
2017-08-06 13:35:29 +03:00
2016-01-05 13:10:24 +03:00
var x0 : = fso. RealToScreenX( 0 ) ;
var y0 : = fso. RealToScreenY( 0 ) ;
Line( x0, y1, x0, y2) ;
Line( x1, y0, x2, y0) ; }
2017-08-06 13:35:29 +03:00
2016-01-05 13:10:24 +03:00
// График
2017-08-06 13:35:29 +03:00
2016-01-05 13:10:24 +03:00
Pen. Color : = Color. Black;
2017-08-06 13:35:29 +03:00
var n : = ( x2 - x1) div 3 ;
2018-11-19 02:48:19 +03:00
Polyline( PartitionPoints( a, b, n) . Select( fso. Apply) . ToArray) ;
2016-01-05 13:10:24 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b, min, max: real ; r: System. Drawing. Rectangle) ;
var
2023-12-18 22:37:49 +03:00
x1 : = r. X;
y1 : = r. Y;
2017-08-06 13:35:29 +03:00
x2 : = r. X + r. Width - 1 ;
y2 : = r. Y + r. Height - 1 ;
2016-01-05 13:10:24 +03:00
begin
2017-08-06 13:35:29 +03:00
Draw( f, a, b, min, max, x1, y1, x2, y2) ;
2016-01-05 13:10:24 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b, min, max: real ) ;
2016-01-05 13:10:24 +03:00
begin
2017-08-06 13:35:29 +03:00
Draw( f, a, b, min, max, ClientRectangle) ;
2016-01-01 23:41:25 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b: real ; x1, y1, x2, y2: integer ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
var n : = ( x2 - x1) div 3 ;
2018-11-19 02:48:19 +03:00
Draw( f, a, b, PartitionPoints( a, b, n) . Min( f) , PartitionPoints( a, b, n) . Max( f) , x1, y1, x2, y2)
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b: real ; r: System. Drawing. Rectangle) ;
var
2023-12-18 22:37:49 +03:00
x1 : = r. X;
y1 : = r. Y;
2017-08-06 13:35:29 +03:00
x2 : = r. X + r. Width - 1 ;
y2 : = r. Y + r. Height - 1 ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Draw( f, a, b, x1, y1, x2, y2) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; r: System. Drawing. Rectangle) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Draw( f, - 5 , 5 , r) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ; a, b: real ) ;
var
2023-12-18 22:37:49 +03:00
x1 : = 0 ;
y1 : = 0 ;
2017-08-06 13:35:29 +03:00
x2 : = Window. Width - 1 ;
y2 : = Window. Height - 1 ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Draw( f, a, b, x1, y1, x2, y2) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( f: real - > real ) ;
2015-05-14 22:35:07 +03:00
begin
2017-08-06 13:35:29 +03:00
Draw( f, - 5 , 5 ) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
var
dpic : = new Dictionary< string , Picture> ;
2015-05-14 22:35:07 +03:00
2017-08-06 13:35:29 +03:00
procedure Draw( fname: string ; x, y: integer ) ;
2015-05-14 22:35:07 +03:00
begin
if not dpic. ContainsKey( fname) then
dpic[ fname] : = new Picture( fname) ;
2017-08-06 13:35:29 +03:00
dpic[ fname] . Draw( x, y) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( fname: string ; x, y, w, h: integer ) ;
2015-05-14 22:35:07 +03:00
begin
if not dpic. ContainsKey( fname) then
dpic[ fname] : = new Picture( fname) ;
2017-08-06 13:35:29 +03:00
dpic[ fname] . Draw( x, y, w, h) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
procedure Draw( fname: string ; x, y: integer ; Scale: real ) ;
2015-05-14 22:35:07 +03:00
begin
if not dpic. ContainsKey( fname) then
dpic[ fname] : = new Picture( fname) ;
var d : = dpic[ fname] ;
var w : = Round( d. Width * Scale) ;
var h : = Round( d. Height * Scale) ;
2017-08-06 13:35:29 +03:00
dpic[ fname] . Draw( x, y, w, h) ;
2015-05-14 22:35:07 +03:00
end ;
2017-08-06 13:35:29 +03:00
var
firstcall : = True ;
2015-05-14 22:35:07 +03:00
procedure ReadlnTextBoxKeyDown( Sender: object ; e: KeyEventArgs) ;
begin
if IOPanel. Visible = False then
Exit;
if e. KeyCode = Keys. Return then
begin
readbuffer : = ed. Text + Environment. NewLine;
IOPanel. Invoke( SetIOPanelInVisible) ;
MainThread. Resume;
2020-09-28 01:46:12 +03:00
e. SuppressKeyPress : = true ;
2015-05-14 22:35:07 +03:00
end ;
end ;
procedure EnterButtonClick( Sender: object ; e: EventArgs) ;
begin
if IOPanel. Visible = False then
Exit;
readbuffer : = ed. Text + Environment. NewLine;
IOPanel. Invoke( SetIOPanelInVisible) ;
MainThread. Resume;
end ;
procedure InitForm;
begin
_CurrentTextBrush : = new SolidBrush( System. Drawing. Color. Black) ;
_ColorLinePen : = new System. Drawing. Pen( System. Drawing. Color. Black) ;
2017-08-06 13:35:29 +03:00
f : = new ABCControl( defaultWindowWidth, defaultWindowHeight) ;
2015-05-14 22:35:07 +03:00
_MainForm : = new Form;
_MainForm. Text : = 'GraphABC.NET' ;
2017-08-06 13:35:29 +03:00
_MainForm. ClientSize : = new Size( defaultWindowWidth, defaultWindowHeight) ;
2015-05-14 22:35:07 +03:00
_MainForm. BackColor : = Color. White;
_MainForm. Controls. Add( f) ;
2017-08-13 14:32:28 +03:00
//_MainForm.TopMost := True;
2015-05-14 22:35:07 +03:00
_MainForm. StartPosition : = FormStartPosition. CenterScreen;
_MainForm. FormClosing + = f. OnClosing;
2015-12-28 14:25:15 +03:00
// Поле ввода
2015-05-14 22:35:07 +03:00
IOPanel : = new Panel( ) ;
IOPanel. Dock : = DockStyle. Bottom;
ed : = new TextBox( ) ;
ed. Dock : = DockStyle. Fill;
ed. Top : = defaultWindowHeight;
EnterButton : = new Button( ) ;
EnterButton. Text : = BUTTON_ENTER_TEXT;
EnterButton. Dock : = DockStyle. Right;
EnterButton. Click + = EnterButtonClick;
IOPanel. Visible : = False ;
2017-08-06 13:35:29 +03:00
IOPanel. Size : = new Size( defaultWindowWidth, ed. Height) ;
2015-05-14 22:35:07 +03:00
IOPanel. Controls. Add( ed) ;
IOPanel. Controls. Add( EnterButton) ;
_MainForm. KeyPreview : = True ;
_MainForm. KeyDown + = ReadlnTextBoxKeyDown;
_MainForm. Controls. Add( IOPanel) ;
2017-08-06 13:35:29 +03:00
2015-05-14 22:35:07 +03:00
gr : = Graphics. FromHwnd( f. Handle) ;
2017-10-27 02:41:17 +03:00
//if (System.Environment.OSVersion.Version.Major >= 6) then SetProcessDPIAware();
2015-05-14 22:35:07 +03:00
InitBMP;
2017-08-06 13:35:29 +03:00
2024-04-22 22:41:12 +03:00
SetSmoothingOn;
_GraphABCControl : = f;
CurrentIOSystem : = new IOGraphABCSystem;
2017-08-06 13:35:29 +03:00
end ;
2015-05-14 22:35:07 +03:00
2024-04-22 22:41:12 +03:00
var mre : = new ManualResetEvent( false ) ;
2015-05-14 22:35:07 +03:00
procedure InitForm0;
begin
InitForm;
StartIsComplete : = True ;
2024-04-22 22:41:12 +03:00
mre. Set( ) ;
2015-05-14 22:35:07 +03:00
Application. Run( MainForm) ;
end ;
procedure InitGraphABC;
begin
if not firstcall then exit;
sf : = new StringFormat( StringFormat. GenericTypographic) ;
sf. FormatFlags : = StringFormatFlags. MeasureTrailingSpaces;
firstcall : = False ;
2017-08-06 13:35:29 +03:00
clMoneyGreen : = RGB( 1 9 2 , 2 2 0 , 1 9 2 ) ;
2015-05-14 22:35:07 +03:00
StartIsComplete : = False ;
MainFormThread : = new System. Threading. Thread( InitForm0) ;
MainFormThread. Start;
2024-04-22 22:41:12 +03:00
mre. WaitOne; // Основная программа не начнется пока не будут инициализированы все компоненты приложения
//while not StartIsComplete do
// Sleep(30);
//Sleep(30);
2015-05-14 22:35:07 +03:00
end ;
procedure SetConsoleIO;
begin
CurrentIOSystem : = new IOStandardSystem;
end ;
procedure SetGraphABCIO;
begin
CurrentIOSystem : = new IOGraphABCSystem;
end ;
procedure __InitModule;
begin
MainThread : = Thread. CurrentThread;
InitGraphABC;
end ;
2017-08-06 13:35:29 +03:00
var
__initialized : = false ;
2015-05-14 22:35:07 +03:00
procedure __InitModule__;
begin
if not __initialized then
begin
__initialized : = true ;
GraphABCHelper. __InitModule__;
__InitModule;
end ;
end ;
initialization
__InitModule;
finalization
// Application.Run(MainWindow);
2017-08-06 13:35:29 +03:00
end .