pascalabcnet/TestSuite/CompilationSamples/GraphABC.pas

4271 lines
134 KiB
ObjectPascal
Raw Permalink Normal View History

// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
2015-06-27 19:33:50 +03:00
///Модуль предоставляет константы, типы, процедуры, функции и классы для рисования в графическом окне
2015-05-14 22:35:07 +03:00
unit GraphABC;
//ne udaljat, IB 7.10.08
//с дополнениями 2015.01 (mabr)
2015-05-14 22:35:07 +03:00
{$apptype windows}
{$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 = 640;
defaultWindowHeight = 480;
// Color constants
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
VK_Back = 8;
VK_Tab = 9;
VK_LineFeed = 10;
VK_Enter = 13;
VK_Return = 13;
VK_ShiftKey = 16;
VK_ControlKey = 17;
VK_Menu = 18;
VK_Pause = 19;
VK_CapsLock = 20;
2015-05-14 22:35:07 +03:00
VK_Capital = 20;
VK_Escape = 27;
VK_Space = 32;
VK_Prior = 33;
VK_PageUp = 33;
VK_PageDown = 34;
VK_Next = 34;
VK_End = 35;
VK_Home = 36;
VK_Left = 37;
VK_Up = 38;
VK_Right = 39;
VK_Down = 40;
VK_Select = 41;
VK_Print = 42;
VK_Snapshot = 44;
VK_PrintScreen = 44;
VK_Insert = 45;
VK_Delete = 46;
VK_Help = 47;
VK_A = 65;
VK_B = 66;
VK_C = 67;
VK_D = 68;
VK_E = 69;
VK_F = 70;
VK_G = 71;
VK_H = 72;
VK_I = 73;
VK_J = 74;
VK_K = 75;
VK_L = 76;
VK_M = 77;
VK_N = 78;
VK_O = 79;
VK_P = 80;
VK_Q = 81;
VK_R = 82;
VK_S = 83;
VK_T = 84;
VK_U = 85;
VK_V = 86;
VK_W = 87;
VK_X = 88;
VK_Y = 89;
VK_Z = 90;
VK_LWin = 91;
VK_RWin = 92;
VK_Apps = 93;
VK_Sleep = 95;
VK_NumPad0 = 96;
VK_NumPad1 = 97;
VK_NumPad2 = 98;
VK_NumPad3 = 99;
VK_NumPad4 = 100;
VK_NumPad5 = 101;
VK_NumPad6 = 102;
VK_NumPad7 = 103;
VK_NumPad8 = 104;
VK_NumPad9 = 105;
VK_Multiply = 106;
VK_Add = 107;
VK_Separator = 108;
VK_Subtract = 109;
VK_Decimal = 110;
VK_Divide = 111;
VK_F1 = 112;
VK_F2 = 113;
VK_F3 = 114;
VK_F4 = 115;
VK_F5 = 116;
VK_F6 = 117;
VK_F7 = 118;
VK_F8 = 119;
VK_F9 = 120;
VK_F10 = 121;
VK_F11 = 122;
VK_F12 = 123;
VK_NumLock = 144;
VK_Scroll = 145;
VK_LShiftKey = 160;
VK_RShiftKey = 161;
VK_LControlKey = 162;
VK_RControlKey = 163;
VK_LMenu = 164;
2015-05-14 22:35:07 +03:00
VK_RMenu = 165;
VK_KeyCode = 65535;
VK_Shift = 65536;
VK_Control = 131072;
VK_Alt = 262144;
VK_Modifiers = -65536;
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);
/// Закрашивает пиксел с координатами (x,y) цветом c
2017-08-06 13:35:29 +03:00
procedure SetPixel(x, y: integer; c: Color);
/// Закрашивает пиксел с координатами (x,y) цветом c
2017-08-06 13:35:29 +03:00
procedure PutPixel(x, y: integer; c: Color);
/// Возвращает цвет пиксела с координатами (x,y)
2017-08-06 13:35:29 +03:00
function GetPixel(x, y: integer): Color;
2015-05-14 22:35:07 +03:00
/// Устанавливает текущую позицию рисования в точку (x,y)
2017-08-06 13:35:29 +03:00
procedure MoveTo(x, y: integer);
/// Перемещает текущую позицию рисования на вектор (dx,dy)
2017-08-06 13:35:29 +03:00
procedure MoveRel(dx, dy: integer);
/// Рисует отрезок от текущей позиции до точки (x,y). Текущая позиция переносится в точку (x,y)
2017-08-06 13:35:29 +03:00
procedure LineTo(x, y: integer);
/// Рисует отрезок от текущей позиции до точки (x,y) цветом c. Текущая позиция переносится в точку (x,y)
2017-08-06 13:35:29 +03:00
procedure LineTo(x, y: integer; c: Color);
/// Рисует отрезок от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку
2017-08-06 13:35:29 +03:00
procedure LineRel(dx, dy: integer);
/// Рисует отрезок цветом 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
/// Рисует отрезок от точки (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);
/// Рисует отрезок от точки (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
/// Заполняет внутренность окружности с центром (x,y) и радиусом r
2017-08-06 13:35:29 +03:00
procedure FillCircle(x, y, r: integer);
/// Рисует окружность с центром (x,y) и радиусом r
2017-08-06 13:35:29 +03:00
procedure DrawCircle(x, y, r: integer);
/// Заполняет внутренность эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure FillEllipse(x1, y1, x2, y2: integer);
/// Рисует границу эллипса, ограниченного прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure DrawEllipse(x1, y1, x2, y2: integer);
/// Заполняет внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure FillRectangle(x1, y1, x2, y2: integer);
/// Заполняет внутренность прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure FillRect(x1, y1, x2, y2: integer);
/// Рисует границу прямоугольника, заданного координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure DrawRectangle(x1, y1, x2, y2: integer);
/// Заполняет внутренность прямоугольника со скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
2017-08-06 13:35:29 +03:00
procedure FillRoundRect(x1, y1, x2, y2, w, h: integer);
/// Рисует границу прямоугольника со скругленными краями; (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
/// Рисует заполненную окружность с центром (x,y) и радиусом r
2017-08-06 13:35:29 +03:00
procedure Circle(x, y, r: integer);
/// Рисует заполненный эллипс, ограниченный прямоугольником, заданным координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure Ellipse(x1, y1, x2, y2: integer);
/// Рисует заполненный прямоугольник, заданный координатами противоположных вершин (x1,y1) и (x2,y2)
2017-08-06 13:35:29 +03:00
procedure Rectangle(x1, y1, x2, y2: integer);
/// Рисует заполненный прямоугольник со скругленными краями; (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
/// Рисует дугу окружности с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
2017-08-06 13:35:29 +03:00
procedure Arc(x, y, r, a1, a2: integer);
/// Заполняет внутренность сектора окружности, ограниченного дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
2017-08-06 13:35:29 +03:00
procedure FillPie(x, y, r, a1, a2: integer);
/// Рисует сектор окружности, ограниченный дугой с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы a1 и a2 с осью OX (a1 и a2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки)
2017-08-06 13:35:29 +03:00
procedure DrawPie(x, y, r, a1, a2: integer);
/// Рисует заполненный сектор окружности, ограниченный дугой с центром в точке (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
/// Возвращает точку на плоскости с координатами (x,y)
2017-08-06 13:35:29 +03:00
function Pnt(x, y: integer): Point;
2015-05-14 22:35:07 +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));
/// Заполняет многоугольник, координаты вершин которого заданы в массиве 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));
/// Рисует заполненный многоугольник, координаты вершин которого заданы в массиве 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));
/// Рисует ломаную по точкам, координаты которых заданы в массиве 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));
/// Рисует кривую по точкам, координаты которых заданы в массиве 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));
/// Рисует замкнутую кривую по точкам, координаты которых заданы в массиве 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));
/// Заполняет замкнутую кривую по точкам, координаты которых заданы в массиве 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));
/// Рисует заполненную замкнутую кривую по точкам, координаты которых заданы в массиве 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
/// Выводит строку s в прямоугольник к координатами левого верхнего угла (x,y)
2017-08-06 13:35:29 +03:00
procedure TextOut(x, y: integer; s: string);
/// Выводит целое n в прямоугольник к координатами левого верхнего угла (x,y)
2017-08-06 13:35:29 +03:00
procedure TextOut(x, y: integer; n: integer);
/// Выводит вещественное r в прямоугольник к координатами левого верхнего угла (x,y)
2017-08-06 13:35:29 +03:00
procedure TextOut(x, y: integer; r: real);
/// Выводит строку s, отцентрированную в прямоугольнике с координатами (x,y,x1,y1)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered(x, y, x1, y1: integer; s: string);
/// Выводит целое значение n, отцентрированное в прямоугольнике с координатами (x,y,x1,y1)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered(x, y, x1, y1: integer; n: integer);
/// Выводит вещественное значение r, отцентрированное в прямоугольнике с координатами (x,y,x1,y1)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered(x, y, x1, y1: integer; r: real);
/// Выводит строку s, отцентрированное по точке с координатами (x,y)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered(x, y: integer; s: string);
/// Выводит целое n, отцентрированное по точке с координатами (x,y)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered(x, y: integer; n: integer);
/// Выводит вещественное r, отцентрированное по точке с координатами (x,y)
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered(x, y: integer; r: real);
/// Заливает область одного цвета цветом 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-05-14 22:35:07 +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;
/// Возвращает цвет, который содержит красную (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
/// Возвращает красный цвет с интенсивностью r (r - в диапазоне от 0 до 255)
2015-05-14 22:35:07 +03:00
function RedColor(r: byte): Color;
/// Возвращает зеленый цвет с интенсивностью g (g - в диапазоне от 0 до 255)
2015-05-14 22:35:07 +03:00
function GreenColor(g: byte): Color;
/// Возвращает синий цвет с интенсивностью b (b - в диапазоне от 0 до 255)
2015-05-14 22:35:07 +03:00
function BlueColor(b: byte): Color;
/// Возвращает случайный цвет
2015-05-14 22:35:07 +03:00
function clRandom: Color;
/// Возвращает красную составляющую цвета
2015-05-14 22:35:07 +03:00
function GetRed(c: Color): integer;
/// Возвращает зеленую составляющую цвета
2015-05-14 22:35:07 +03:00
function GetGreen(c: Color): integer;
/// Возвращает синюю составляющую цвета
2015-05-14 22:35:07 +03:00
function GetBlue(c: Color): integer;
/// Возвращает составляющую прозрачности цвета
2015-05-14 22:35:07 +03:00
function GetAlpha(c: Color): integer;
//--------------------------------------------
//// Перья
2015-05-14 22:35:07 +03:00
//--------------------------------------------
/// Устанавливает цвет текущего пера
2017-08-06 13:35:29 +03:00
procedure SetPenColor(c: Color);
/// Возвращает цвет текущего пера
2015-05-14 22:35:07 +03:00
function PenColor: Color;
/// Устанавливает ширину текущего пера
2015-05-14 22:35:07 +03:00
procedure SetPenWidth(Width: integer);
/// Возвращает ширину текущего пера
2015-05-14 22:35:07 +03:00
function PenWidth: integer;
/// Устанавливает стиль текущего пера
2015-05-14 22:35:07 +03:00
procedure SetPenStyle(style: DashStyle);
/// Возвращает стиль текущего пера
2015-05-14 22:35:07 +03:00
function PenStyle: DashStyle;
/// Устанавливает режим текущего пера
2015-05-14 22:35:07 +03:00
procedure SetPenMode(m: integer);
/// Возвращает режим текущего пера
2015-05-14 22:35:07 +03:00
function PenMode: integer;
//2015.01>
/// Устанавливает или отменяет режим закругленных концов линий
2015-05-14 22:35:07 +03:00
procedure SetPenRoundCap(isRoundCap: boolean);
/// Возвращает truе, если установлен режим закругленных концов линий
2015-05-14 22:35:07 +03:00
function PenRoundCap: boolean;
//2015.01<
/// Возвращают x-координату текущей позиции рисования
2015-05-14 22:35:07 +03:00
function PenX: integer;
/// Возвращают y-координату текущей позиции рисования
2015-05-14 22:35:07 +03:00
function PenY: integer;
//--------------------------------------------
//// Кисти
2015-05-14 22:35:07 +03:00
//--------------------------------------------
/// Устанавливает цвет текущей кисти
2015-05-14 22:35:07 +03:00
procedure SetBrushColor(c: Color);
/// Возвращает цвет текущей кисти
2015-05-14 22:35:07 +03:00
function BrushColor: Color;
/// Устанавливает цвет текущей кисти
2015-05-14 22:35:07 +03:00
procedure SetBrushStyle(bs: BrushStyleType);
/// Возвращает цвет текущей кисти
2015-05-14 22:35:07 +03:00
function BrushStyle: BrushStyleType;
/// Устанавливает штриховку текущей кисти
2015-05-14 22:35:07 +03:00
procedure SetBrushHatch(bh: HatchStyle);
/// Возвращает штриховку текущей кисти
2015-05-14 22:35:07 +03:00
function BrushHatch: HatchStyle;
/// Устанавливает цвет заднего плана текущей штриховой кисти
2015-05-14 22:35:07 +03:00
procedure SetHatchBrushBackgroundColor(c: Color);
/// Возвращает цвет заднего плана текущей штриховой кисти
2015-05-14 22:35:07 +03:00
function HatchBrushBackgroundColor: Color;
/// Устанавливает второй цвет текущей градиентной кисти
2015-05-14 22:35:07 +03:00
procedure SetGradientBrushSecondColor(c: Color);
/// Возвращает второй цвет текущей градиентной кисти
2015-05-14 22:35:07 +03:00
function GradientBrushSecondColor: Color;
//--------------------------------------------
//// Шрифты
2015-05-14 22:35:07 +03:00
//--------------------------------------------
/// Устанавливает размер текущего шрифта в пунктах
2015-05-14 22:35:07 +03:00
procedure SetFontSize(size: integer);
/// Возвращает размер текущего шрифта в пунктах
2015-05-14 22:35:07 +03:00
function FontSize: integer;
/// Устанавливает имя текущего шрифта
2015-05-14 22:35:07 +03:00
procedure SetFontName(name: string);
/// Возвращает имя текущего шрифта
2015-05-14 22:35:07 +03:00
function FontName: string;
/// Устанавливает цвет текущего шрифта
2015-05-14 22:35:07 +03:00
procedure SetFontColor(c: Color);
/// Возвращает цвет текущего шрифта
2015-05-14 22:35:07 +03:00
function FontColor: Color;
/// Устанавливает стиль текущего шрифта
2015-05-14 22:35:07 +03:00
procedure SetFontStyle(fs: FontStyleType);
/// Возвращает стиль текущего шрифта
2015-05-14 22:35:07 +03:00
function FontStyle: FontStyleType;
/// Возвращает ширину строки s в пикселях при текущих настройках шрифта
2015-05-14 22:35:07 +03:00
function TextWidth(s: string): integer;
/// Возвращает высоту строки s в пикселях при текущих настройках шрифта
2015-05-14 22:35:07 +03:00
function TextHeight(s: string): integer;
//--------------------------------------------
//// Графическое окно
2015-05-14 22:35:07 +03:00
//--------------------------------------------
/// Очищает графическое окно белым цветом
2015-05-14 22:35:07 +03:00
procedure ClearWindow;
/// Очищает графическое окно цветом c
2015-05-14 22:35:07 +03:00
procedure ClearWindow(c: Color);
/// Возвращает ширину клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
function WindowWidth: integer;
/// Возвращает высоту клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
function WindowHeight: integer;
/// Возвращает отступ графического окна от левого края экрана в пикселах
2015-05-14 22:35:07 +03:00
function WindowLeft: integer;
/// Возвращает отступ графического окна от верхнего края экрана в пикселах
2015-05-14 22:35:07 +03:00
function WindowTop: integer;
/// Возвращает центр графического окна
2015-05-14 22:35:07 +03:00
function WindowCenter: Point;
/// Возвращает True, если графическое окно имеет фиксированный размер, и False в противном случае
2015-05-14 22:35:07 +03:00
function WindowIsFixedSize: boolean;
/// Устанавливает ширину клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
procedure SetWindowWidth(w: integer);
/// Устанавливает высоту клиентской части графического окна в пикселах
2015-05-14 22:35:07 +03:00
procedure SetWindowHeight(h: integer);
/// Устанавливает отступ графического окна от левого края экрана в пикселах
2015-05-14 22:35:07 +03:00
procedure SetWindowLeft(l: integer);
/// Устанавливает отступ графического окна от верхнего края экрана в пикселах
2015-05-14 22:35:07 +03:00
procedure SetWindowTop(t: integer);
/// Устанавливает, имеет ли графическое окно фиксированный размер
2015-05-14 22:35:07 +03:00
procedure SetWindowIsFixedSize(b: boolean);
/// Устанавливает размеры клиентской части графического окна в пикселах
2017-08-06 13:35:29 +03:00
procedure SetWindowSize(w, h: integer);
/// Устанавливает отступ графического окна от левого верхнего края экрана в пикселах
2017-08-06 13:35:29 +03:00
procedure SetWindowPos(l, t: integer);
2015-05-14 22:35:07 +03:00
/// Возвращает ширину графического компонента в пикселах (по умолчанию совпадает с WindowWidth)
2015-05-14 22:35:07 +03:00
function GraphBoxWidth: integer;
/// Возвращает высоту графического компонента в пикселах (по умолчанию совпадает с WindowHeight)
2015-05-14 22:35:07 +03:00
function GraphBoxHeight: integer;
/// Возвращает отступ графического компонента от левого края окна в пикселах
2015-05-14 22:35:07 +03:00
function GraphBoxLeft: integer;
/// Возвращает отступ графического компонента от верхнего края окна в пикселах
2015-05-14 22:35:07 +03:00
function GraphBoxTop: integer;
/// Возвращает заголовок графического окна
2015-05-14 22:35:07 +03:00
function WindowCaption: string;
/// Возвращает заголовок графического окна
2015-05-14 22:35:07 +03:00
function WindowTitle: string;
/// Устанавливает заголовок графического окна
2015-05-14 22:35:07 +03:00
procedure SetWindowCaption(s: string);
/// Устанавливает заголовок графического окна
2015-05-14 22:35:07 +03:00
procedure SetWindowTitle(s: string);
/// Устанавливает ширину и высоту клиентской части графического окна в пикселах
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
/// Сохраняет содержимое графического окна в файл с именем fname
2015-05-14 22:35:07 +03:00
procedure SaveWindow(fname: string);
/// Восстанавливает содержимое графического окна из файла с именем fname
2015-05-14 22:35:07 +03:00
procedure LoadWindow(fname: string);
/// Заполняет содержимое графического окна обоями из файла с именем fname
2015-05-14 22:35:07 +03:00
procedure FillWindow(fname: string);
/// Закрывает графическое окно и завершает приложение
2015-05-14 22:35:07 +03:00
procedure CloseWindow;
/// Возвращает ширину экрана в пикселях
2015-05-14 22:35:07 +03:00
function ScreenWidth: integer;
/// Возвращает высоту экрана в пикселях
2015-05-14 22:35:07 +03:00
function ScreenHeight: integer;
/// Центрирует графическое окно по центру экрана
2015-05-14 22:35:07 +03:00
procedure CenterWindow;
/// Максимизирует графическое окно
2015-05-14 22:35:07 +03:00
procedure MaximizeWindow;
/// Сворачивает графическое окно
2015-05-14 22:35:07 +03:00
procedure MinimizeWindow;
/// Возвращает графическое окно к нормальному размеру
2015-05-14 22:35:07 +03:00
procedure NormalizeWindow;
//--------------------------------------------
//// Буферизация рисования
2015-05-14 22:35:07 +03:00
//--------------------------------------------
/// Перерисовывает содержимое графического окна. Вызывается в паре с LockDrawing
2015-05-14 22:35:07 +03:00
procedure Redraw;
///--
procedure FullRedraw;
/// Блокирует рисование на графическом окне. Перерисовка графического окна выполняется с помощью Redraw
2015-05-14 22:35:07 +03:00
procedure LockDrawing;
/// Снимает блокировку рисования на графическом окне и осуществляет его перерисовку
2015-05-14 22:35:07 +03:00
procedure UnlockDrawing;
//--------------------------------------------
//// Сглаживание
2015-05-14 22:35:07 +03:00
//--------------------------------------------
/// Устанавливает режим сглаживания
2015-05-14 22:35:07 +03:00
procedure SetSmoothing(sm: boolean);
/// Включает режим сглаживания
2015-05-14 22:35:07 +03:00
procedure SetSmoothingOn;
/// Выключает режим сглаживания
2015-05-14 22:35:07 +03:00
procedure SetSmoothingOff;
/// Возвращает True, если режим сглаживания установлен
2015-05-14 22:35:07 +03:00
function SmoothingIsOn: boolean;
//--------------------------------------------
//// Вспомогательные подпрограммы
2015-05-14 22:35:07 +03:00
//--------------------------------------------
/// Блокирует прорисовку графики. Вызывается для синхронизации
2015-05-14 22:35:07 +03:00
procedure LockGraphics;
/// Разблокирует прорисовку графики. Вызывается для синхронизации
2015-05-14 22:35:07 +03:00
procedure UnLockGraphics;
//------------------------------------------------------------
//// Подпрограммы для работы с системой координат
2015-05-14 22:35:07 +03:00
//------------------------------------------------------------
/// Устанавливает начало координат в точку (x0,y0)
2017-08-06 13:35:29 +03:00
procedure SetCoordinateOrigin(x0, y0: integer);
/// Устанавливает масштаб системы координат
2017-08-06 13:35:29 +03:00
procedure SetCoordinateScale(sx, sy: real);
/// Устанавливает поворот системы координат
2015-05-14 22:35:07 +03:00
procedure SetCoordinateAngle(a: real);
//----------------------------------------
//// Сервисные подпрограммы
2015-05-14 22:35:07 +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-05-14 22:35:07 +03:00
function ClientRectangle: System.Drawing.Rectangle;
/// Коэффициент масштабирования экрана
function ScreenScale: real;
/// Размер экрана в пикселах
function ScreenSize: System.Drawing.Size;
2015-05-14 22:35:07 +03:00
//------------------------------------------
//// Рисование графиков функций
2015-05-14 22:35:07 +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);
/// Рисует график функции 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);
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно
2017-08-06 13:35:29 +03:00
procedure Draw(f: real-> real; a, b, min, max: real);
/// Рисует график функции 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);
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике r
2017-08-06 13:35:29 +03:00
procedure Draw(f: real-> real; a, b: real; r: System.Drawing.Rectangle);
/// Рисует график функции f, заданной на отрезке [-5,5], в прямоугольнике r
2017-08-06 13:35:29 +03:00
procedure Draw(f: real-> real; r: System.Drawing.Rectangle);
/// Рисует график функции f, заданной на отрезке [a,b], на полное графическое окно
2017-08-06 13:35:29 +03:00
procedure Draw(f: real-> real; a, b: real);
/// Рисует график функции 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-05-14 22:35:07 +03:00
//------------------------------------------
/// Выводит растровое изображение из файла с именем fname в позицию x,y
2015-05-14 22:35:07 +03:00
procedure Draw(fname: string; x: integer := 0; y: integer := 0);
/// Выводит растровое изображение из файла с именем fname в позицию x,y, масштабируя его к размеру w на h
2017-08-06 13:35:29 +03:00
procedure Draw(fname: string; x, y, w, h: integer);
/// Выводит растровое изображение из файла с именем 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-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
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
/// Текущее перо .NET
2015-05-14 22:35:07 +03:00
property NETPen: System.Drawing.Pen read _NETPen write SetNETPen;
/// Цвет пера
2015-05-14 22:35:07 +03:00
property Color: GraphABC.Color read GetColor write SetColor;
/// Ширина пера
2015-05-14 22:35:07 +03:00
property Width: integer read GetWidth write SetWidth;
/// Стиль пера
2015-05-14 22:35:07 +03:00
property Style: DashStyle read GetStyle write SetStyle;
/// Режим пера
2015-05-14 22:35:07 +03:00
property Mode: integer read GetMode write SetMode;
/// X-координата текущей позиции пера
2015-05-14 22:35:07 +03:00
property X: integer read GetX;
/// 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
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
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-05-14 22:35:07 +03:00
property Color: GraphABC.Color read GetColor write SetColor;
/// Стиль шрифта
2015-05-14 22:35:07 +03:00
property Style: FontStyleType read GetStyle write SetStyle;
/// Размер шрифта в пунктах
2015-05-14 22:35:07 +03:00
property Size: integer read GetSize write SetSize;
/// Наименование шрифта
2015-05-14 22:35:07 +03:00
property Name: string read GetName write SetName;
end;
GraphABCCoordinate = class
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;
public
2015-05-14 22:35:07 +03:00
constructor;
/// Устанавливает параметры системы координат
2017-08-06 13:35:29 +03:00
procedure SetTransform(x0, y0, angle, sx, sy: real);
/// Устанавливает начало системы координат
2017-08-06 13:35:29 +03:00
procedure SetOrigin(x0, y0: integer);
/// Устанавливает масштаб системы координат
2017-08-06 13:35:29 +03:00
procedure SetScale(sx, sy: real);
/// Устанавливает масштаб системы координат
2015-05-14 22:35:07 +03:00
procedure SetScale(scale: real);
/// Устанавливает правую систему координат (ось OY направлена вверх, ось OX - вправо)
2015-05-14 22:35:07 +03:00
procedure SetMathematic;
/// Устанавливает левую систему координат (ось OY направлена вниз, ось OX - вправо)
2015-05-14 22:35:07 +03:00
procedure SetStandard;
procedure ScaleOn(scale: real);
2017-08-06 13:35:29 +03:00
procedure Transform(x, y: real);
procedure Rotate(angle: real);
procedure ClearMatrix;
2017-08-06 13:35:29 +03:00
/// X-координата начала координат относительно левого верхнего угла окна
2015-05-14 22:35:07 +03:00
property OriginX: integer read GetOriginX write SetOriginX;
/// Y-координата начала координат относительно левого верхнего угла окна
2015-05-14 22:35:07 +03:00
property OriginY: integer read GetOriginY write SetOriginY;
/// Координаты начала координат относительно левого верхнего угла окна
2015-05-14 22:35:07 +03:00
property Origin: Point read GetOrigin write SetOrigin;
/// Угол поворота системы координат
2015-05-14 22:35:07 +03:00
property Angle: real read GetAngle write SetAngle;
/// Масштаб системы координат по оси X
2015-05-14 22:35:07 +03:00
property ScaleX: real read GetScaleX write SetScaleX;
/// Масштаб системы координат по оси Y
2015-05-14 22:35:07 +03:00
property ScaleY: real read GetScaleY write SetScaleY;
/// Масштаб системы координат по обоим осям
2015-05-14 22:35:07 +03:00
property Scale: real write SetScale;
/// Матрица 3x3 преобразований координат
2015-05-14 22:35:07 +03:00
property Matrix: System.Drawing.Drawing2D.Matrix read GetMatrix;
end;
GraphABCWindow = class
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;
GraphABCStatusPanel = class
private
p: System.Windows.Forms.ToolStripStatusLabel;
procedure SetText(s: string);
function GetText: string;
public
2017-08-06 13:35:29 +03:00
constructor(pp: System.Windows.Forms.ToolStripStatusLabel);
property Text: string read GetText write SetText;
end;
GraphABCStatus = class
private
procedure SetText(s: string);
function GetText: string;
procedure SetPanelsCount(n: integer);
function GetPanelsCount: integer;
function GetItem(i: integer): GraphABCStatusPanel;
public
procedure Show;
procedure Hide;
property Text: string read GetText write SetText;
property Items[i: integer]: GraphABCStatusPanel read GetItem;default;
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
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)
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;
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
public
2017-08-06 13:35:29 +03:00
constructor(w, h: integer);
end;
/// Создает рисунок размера w на h пикселов и записывает его в переменную p
2017-08-06 13:35:29 +03:00
procedure CreatePicture(var p: Picture; w, h: integer);
/// Возвращает окно графического приложения
2015-05-14 22:35:07 +03:00
function Window: GraphABCWindow;
/// Возвращает главную форму графического приложения
2015-05-14 22:35:07 +03:00
function MainForm: Form;
/// Возвращает графический компонент
2015-05-14 22:35:07 +03:00
function GraphABCControl: ABCControl;
/// Возвращает текущее перо
2015-05-14 22:35:07 +03:00
function Pen: GraphABCPen;
/// Возвращает текущую кисть
2015-05-14 22:35:07 +03:00
function Brush: GraphABCBrush;
/// Возвращает текущий шрифт
2015-05-14 22:35:07 +03:00
function Font: GraphABCFont;
/// Возвращает систему координат GraphABC
2015-05-14 22:35:07 +03:00
function Coordinate: GraphABCCoordinate;
/// Строка статуса
function StatusBar: GraphABCStatus;
2015-05-14 22:35:07 +03:00
function GraphWindowGraphics: Graphics;
function GraphBufferGraphics: Graphics;
function GraphBufferBitmap: Bitmap;
/// Устанавливает консольный ввод-вывод
2015-05-14 22:35:07 +03:00
procedure SetConsoleIO;
/// Устанавливает ввод-вывод через графическое окно (по умолчанию)
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
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)
public
2015-05-14 22:35:07 +03:00
constructor Create;
2017-08-06 13:35:29 +03:00
// procedure write(p: pointer); override;
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
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';
function operator*(s: Size; r: real): Size; extensionmethod;
begin
Result := new Size(Round(s.Width * r), Round(s.Height * r))
end;
function operator*(p: Point; r: real): Point; extensionmethod;
begin
Result := new Point(Round(p.X * r), Round(p.Y * r))
end;
2017-08-06 13:35:29 +03:00
var
// строка-буфер ввода
2015-05-14 22:35:07 +03:00
MainThread: Thread;
// строка-буфер ввода
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;
_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
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-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-05-14 22:35:07 +03:00
MainThread.Suspend;
end;
Result := integer(readBuffer[1]);
end;
// ------------ GraphABCCoordinate -----------------
constructor GraphABCCoordinate.Create;
begin
// 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;
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);
end;
end;
2017-08-06 13:35:29 +03:00
procedure GraphABCCoordinate.Transform(x, y: real);
begin
lock f do
begin
2017-08-06 13:35:29 +03:00
gr.TranslateTransform(x, y);
gbmp.TranslateTransform(x, y)
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 * 180 / 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;
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)
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
Show;
2017-08-06 13:35:29 +03:00
f.Invoke(SetStatusTextP, s);
end;
function GraphABCStatus.GetText: string;
begin
2017-08-06 13:35:29 +03:00
if (_StatusStrip = nil) or (_StatusStrip.Visible = False) then
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 > 10 then n := 10;
if n > _StatusStrip.Items.Count then
begin
var d := n - _StatusStrip.Items.Count;
2017-08-06 13:35:29 +03:00
for var i := 1 to d do
_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
Show;
2017-08-06 13:35:29 +03:00
f.Invoke(SetPanelsCountP, n);
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
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
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-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
// 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 / 360) * 2 * Pi;//угол в радианах
2015-05-14 22:35:07 +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);
//(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
//var tempbmp := GetView(bmp, src); // SSM 17/09/22 заменил это сложное - не работает под Linux
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', 10);
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(600, 600), 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
PutPixel(x, y, c);
2017-09-16 17:38:24 +03:00
{lock f do
2017-08-06 13:35:29 +03:00
begin
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);
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);
begin
2017-08-06 13:35:29 +03:00
LineTo(x_coord + dx, y_coord + dy);
end;
2017-08-06 13:35:29 +03:00
procedure LineRel(dx, dy: integer; c: Color);
begin
2017-08-06 13:35:29 +03:00
LineTo(x_coord + dx, y_coord + dy, c);
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);
begin
Monitor.Enter(f);
if NotLockDrawing then
2017-08-06 13:35:29 +03:00
DrawTextCentered(x, y, s, gr);
if DrawInBuffer then
2017-08-06 13:35:29 +03:00
DrawTextCentered(x, y, s, gbmp);
Monitor.Exit(f);
end;
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered(x, y: integer; n: integer);
begin
2017-08-06 13:35:29 +03:00
DrawTextCentered(x, y, n.ToString);
end;
2017-08-06 13:35:29 +03:00
procedure DrawTextCentered(x, y: integer; r: real);
begin
var nfi := new System.Globalization.NumberFormatInfo();
nfi.NumberGroupSeparator := '.';
2017-08-06 13:35:29 +03:00
DrawTextCentered(x, y, r.ToString(nfi));
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
{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
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);
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 16));
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(255, PABCSystem.Random(255), PABCSystem.Random(255), PABCSystem.Random(255));
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
psSolid: Pen.NETPen.DashStyle := DashStyle.Solid;
2015-05-14 22:35:07 +03:00
psClear: Pen.NETPen.DashStyle := DashStyle.Custom;
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
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;
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
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);
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;
var
scale: real := -1;
function ScreenScale: real;
begin
if scale <= 0 then
try
var g := MainForm.CreateGraphics;
var dpiX := g.DpiX;
scale := dpiX / 96;
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;
except
scale := 1;
end;
Result := scale
end;
function ScreenSize: System.Drawing.Size;
begin
//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))
Result := new Size(ScreenWidth, ScreenHeight)
end;
2015-05-14 22:35:07 +03:00
function ScreenWidth: integer;
begin
Result := Round(Screen.PrimaryScreen.Bounds.Width);
2015-05-14 22:35:07 +03:00
end;
function ScreenHeight: integer;
begin
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;
//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;
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);
begin
2017-08-06 13:35:29 +03:00
var coefx := (x2 - x1) / (b - a);
var coefy := (y2 - y1) / (max - min);
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);
// Линии
{Pen.Color := Color.LightGray;
2017-08-06 13:35:29 +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
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
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
// Оси
Pen.Color := Color.Blue;
2017-08-06 13:35:29 +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
// График
2017-08-06 13:35:29 +03:00
Pen.Color := Color.Black;
2017-08-06 13:35:29 +03:00
var n := (x2 - x1) div 3;
Polyline(PartitionPoints(a, b, n).Select(fso.Apply).ToArray);
end;
2017-08-06 13:35:29 +03:00
procedure Draw(f: real-> real; a, b, min, max: real; r: System.Drawing.Rectangle);
var
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;
begin
2017-08-06 13:35:29 +03:00
Draw(f, a, b, min, max, x1, y1, x2, y2);
end;
2017-08-06 13:35:29 +03:00
procedure Draw(f: real-> real; a, b, min, max: real);
begin
2017-08-06 13:35:29 +03:00
Draw(f, a, b, min, max, ClientRectangle);
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;
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
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
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-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
SetSmoothingOn;
_GraphABCControl := f;
CurrentIOSystem := new IOGraphABCSystem;
2017-08-06 13:35:29 +03:00
end;
2015-05-14 22:35:07 +03:00
var mre := new ManualResetEvent(false);
2015-05-14 22:35:07 +03:00
procedure InitForm0;
begin
InitForm;
StartIsComplete := True;
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(192, 220, 192);
2015-05-14 22:35:07 +03:00
StartIsComplete := False;
MainFormThread := new System.Threading.Thread(InitForm0);
MainFormThread.Start;
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.