4083 lines
134 KiB
ObjectPascal
4083 lines
134 KiB
ObjectPascal
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
|
||
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
|
||
|
||
///Модуль предоставляет константы, типы, процедуры, функции и классы для рисования в графическом окне
|
||
unit GraphABC;
|
||
|
||
//ne udaljat, IB 7.10.08
|
||
//с дополнениями 2015.01 (mabr)
|
||
{$apptype windows}
|
||
{$reference '%GAC%\System.Windows.Forms.dll'}
|
||
{$reference '%GAC%\System.Drawing.dll'}
|
||
{$gendoc true}
|
||
|
||
interface
|
||
|
||
uses
|
||
System,
|
||
System.Drawing,
|
||
System.Windows.Forms,
|
||
System.Drawing.Drawing2D;
|
||
|
||
type
|
||
/// Тип цвета
|
||
Color = System.Drawing.Color;
|
||
/// Тип стиля штриховки кисти
|
||
HatchStyle = System.Drawing.Drawing2D.HatchStyle;
|
||
/// Тип стиля штриховки пера
|
||
DashStyle = System.Drawing.Drawing2D.DashStyle;
|
||
/// Тип исключения GraphABC
|
||
GraphABCException = class(Exception) end;
|
||
/// Тип точки
|
||
Point = System.Drawing.Point;
|
||
|
||
var
|
||
clMoneyGreen: Color;
|
||
|
||
const
|
||
// 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;
|
||
|
||
// 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;
|
||
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;
|
||
VK_RMenu = 165;
|
||
VK_KeyCode = 65535; VK_Shift = 65536; VK_Control = 131072;
|
||
VK_Alt = 262144; VK_Modifiers = -65536;
|
||
|
||
// Pen style constants
|
||
psSolid = DashStyle.Solid;
|
||
psClear = DashStyle.Custom;
|
||
psDash = DashStyle.Dash;
|
||
psDot = DashStyle.Dot;
|
||
psDashDot = DashStyle.DashDot;
|
||
psDashDotDot = DashStyle.DashDotDot;
|
||
|
||
// Pen mode constants
|
||
pmCopy = 0;
|
||
pmNot = 1;
|
||
|
||
// Brush hatch type constants
|
||
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
|
||
type
|
||
FontStyleType = (fsNormal, fsBold, fsItalic, fsBoldItalic, fsUnderline, fsBoldUnderline, fsItalicUnderline, fsBoldItalicUnderline);
|
||
BrushStyleType = (bsSolid, bsClear, bsHatch, bsGradient, bsNone);
|
||
|
||
/// Закрашивает пиксел с координатами (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;
|
||
|
||
/// Устанавливает текущую позицию рисования в точку (x,y)
|
||
procedure MoveTo(x, y: integer);
|
||
/// Перемещает текущую позицию рисования на вектор (dx,dy)
|
||
procedure MoveRel(dx, dy: integer);
|
||
/// Рисует отрезок от текущей позиции до точки (x,y). Текущая позиция переносится в точку (x,y)
|
||
procedure LineTo(x, y: integer);
|
||
/// Рисует отрезок от текущей позиции до точки (x,y) цветом c. Текущая позиция переносится в точку (x,y)
|
||
procedure LineTo(x, y: integer; c: Color);
|
||
/// Рисует отрезок от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку
|
||
procedure LineRel(dx, dy: integer);
|
||
/// Рисует отрезок цветом c от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку
|
||
procedure LineRel(dx, dy: integer; c: Color);
|
||
|
||
/// Рисует отрезок от точки (x1,y1) до точки (x2,y2)
|
||
procedure Line(x1, y1, x2, y2: integer);
|
||
/// Рисует отрезок от точки p1 до точки p2
|
||
procedure Line(p1, p2: Point);
|
||
/// Рисует отрезок от точки (x1,y1) до точки (x2,y2) цветом c
|
||
procedure Line(x1, y1, x2, y2: integer; c: Color);
|
||
/// Рисует отрезок от точки p1 до точки p2 цветом c
|
||
procedure Line(p1, p2: Point; 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);
|
||
/// Заполняет внутренность прямоугольника со скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
|
||
procedure FillRoundRect(x1, y1, x2, y2, w, h: integer);
|
||
/// Рисует границу прямоугольника со скругленными краями; (x1,y1) и (x2,y2) задают пару противоположных вершин, а w и h – ширину и высоту эллипса, используемого для скругления краев
|
||
procedure DrawRoundRect(x1, y1, x2, y2, w, h: 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);
|
||
|
||
/// Возвращает точку на плоскости с координатами (x,y)
|
||
function Pnt(x, y: integer): Point;
|
||
|
||
/// Рисует замкнутую ломаную по точкам, координаты которых заданы в массиве points
|
||
procedure DrawPolygon(points: array of Point);
|
||
/// Рисует замкнутую ломаную по точкам, координаты которых заданы в массиве points
|
||
procedure DrawPolygon(params points: array of (integer, integer));
|
||
/// Заполняет многоугольник, координаты вершин которого заданы в массиве points
|
||
procedure FillPolygon(points: array of Point);
|
||
/// Заполняет многоугольник, координаты вершин которого заданы в массиве points
|
||
procedure FillPolygon(params points: array of (integer, integer));
|
||
/// Рисует заполненный многоугольник, координаты вершин которого заданы в массиве points
|
||
procedure Polygon(points: array of Point);
|
||
/// Рисует заполненный многоугольник, координаты вершин которого заданы в массиве points
|
||
procedure Polygon(params points: array of (integer, integer));
|
||
/// Рисует ломаную по точкам, координаты которых заданы в массиве points
|
||
procedure Polyline(points: array of Point);
|
||
/// Рисует ломаную по точкам, координаты которых заданы в массиве points
|
||
procedure Polyline(params points: array of (integer, integer));
|
||
/// Рисует кривую по точкам, координаты которых заданы в массиве points
|
||
procedure Curve(points: array of Point);
|
||
/// Рисует кривую по точкам, координаты которых заданы в массиве points
|
||
procedure Curve(params points: array of (integer, integer));
|
||
/// Рисует замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure DrawClosedCurve(points: array of Point);
|
||
/// Рисует замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure DrawClosedCurve(params points: array of (integer, integer));
|
||
/// Заполняет замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure FillClosedCurve(points: array of Point);
|
||
/// Заполняет замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure FillClosedCurve(params points: array of (integer, integer));
|
||
/// Рисует заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure ClosedCurve(points: array of Point);
|
||
/// Рисует заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure ClosedCurve(params points: array of (integer, integer));
|
||
|
||
/// Выводит строку s в прямоугольник к координатами левого верхнего угла (x,y)
|
||
procedure TextOut(x, y: integer; s: string);
|
||
/// Выводит целое n в прямоугольник к координатами левого верхнего угла (x,y)
|
||
procedure TextOut(x, y: integer; n: integer);
|
||
/// Выводит вещественное r в прямоугольник к координатами левого верхнего угла (x,y)
|
||
procedure TextOut(x, y: integer; r: real);
|
||
/// Выводит строку s, отцентрированную в прямоугольнике с координатами (x,y,x1,y1)
|
||
procedure DrawTextCentered(x, y, x1, y1: integer; s: string);
|
||
/// Выводит целое значение n, отцентрированное в прямоугольнике с координатами (x,y,x1,y1)
|
||
procedure DrawTextCentered(x, y, x1, y1: integer; n: integer);
|
||
/// Выводит вещественное значение r, отцентрированное в прямоугольнике с координатами (x,y,x1,y1)
|
||
procedure DrawTextCentered(x, y, x1, y1: integer; r: real);
|
||
/// Выводит строку s, отцентрированное по точке с координатами (x,y)
|
||
procedure DrawTextCentered(x, y: integer; s: string);
|
||
/// Выводит целое n, отцентрированное по точке с координатами (x,y)
|
||
procedure DrawTextCentered(x, y: integer; n: integer);
|
||
/// Выводит вещественное r, отцентрированное по точке с координатами (x,y)
|
||
procedure DrawTextCentered(x, y: integer; r: real);
|
||
/// Заливает область одного цвета цветом c, начиная с точки (x,y).
|
||
procedure FloodFill(x, y: integer; c: Color);
|
||
|
||
{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);}
|
||
|
||
//--------------------------------------------
|
||
//// Цвета
|
||
//--------------------------------------------
|
||
/// Возвращает цвет, который содержит красную (r), зеленую (g) и синюю (b) составляющие (r,g и b - в диапазоне от 0 до 255)
|
||
function RGB(r, g, b: byte): Color;
|
||
/// Возвращает цвет, который содержит красную (r), зеленую (g) и синюю (b) составляющие и прозрачность (a) (a,r,g,b - в диапазоне от 0 до 255)
|
||
function ARGB(a, r, g, b: byte): Color;
|
||
|
||
/// Возвращает красный цвет с интенсивностью r (r - в диапазоне от 0 до 255)
|
||
function RedColor(r: byte): Color;
|
||
/// Возвращает зеленый цвет с интенсивностью g (g - в диапазоне от 0 до 255)
|
||
function GreenColor(g: byte): Color;
|
||
/// Возвращает синий цвет с интенсивностью b (b - в диапазоне от 0 до 255)
|
||
function BlueColor(b: byte): Color;
|
||
/// Возвращает случайный цвет
|
||
function clRandom: Color;
|
||
|
||
/// Возвращает красную составляющую цвета
|
||
function GetRed(c: Color): integer;
|
||
/// Возвращает зеленую составляющую цвета
|
||
function GetGreen(c: Color): integer;
|
||
/// Возвращает синюю составляющую цвета
|
||
function GetBlue(c: Color): integer;
|
||
/// Возвращает составляющую прозрачности цвета
|
||
function GetAlpha(c: Color): integer;
|
||
|
||
//--------------------------------------------
|
||
//// Перья
|
||
//--------------------------------------------
|
||
/// Устанавливает цвет текущего пера
|
||
procedure SetPenColor(c: Color);
|
||
/// Возвращает цвет текущего пера
|
||
function PenColor: Color;
|
||
/// Устанавливает ширину текущего пера
|
||
procedure SetPenWidth(Width: integer);
|
||
/// Возвращает ширину текущего пера
|
||
function PenWidth: integer;
|
||
/// Устанавливает стиль текущего пера
|
||
procedure SetPenStyle(style: DashStyle);
|
||
/// Возвращает стиль текущего пера
|
||
function PenStyle: DashStyle;
|
||
/// Устанавливает режим текущего пера
|
||
procedure SetPenMode(m: integer);
|
||
/// Возвращает режим текущего пера
|
||
function PenMode: integer;
|
||
//2015.01>
|
||
/// Устанавливает или отменяет режим закругленных концов линий
|
||
procedure SetPenRoundCap(isRoundCap: boolean);
|
||
/// Возвращает truе, если установлен режим закругленных концов линий
|
||
function PenRoundCap: boolean;
|
||
//2015.01<
|
||
/// Возвращают x-координату текущей позиции рисования
|
||
function PenX: integer;
|
||
/// Возвращают y-координату текущей позиции рисования
|
||
function PenY: integer;
|
||
|
||
//--------------------------------------------
|
||
//// Кисти
|
||
//--------------------------------------------
|
||
/// Устанавливает цвет текущей кисти
|
||
procedure SetBrushColor(c: Color);
|
||
/// Возвращает цвет текущей кисти
|
||
function BrushColor: Color;
|
||
/// Устанавливает цвет текущей кисти
|
||
procedure SetBrushStyle(bs: BrushStyleType);
|
||
/// Возвращает цвет текущей кисти
|
||
function BrushStyle: BrushStyleType;
|
||
/// Устанавливает штриховку текущей кисти
|
||
procedure SetBrushHatch(bh: HatchStyle);
|
||
/// Возвращает штриховку текущей кисти
|
||
function BrushHatch: HatchStyle;
|
||
/// Устанавливает цвет заднего плана текущей штриховой кисти
|
||
procedure SetHatchBrushBackgroundColor(c: Color);
|
||
/// Возвращает цвет заднего плана текущей штриховой кисти
|
||
function HatchBrushBackgroundColor: Color;
|
||
/// Устанавливает второй цвет текущей градиентной кисти
|
||
procedure SetGradientBrushSecondColor(c: Color);
|
||
/// Возвращает второй цвет текущей градиентной кисти
|
||
function GradientBrushSecondColor: Color;
|
||
|
||
//--------------------------------------------
|
||
//// Шрифты
|
||
//--------------------------------------------
|
||
/// Устанавливает размер текущего шрифта в пунктах
|
||
procedure SetFontSize(size: integer);
|
||
/// Возвращает размер текущего шрифта в пунктах
|
||
function FontSize: integer;
|
||
/// Устанавливает имя текущего шрифта
|
||
procedure SetFontName(name: string);
|
||
/// Возвращает имя текущего шрифта
|
||
function FontName: string;
|
||
/// Устанавливает цвет текущего шрифта
|
||
procedure SetFontColor(c: Color);
|
||
/// Возвращает цвет текущего шрифта
|
||
function FontColor: Color;
|
||
/// Устанавливает стиль текущего шрифта
|
||
procedure SetFontStyle(fs: FontStyleType);
|
||
/// Возвращает стиль текущего шрифта
|
||
function FontStyle: FontStyleType;
|
||
/// Возвращает ширину строки s в пикселях при текущих настройках шрифта
|
||
function TextWidth(s: string): integer;
|
||
/// Возвращает высоту строки s в пикселях при текущих настройках шрифта
|
||
function TextHeight(s: string): integer;
|
||
|
||
//--------------------------------------------
|
||
//// Графическое окно
|
||
//--------------------------------------------
|
||
/// Очищает графическое окно белым цветом
|
||
procedure ClearWindow;
|
||
/// Очищает графическое окно цветом c
|
||
procedure ClearWindow(c: Color);
|
||
|
||
/// Возвращает ширину клиентской части графического окна в пикселах
|
||
function WindowWidth: integer;
|
||
/// Возвращает высоту клиентской части графического окна в пикселах
|
||
function WindowHeight: integer;
|
||
/// Возвращает отступ графического окна от левого края экрана в пикселах
|
||
function WindowLeft: integer;
|
||
/// Возвращает отступ графического окна от верхнего края экрана в пикселах
|
||
function WindowTop: integer;
|
||
/// Возвращает центр графического окна
|
||
function WindowCenter: Point;
|
||
/// Возвращает True, если графическое окно имеет фиксированный размер, и False в противном случае
|
||
function WindowIsFixedSize: boolean;
|
||
|
||
/// Устанавливает ширину клиентской части графического окна в пикселах
|
||
procedure SetWindowWidth(w: integer);
|
||
/// Устанавливает высоту клиентской части графического окна в пикселах
|
||
procedure SetWindowHeight(h: integer);
|
||
/// Устанавливает отступ графического окна от левого края экрана в пикселах
|
||
procedure SetWindowLeft(l: integer);
|
||
/// Устанавливает отступ графического окна от верхнего края экрана в пикселах
|
||
procedure SetWindowTop(t: integer);
|
||
/// Устанавливает, имеет ли графическое окно фиксированный размер
|
||
procedure SetWindowIsFixedSize(b: boolean);
|
||
|
||
/// Устанавливает размеры клиентской части графического окна в пикселах
|
||
procedure SetWindowSize(w, h: integer);
|
||
/// Устанавливает отступ графического окна от левого верхнего края экрана в пикселах
|
||
procedure SetWindowPos(l, t: integer);
|
||
|
||
/// Возвращает ширину графического компонента в пикселах (по умолчанию совпадает с WindowWidth)
|
||
function GraphBoxWidth: integer;
|
||
/// Возвращает высоту графического компонента в пикселах (по умолчанию совпадает с WindowHeight)
|
||
function GraphBoxHeight: integer;
|
||
/// Возвращает отступ графического компонента от левого края окна в пикселах
|
||
function GraphBoxLeft: integer;
|
||
/// Возвращает отступ графического компонента от верхнего края окна в пикселах
|
||
function GraphBoxTop: integer;
|
||
|
||
/// Возвращает заголовок графического окна
|
||
function WindowCaption: string;
|
||
/// Возвращает заголовок графического окна
|
||
function WindowTitle: string;
|
||
/// Устанавливает заголовок графического окна
|
||
procedure SetWindowCaption(s: string);
|
||
/// Устанавливает заголовок графического окна
|
||
procedure SetWindowTitle(s: string);
|
||
|
||
/// Устанавливает ширину и высоту клиентской части графического окна в пикселах
|
||
procedure InitWindow(Left, Top, Width, Height: integer; BackColor: Color := clWhite);
|
||
|
||
/// Сохраняет содержимое графического окна в файл с именем fname
|
||
procedure SaveWindow(fname: string);
|
||
/// Восстанавливает содержимое графического окна из файла с именем fname
|
||
procedure LoadWindow(fname: string);
|
||
/// Заполняет содержимое графического окна обоями из файла с именем fname
|
||
procedure FillWindow(fname: string);
|
||
/// Закрывает графическое окно и завершает приложение
|
||
procedure CloseWindow;
|
||
|
||
/// Возвращает ширину экрана в пикселях
|
||
function ScreenWidth: integer;
|
||
/// Возвращает высоту экрана в пикселях
|
||
function ScreenHeight: integer;
|
||
|
||
/// Центрирует графическое окно по центру экрана
|
||
procedure CenterWindow;
|
||
/// Максимизирует графическое окно
|
||
procedure MaximizeWindow;
|
||
/// Сворачивает графическое окно
|
||
procedure MinimizeWindow;
|
||
/// Возвращает графическое окно к нормальному размеру
|
||
procedure NormalizeWindow;
|
||
|
||
//--------------------------------------------
|
||
//// Буферизация рисования
|
||
//--------------------------------------------
|
||
/// Перерисовывает содержимое графического окна. Вызывается в паре с LockDrawing
|
||
procedure Redraw;
|
||
///--
|
||
procedure FullRedraw;
|
||
/// Блокирует рисование на графическом окне. Перерисовка графического окна выполняется с помощью Redraw
|
||
procedure LockDrawing;
|
||
/// Снимает блокировку рисования на графическом окне и осуществляет его перерисовку
|
||
procedure UnlockDrawing;
|
||
|
||
//--------------------------------------------
|
||
//// Сглаживание
|
||
//--------------------------------------------
|
||
/// Устанавливает режим сглаживания
|
||
procedure SetSmoothing(sm: boolean);
|
||
/// Включает режим сглаживания
|
||
procedure SetSmoothingOn;
|
||
/// Выключает режим сглаживания
|
||
procedure SetSmoothingOff;
|
||
/// Возвращает True, если режим сглаживания установлен
|
||
function SmoothingIsOn: boolean;
|
||
|
||
//--------------------------------------------
|
||
//// Вспомогательные подпрограммы
|
||
//--------------------------------------------
|
||
/// Блокирует прорисовку графики. Вызывается для синхронизации
|
||
procedure LockGraphics;
|
||
/// Разблокирует прорисовку графики. Вызывается для синхронизации
|
||
procedure UnLockGraphics;
|
||
|
||
//------------------------------------------------------------
|
||
//// Подпрограммы для работы с системой координат
|
||
//------------------------------------------------------------
|
||
/// Устанавливает начало координат в точку (x0,y0)
|
||
procedure SetCoordinateOrigin(x0, y0: integer);
|
||
/// Устанавливает масштаб системы координат
|
||
procedure SetCoordinateScale(sx, sy: real);
|
||
/// Устанавливает поворот системы координат
|
||
procedure SetCoordinateAngle(a: real);
|
||
|
||
//----------------------------------------
|
||
//// Сервисные подпрограммы
|
||
//----------------------------------------
|
||
/// Возвращает прямоугольник, заданный координатами противоположных вершин
|
||
function Rect(x1, y1, x2, y2: integer): System.Drawing.Rectangle;
|
||
|
||
/// Возвращает прямоугольник клиентской части главного окна
|
||
function ClientRectangle: System.Drawing.Rectangle;
|
||
|
||
/// Коэффициент масштабирования экрана
|
||
function ScreenScale: real;
|
||
|
||
/// Размер экрана в пикселах
|
||
function ScreenSize: System.Drawing.Size;
|
||
|
||
//------------------------------------------
|
||
//// Рисование графиков функций
|
||
//------------------------------------------
|
||
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
|
||
procedure Draw(f: real-> real; a, b, min, max: real; x1, y1, x2, y2: integer);
|
||
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r
|
||
procedure Draw(f: real-> real; a, b, min, max: real; r: System.Drawing.Rectangle);
|
||
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно
|
||
procedure Draw(f: real-> real; a, b, min, max: real);
|
||
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
|
||
procedure Draw(f: real-> real; a, b: real; x1, y1, x2, y2: integer);
|
||
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике r
|
||
procedure Draw(f: real-> real; a, b: real; r: System.Drawing.Rectangle);
|
||
/// Рисует график функции f, заданной на отрезке [-5,5], в прямоугольнике r
|
||
procedure Draw(f: real-> real; r: System.Drawing.Rectangle);
|
||
/// Рисует график функции f, заданной на отрезке [a,b], на полное графическое окно
|
||
procedure Draw(f: real-> real; a, b: real);
|
||
/// Рисует график функции f, заданной на отрезке [-5,5], на полное графическое окно
|
||
procedure Draw(f: real-> real);
|
||
|
||
//------------------------------------------
|
||
//// Рисование изображений
|
||
//------------------------------------------
|
||
/// Выводит растровое изображение из файла с именем fname в позицию x,y
|
||
procedure Draw(fname: string; x: integer := 0; y: integer := 0);
|
||
/// Выводит растровое изображение из файла с именем fname в позицию x,y, масштабируя его к размеру w на h
|
||
procedure Draw(fname: string; x, y, w, h: integer);
|
||
/// Выводит растровое изображение из файла с именем fname в позицию x,y, масштабируя его с коэффициентом Scale
|
||
procedure Draw(fname: string; x, y: integer; Scale: real);
|
||
|
||
|
||
/// Инициализирует графическое окно. Используется для внутренних целей
|
||
procedure InitGraphABC;
|
||
|
||
type
|
||
/// Тип пера GraphABC
|
||
GraphABCPen = class
|
||
private
|
||
_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;
|
||
//2015.01>
|
||
procedure SetRoundCap(isRoundCap: boolean);
|
||
function GetRoundCap: boolean;
|
||
//2015.01<
|
||
public
|
||
/// Текущее перо .NET
|
||
property NETPen: System.Drawing.Pen read _NETPen write SetNETPen;
|
||
/// Цвет пера
|
||
property Color: GraphABC.Color read GetColor write SetColor;
|
||
/// Ширина пера
|
||
property Width: integer read GetWidth write SetWidth;
|
||
/// Стиль пера
|
||
property Style: DashStyle read GetStyle write SetStyle;
|
||
/// Режим пера
|
||
property Mode: integer read GetMode write SetMode;
|
||
/// X-координата текущей позиции пера
|
||
property X: integer read GetX;
|
||
/// Y-координата текущей позиции пера
|
||
property Y: integer read GetY;
|
||
//2015.01>
|
||
/// Режим закругленных концов линий
|
||
property RoundCap: boolean read GetRoundCap write SetRoundCap;
|
||
//2015.01<
|
||
end;
|
||
|
||
/// Тип кисти GraphABC
|
||
GraphABCBrush = class
|
||
private
|
||
_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;
|
||
public
|
||
/// Текущая кисть .NET
|
||
property NETBrush: System.Drawing.Brush read _NETBrush write SetNETBrush;
|
||
/// Цвет кисти
|
||
property Color: GraphABC.Color read GetColor write SetColor;
|
||
/// Стиль кисти
|
||
property Style: BrushStyleType read GetStyle write SetStyle;
|
||
/// Штриховка кисти
|
||
property Hatch: HatchStyle read GetHatch write SetHatch;
|
||
/// Цвет заднего плана штриховой кисти
|
||
property HatchBackgroundColor: GraphABC.Color read GetHatchBackgroundColor write SetHatchBackgroundColor;
|
||
/// Второй цвет градиентной кисти
|
||
property GradientSecondColor: GraphABC.Color read GetGradientSecondColor write SetGradientSecondColor;
|
||
end;
|
||
|
||
/// Тип шрифта GraphABC
|
||
GraphABCFont = class
|
||
private
|
||
_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;
|
||
public
|
||
/// Текущий шрифт .NET
|
||
property NETFont: System.Drawing.Font read _NETFont write SetNETFont;
|
||
/// Цвет шрифта
|
||
property Color: GraphABC.Color read GetColor write SetColor;
|
||
/// Стиль шрифта
|
||
property Style: FontStyleType read GetStyle write SetStyle;
|
||
/// Размер шрифта в пунктах
|
||
property Size: integer read GetSize write SetSize;
|
||
/// Наименование шрифта
|
||
property Name: string read GetName write SetName;
|
||
end;
|
||
|
||
GraphABCCoordinate = class
|
||
private
|
||
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
|
||
constructor;
|
||
/// Устанавливает параметры системы координат
|
||
procedure SetTransform(x0, y0, angle, sx, sy: real);
|
||
/// Устанавливает начало системы координат
|
||
procedure SetOrigin(x0, y0: integer);
|
||
/// Устанавливает масштаб системы координат
|
||
procedure SetScale(sx, sy: real);
|
||
/// Устанавливает масштаб системы координат
|
||
procedure SetScale(scale: real);
|
||
/// Устанавливает правую систему координат (ось OY направлена вверх, ось OX - вправо)
|
||
procedure SetMathematic;
|
||
/// Устанавливает левую систему координат (ось OY направлена вниз, ось OX - вправо)
|
||
procedure SetStandard;
|
||
|
||
procedure ScaleOn(scale: real);
|
||
|
||
procedure Transform(x, y: real);
|
||
|
||
procedure Rotate(angle: real);
|
||
|
||
procedure ClearMatrix;
|
||
|
||
/// X-координата начала координат относительно левого верхнего угла окна
|
||
property OriginX: integer read GetOriginX write SetOriginX;
|
||
/// Y-координата начала координат относительно левого верхнего угла окна
|
||
property OriginY: integer read GetOriginY write SetOriginY;
|
||
/// Координаты начала координат относительно левого верхнего угла окна
|
||
property Origin: Point read GetOrigin write SetOrigin;
|
||
/// Угол поворота системы координат
|
||
property Angle: real read GetAngle write SetAngle;
|
||
/// Масштаб системы координат по оси X
|
||
property ScaleX: real read GetScaleX write SetScaleX;
|
||
/// Масштаб системы координат по оси Y
|
||
property ScaleY: real read GetScaleY write SetScaleY;
|
||
/// Масштаб системы координат по обоим осям
|
||
property Scale: real write SetScale;
|
||
/// Матрица 3x3 преобразований координат
|
||
property Matrix: System.Drawing.Drawing2D.Matrix read GetMatrix;
|
||
end;
|
||
|
||
GraphABCWindow = class
|
||
private
|
||
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;
|
||
public
|
||
/// Отступ графического окна от левого края экрана в пикселах
|
||
property Left: integer read GetLeft write SetLeft;
|
||
/// Отступ графического окна от верхнего края экрана в пикселах
|
||
property Top: integer read GetTop write SetTop;
|
||
/// Ширина клиентской части графического окна в пикселах
|
||
property Width: integer read GetWidth write SetWidth;
|
||
/// Высота клиентской части графического окна в пикселах
|
||
property Height: integer read GetHeight write SetHeight;
|
||
/// Заголовок графического окна
|
||
property Caption: string read GetCaption write SetCaption;
|
||
/// Заголовок графического окна
|
||
property Title: string read GetCaption write SetCaption;
|
||
/// Имеет ли графическое окно фиксированный размер
|
||
property IsFixedSize: boolean read GetIsFixedSize write SetIsFixedSize;
|
||
/// Очищает графическое окно белым цветом
|
||
procedure Clear;
|
||
/// Очищает графическое окно цветом c
|
||
procedure Clear(c: Color);
|
||
/// Устанавливает размеры клиентской части графического окна в пикселах
|
||
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);
|
||
/// Закрывает графическое окно и завершает приложение
|
||
procedure Close;
|
||
/// Сворачивает графическое окно
|
||
procedure Minimize;
|
||
/// Максимизирует графическое окно
|
||
procedure Maximize;
|
||
/// Возвращает графическое окно к нормальному размеру
|
||
procedure Normalize;
|
||
/// Центрирует графическое окно по центру экрана
|
||
procedure CenterOnScreen;
|
||
/// Возвращает центр графического окна
|
||
function Center: Point;
|
||
end;
|
||
|
||
GraphABCStatusPanel = class
|
||
private
|
||
p: System.Windows.Forms.ToolStripStatusLabel;
|
||
procedure SetText(s: string);
|
||
function GetText: string;
|
||
public
|
||
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;
|
||
|
||
/// Тип рисунка GraphABC
|
||
Picture = class
|
||
public
|
||
bmp, savedbmp: Bitmap;
|
||
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;
|
||
public
|
||
/// Создает рисунок размера w на h пикселей
|
||
constructor Create(w, h: integer);
|
||
/// Создает рисунок из файла с именем fname
|
||
constructor Create(fname: string);
|
||
/// Создает рисунок из прямоугольника r графического окна
|
||
constructor Create(r: System.Drawing.Rectangle);// Create from screen
|
||
/// Загружает рисунок из файла с именем fname
|
||
procedure Load(fname: string);
|
||
/// Сохраняет рисунок в файл с именем fname
|
||
procedure Save(fname: string);
|
||
/// Устанавливает размер рисунка w на h пикселей
|
||
procedure SetSize(w, h: integer);
|
||
/// Ширина рисунка в пикселах
|
||
property Width: integer read GetWidth write SetWidth;
|
||
/// Высота рисунка в пикселах
|
||
property Height: integer read GetHeight write SetHeight;
|
||
/// Прозрачность рисунка; прозрачный цвет задается свойством TransparentColor
|
||
property Transparent: boolean read istransp write SetTransparent;
|
||
/// Прозрачный цвет рисунка. Должна быть установлена прозрачность Transparent := True
|
||
property TransparentColor: GraphABC.Color read GetTransparentColor write SetTransparentColor;
|
||
/// Возвращает True, если изображение данного рисунка пересекается с изображением рисунка p, и False в противном случае. Белый цвет считается прозрачным
|
||
function Intersect(p: Picture): boolean;
|
||
/// Выводит рисунок в позиции (x,y)
|
||
procedure Draw(x: integer := 0; y: integer := 0);
|
||
/// Выводит рисунок в позиции (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 текущего рисунка
|
||
procedure CopyRect(dst: System.Drawing.Rectangle; p: Picture; src: System.Drawing.Rectangle);
|
||
/// Копирует прямоугольник src битового образа bmp в прямоугольник dst текущего рисунка
|
||
procedure CopyRect(dst: System.Drawing.Rectangle; bmp: Bitmap; src: System.Drawing.Rectangle);
|
||
/// Зеркально отображает рисунок относительно горизонтальной оси симметрии
|
||
procedure FlipHorizontal;
|
||
/// Зеркально отображает рисунок относительно вертикальной оси симметрии
|
||
procedure FlipVertical;
|
||
|
||
/// Закрашивает пиксел (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
|
||
procedure DrawPolygon(points: array of Point);
|
||
/// Заполняет на рисунке многоугольник, координаты вершин которого заданы в массиве points
|
||
procedure FillPolygon(points: array of Point);
|
||
/// Выводит на рисунке заполненный многоугольник, координаты вершин которого заданы в массиве points
|
||
procedure Polygon(points: array of Point);
|
||
/// Выводит на рисунке ломаную по точкам, координаты которых заданы в массиве points
|
||
procedure Polyline(points: array of Point);
|
||
/// Выводит на рисунке кривую по точкам, координаты которых заданы в массиве points
|
||
procedure Curve(points: array of Point);
|
||
/// Выводит на рисунке замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure DrawClosedCurve(points: array of Point);
|
||
/// Заполняет на рисунке замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure FillClosedCurve(points: array of Point);
|
||
/// Выводит на рисунке заполненную замкнутую кривую по точкам, координаты которых заданы в массиве points
|
||
procedure ClosedCurve(points: array of Point);
|
||
|
||
/// Выводит на рисунке строку s в прямоугольник к координатами левого верхнего угла (x,y)
|
||
procedure TextOut(x, y: integer; s: string);
|
||
/// Заливает на рисунке область одного цвета цветом c, начиная с точки (x,y).
|
||
procedure FloodFill(x, y: integer; c: Color);
|
||
|
||
/// Очищает рисунок белым цветом
|
||
procedure Clear;
|
||
/// Очищает рисунок цветом c
|
||
procedure Clear(c: Color);
|
||
end;
|
||
|
||
type
|
||
ABCControl = class(Control)
|
||
private
|
||
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
|
||
function IsInputKey(keyData: Keys): boolean; override;
|
||
procedure OnPaintBackground(e: PaintEventArgs); override;begin end;// сами все перерисовываем!
|
||
|
||
public
|
||
constructor(w, h: integer);
|
||
end;
|
||
|
||
/// Создает рисунок размера w на h пикселов и записывает его в переменную p
|
||
procedure CreatePicture(var p: Picture; w, h: integer);
|
||
/// Возвращает окно графического приложения
|
||
function Window: GraphABCWindow;
|
||
/// Возвращает главную форму графического приложения
|
||
function MainForm: Form;
|
||
/// Возвращает графический компонент
|
||
function GraphABCControl: ABCControl;
|
||
/// Возвращает текущее перо
|
||
function Pen: GraphABCPen;
|
||
/// Возвращает текущую кисть
|
||
function Brush: GraphABCBrush;
|
||
/// Возвращает текущий шрифт
|
||
function Font: GraphABCFont;
|
||
/// Возвращает систему координат GraphABC
|
||
function Coordinate: GraphABCCoordinate;
|
||
/// Строка статуса
|
||
function StatusBar: GraphABCStatus;
|
||
|
||
function GraphWindowGraphics: Graphics;
|
||
function GraphBufferGraphics: Graphics;
|
||
function GraphBufferBitmap: Bitmap;
|
||
|
||
/// Устанавливает консольный ввод-вывод
|
||
procedure SetConsoleIO;
|
||
/// Устанавливает ввод-вывод через графическое окно (по умолчанию)
|
||
procedure SetGraphABCIO;
|
||
|
||
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);
|
||
/// Событие изменения размера графического окна
|
||
OnResize: procedure;
|
||
/// Событие закрытия графического окна
|
||
OnClose: procedure;
|
||
|
||
/// Процедурная переменная перерисовки графического окна. Если равна nil, то используется стандартная перерисовка
|
||
RedrawProc: procedure;
|
||
/// Следует ли рисовать во внеэкранном буфере
|
||
DrawInBuffer: boolean;
|
||
|
||
///--
|
||
procedure __InitModule__;
|
||
|
||
implementation
|
||
|
||
uses
|
||
System.Threading,
|
||
GraphABCHelper;
|
||
|
||
const
|
||
FILE_NOT_FOUND_MESSAGE = 'Файл {0} не найден';
|
||
BUTTON_ENTER_TEXT = 'Ввести';
|
||
|
||
type
|
||
Proc1Integer = procedure(x: integer);
|
||
Proc1String = procedure(s: string);
|
||
Proc2Integer = procedure(x, y: integer);
|
||
Proc1Boolean = procedure(b: boolean);
|
||
Proc1BorderStyle = procedure(st: FormBorderStyle);
|
||
|
||
IOGraphABCSystem = class(IOStandardSystem)
|
||
public
|
||
constructor Create;
|
||
// procedure write(p: pointer); override;
|
||
procedure write(obj: object); override;
|
||
procedure writeln; override;
|
||
function read_symbol: char; override;
|
||
function peek: integer; override;
|
||
end;
|
||
|
||
var IsRunningOnMono := System.Type.GetType('Mono.Runtime') <> nil;
|
||
|
||
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;
|
||
|
||
var
|
||
// строка-буфер ввода
|
||
MainThread: Thread;
|
||
// строка-буфер ввода
|
||
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;
|
||
|
||
__buffer: Bitmap;
|
||
bmp: Bitmap;
|
||
gr: Graphics;
|
||
gbmp: Graphics;
|
||
|
||
f: ABCControl;
|
||
ed: TextBox;
|
||
IOPanel: Panel;
|
||
EnterButton: Button;
|
||
|
||
CurrentSolidBrush: SolidBrush;
|
||
CurrentHatchBrush: HatchBrush;
|
||
CurrentGradientBrush: LinearGradientBrush;
|
||
PixelBrush: SolidBrush;
|
||
|
||
// For MoveTo, LineTo
|
||
x_coord, y_coord: integer;
|
||
NotLockDrawing: boolean;
|
||
|
||
StartIsComplete: boolean;
|
||
MainFormThread: System.Threading.Thread;
|
||
|
||
// coords for write
|
||
writecoords: Point := new Point(1, 1);
|
||
// font for write
|
||
// CurrentWriteFont: System.Drawing.Font;
|
||
// format for TextWidth
|
||
sf: StringFormat;
|
||
|
||
// ------------ IOGraphABCSystem -----------------
|
||
constructor IOGraphABCSystem.Create;
|
||
begin
|
||
lock f do
|
||
begin
|
||
{ var fnt := GraphABC.Font.NETFont;
|
||
GraphABC.Font.NETFont := CurrentWriteFont;
|
||
GraphABC.Font.NETFont := fnt;}
|
||
readbuffer := '';
|
||
end;
|
||
end;
|
||
|
||
procedure NextLine;
|
||
begin
|
||
writecoords.X := 1;
|
||
writecoords.Y += TextHeight('a') - 1;
|
||
if writecoords.Y > Window.Height then
|
||
begin
|
||
writecoords.Y := 1;
|
||
end;
|
||
end;
|
||
|
||
procedure IOGraphABCSystem.write(obj: object);
|
||
|
||
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
|
||
var cs := CountSymBeforeDivision(s);
|
||
if cs = Length(s) then
|
||
begin
|
||
TextOut(writecoords.X - 1, writecoords.Y - 1, s);
|
||
var w := TextWidth(s) - 1;
|
||
writecoords.X += w;
|
||
end
|
||
else
|
||
begin
|
||
var srem := s.Substring(cs, s.Length - cs);
|
||
s := s.Substring(0, cs);
|
||
TextOut(writecoords.X - 1, writecoords.Y - 1, s);
|
||
NextLine;
|
||
InternalWrite(srem);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
var s := _ObjectToString(obj);
|
||
lock f do
|
||
begin
|
||
//var fnt := GraphABC.Font.NETFont;
|
||
// GraphABC.Font.NETFont := CurrentWriteFont;
|
||
InternalWrite(s);
|
||
// GraphABC.Font.NETFont := fnt;
|
||
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
|
||
if readbuffer.Length = 0 then
|
||
begin
|
||
IOPanel.Invoke(SetIOPanelVisible);
|
||
// приостановить основной поток
|
||
MainThread.Suspend;
|
||
end;
|
||
Result := readBuffer[1];
|
||
readBuffer := readBuffer.Remove(0, 1);
|
||
end;
|
||
|
||
function IOGraphABCSystem.peek: integer;
|
||
begin
|
||
if readbuffer.Length = 0 then
|
||
begin
|
||
IOPanel.Invoke(SetIOPanelVisible);
|
||
// приостановить основной поток
|
||
MainThread.Suspend;
|
||
end;
|
||
Result := integer(readBuffer[1]);
|
||
end;
|
||
|
||
// ------------ GraphABCCoordinate -----------------
|
||
constructor GraphABCCoordinate.Create;
|
||
begin
|
||
// 1 - компьютерная система координат (ось OY - вниз)
|
||
// -1 - математическия система координат (ось OY - вверх)
|
||
coef := 1;
|
||
end;
|
||
|
||
procedure GraphABCCoordinate.SetTransform(x0, y0, angle, sx, sy: real);
|
||
begin
|
||
sx := abs(sx);
|
||
sy := abs(sy);
|
||
angle := DegToRad(angle);
|
||
var m11 := sx * cos(angle);
|
||
var m12 := coef * sx * sin(angle);
|
||
var m21 := -sy * sin(angle);
|
||
var m22 := coef * sy * cos(angle);
|
||
var m := new System.Drawing.Drawing2D.Matrix(m11, m12, m21, m22, x0, y0);
|
||
lock f do
|
||
begin
|
||
gr.Transform := m;
|
||
gbmp.Transform := m;
|
||
end;
|
||
end;
|
||
|
||
procedure GraphABCCoordinate.SetOrigin(x0, y0: integer) := SetTransform(x0, y0, Angle, ScaleX, ScaleY);
|
||
|
||
procedure GraphABCCoordinate.SetScale(sx, sy: real) := SetTransform(OriginX, OriginY, Angle, sx, sy);
|
||
|
||
procedure GraphABCCoordinate.SetScale(scale: real) := SetScale(scale, scale);
|
||
|
||
procedure GraphABCCoordinate.SetMathematic;
|
||
begin
|
||
coef := -1;
|
||
SetTransform(OriginX, OriginY, Angle, ScaleX, ScaleY);
|
||
end;
|
||
|
||
procedure GraphABCCoordinate.SetStandard;
|
||
begin
|
||
coef := 1;
|
||
SetTransform(OriginX, OriginY, Angle, ScaleX, ScaleY);
|
||
end;
|
||
|
||
procedure GraphABCCoordinate.ScaleOn(scale: real);
|
||
begin
|
||
lock f do
|
||
begin
|
||
gr.ScaleTransform(scale, scale);
|
||
gbmp.ScaleTransform(scale, scale);
|
||
end;
|
||
end;
|
||
|
||
procedure GraphABCCoordinate.Transform(x, y: real);
|
||
begin
|
||
lock f do
|
||
begin
|
||
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;
|
||
|
||
procedure GraphABCCoordinate.SetOriginX(x: integer) := SetOrigin(x, OriginY);
|
||
|
||
procedure GraphABCCoordinate.SetOriginY(y: integer) := SetOrigin(OriginX, y);
|
||
|
||
procedure GraphABCCoordinate.SetOrigin(p: Point) := SetOrigin(p.x, p.y);
|
||
|
||
procedure GraphABCCoordinate.SetAngle(a: real) := SetTransform(OriginX, OriginY, a, ScaleX, ScaleY);
|
||
|
||
procedure GraphABCCoordinate.SetScaleX(sx: real) := SetScale(sx, ScaleY);
|
||
|
||
procedure GraphABCCoordinate.SetScaleY(sy: real) := SetScale(ScaleX, sy);
|
||
|
||
function GraphABCCoordinate.GetOriginX: integer;
|
||
begin
|
||
lock (f) do
|
||
Result := Round(gr.Transform.OffsetX);
|
||
end;
|
||
|
||
function GraphABCCoordinate.GetOrigin := new Point(GetOriginX, GetOriginY);
|
||
|
||
function GraphABCCoordinate.GetOriginY: integer;
|
||
begin
|
||
lock(f) do
|
||
Result := Round(gr.Transform.OffsetY);
|
||
end;
|
||
|
||
function GraphABCCoordinate.GetAngle: real;
|
||
begin
|
||
var a := Coordinate.Matrix.Elements;
|
||
Result := ArcSin(a[1] / ScaleY);
|
||
if a[0] < 0 then
|
||
if a[1] > 0 then
|
||
Result := Pi - Result
|
||
else Result := -Pi - Result;
|
||
Result *= coef * 180 / Pi;
|
||
end;
|
||
|
||
function GraphABCCoordinate.GetScaleX: real;
|
||
begin
|
||
var a := Coordinate.Matrix.Elements;
|
||
Result := sqrt(sqr(a[0]) + sqr(a[1]));
|
||
end;
|
||
|
||
function GraphABCCoordinate.GetScaleY: real;
|
||
begin
|
||
var a := Coordinate.Matrix.Elements;
|
||
Result := sqrt(sqr(a[2]) + sqr(a[3]));
|
||
end;
|
||
|
||
function GraphABCCoordinate.GetMatrix: System.Drawing.Drawing2D.Matrix;
|
||
begin
|
||
lock (f) do
|
||
Result := gr.Transform;
|
||
end;
|
||
|
||
procedure SetCoordinateOrigin(x0, y0: integer);
|
||
begin
|
||
Coordinate.SetOrigin(x0, y0);
|
||
end;
|
||
|
||
procedure SetCoordinateScale(sx, sy: real);
|
||
begin
|
||
Coordinate.SetScale(sx, sy);
|
||
end;
|
||
|
||
procedure SetCoordinateAngle(a: real) := Coordinate.Angle := a;
|
||
|
||
{function CurrentABCWindow: ABCWindow;
|
||
begin
|
||
Result := f;
|
||
end; }
|
||
|
||
procedure LockGraphics := Monitor.Enter(f);
|
||
|
||
procedure UnLockGraphics := Monitor.Exit(f);
|
||
|
||
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;
|
||
|
||
function SmoothingIsOn := gr.SmoothingMode = SmoothingMode.AntiAlias;
|
||
|
||
function GraphWindowGraphics := gr;
|
||
|
||
function GraphBufferGraphics := gbmp;
|
||
|
||
function GraphBufferBitmap := bmp;
|
||
|
||
// 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;
|
||
end;
|
||
|
||
procedure GraphABCPen.SetNETPen(p: System.Drawing.Pen);
|
||
begin
|
||
if p = nil then exit;
|
||
_NETPen := p;
|
||
end;
|
||
|
||
function GraphABCPen.GetX: integer;
|
||
begin
|
||
Result := PenX;
|
||
end;
|
||
|
||
function GraphABCPen.GetY: integer;
|
||
begin
|
||
Result := PenY;
|
||
end;
|
||
|
||
//2015.01>
|
||
procedure GraphABCPen.SetRoundCap(isRoundCap: boolean);
|
||
begin
|
||
SetPenRoundCap(isRoundCap);
|
||
end;
|
||
|
||
function GraphABCPen.GetRoundCap: boolean;
|
||
begin
|
||
result := PenRoundCap;
|
||
end;
|
||
//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
|
||
if f = nil then Exit;
|
||
_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;
|
||
|
||
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
|
||
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
|
||
if (_StatusStrip = nil) or (_StatusStrip.Visible = False) then
|
||
Show;
|
||
f.Invoke(SetStatusTextP, s);
|
||
end;
|
||
|
||
function GraphABCStatus.GetText: string;
|
||
begin
|
||
if (_StatusStrip = nil) or (_StatusStrip.Visible = False) then
|
||
Show;
|
||
Result := _StatusStrip.Items[0].Text
|
||
end;
|
||
|
||
procedure SetPanelsCountP(n: integer);
|
||
begin
|
||
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;
|
||
for var i := 1 to d do
|
||
_StatusStrip.Items.Add(new System.Windows.Forms.ToolStripStatusLabel);
|
||
end;
|
||
end;
|
||
|
||
procedure GraphABCStatus.SetPanelsCount(n: integer);
|
||
begin
|
||
if (_StatusStrip = nil) or (_StatusStrip.Visible = False) then
|
||
Show;
|
||
f.Invoke(SetPanelsCountP, n);
|
||
end;
|
||
|
||
function GraphABCStatus.GetPanelsCount := _StatusStrip.Items.Count;
|
||
|
||
function GraphABCStatus.GetItem(i: integer): GraphABCStatusPanel;
|
||
begin
|
||
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
|
||
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;
|
||
|
||
// Picture
|
||
constructor Picture.Create(w, h: integer);
|
||
begin
|
||
if (w <= 0) or (h <= 0) then
|
||
raise new GraphABCException('w or h <= 0');
|
||
bmp := new Bitmap(w, h);
|
||
gb := Graphics.FromImage(bmp);
|
||
transpcolor := bmp.GetPixel(0, bmp.Height - 1);
|
||
istransp := false;
|
||
savedbmp := nil;
|
||
end;
|
||
|
||
constructor Picture.Create(fname: string);
|
||
begin
|
||
try
|
||
var fs := new System.IO.FileStream(fname, System.IO.FileMode.Open);
|
||
var tmp := Image.FromStream(fs);
|
||
bmp := new Bitmap(tmp);
|
||
fs.Flush;
|
||
fs.Close;
|
||
tmp.Dispose;
|
||
except
|
||
on ex: System.ArgumentException do
|
||
raise new System.IO.FileNotFoundException(string.Format(FILE_NOT_FOUND_MESSAGE, fname));
|
||
end;
|
||
|
||
gb := Graphics.FromImage(bmp); //!!!
|
||
transpcolor := bmp.GetPixel(0, bmp.Height - 1);
|
||
istransp := false;
|
||
savedbmp := nil;
|
||
end;
|
||
|
||
constructor Picture.Create(r: System.Drawing.Rectangle);
|
||
// Create from Screen
|
||
begin
|
||
bmp := new Bitmap(r.Width, r.Height);
|
||
gb := Graphics.FromImage(bmp);
|
||
gb.CopyFromScreen(r.Left, r.Top, 0, 0, r.Size);
|
||
transpcolor := bmp.GetPixel(0, bmp.Height - 1);
|
||
istransp := false;
|
||
savedbmp := nil;
|
||
end;
|
||
|
||
procedure Picture.SetWidth(w: integer);
|
||
begin
|
||
SetSize(w, Height);
|
||
end;
|
||
|
||
function Picture.GetWidth: integer;
|
||
begin
|
||
Result := bmp.Width;
|
||
end;
|
||
|
||
procedure Picture.SetHeight(h: integer);
|
||
begin
|
||
SetSize(Width, h);
|
||
end;
|
||
|
||
function Picture.GetHeight: integer;
|
||
begin
|
||
Result := bmp.Height;
|
||
end;
|
||
|
||
{
|
||
// Логика установки прозрачности
|
||
// 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);
|
||
}
|
||
function Picture.GetTransparentColor: Color;
|
||
begin
|
||
Result := transpcolor;
|
||
end;
|
||
|
||
procedure Picture.SetTransparentColor(c: Color);
|
||
begin
|
||
if c = TransparentColor then
|
||
Exit;
|
||
transpcolor := c;
|
||
if istransp then
|
||
begin
|
||
bmp.Dispose;
|
||
var ob := savedbmp.Clone;
|
||
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;
|
||
var ob := bmp.Clone;
|
||
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;
|
||
//2015.01>
|
||
// bmp := new Bitmap(fname);
|
||
try
|
||
var fs := new System.IO.FileStream(fname, System.IO.FileMode.Open);
|
||
var tmp := Image.FromStream(fs);
|
||
bmp := new Bitmap(tmp);
|
||
fs.Flush;
|
||
fs.Close;
|
||
tmp.Dispose;
|
||
except
|
||
on ex: System.ArgumentException do
|
||
raise new System.IO.FileNotFoundException(string.Format(FILE_NOT_FOUND_MESSAGE, fname));
|
||
end;
|
||
//2015.01<
|
||
gb := Graphics.FromImage(bmp);
|
||
istransp := False;
|
||
if savedbmp <> nil then
|
||
begin
|
||
savedbmp.Dispose;
|
||
savedbmp := nil;
|
||
end;
|
||
end;
|
||
|
||
procedure Picture.Save(fname: string);
|
||
begin
|
||
bmp.Save(fname);
|
||
end;
|
||
|
||
procedure Picture.SetSize(w, h: integer);
|
||
begin
|
||
var oldbmp := bmp;
|
||
bmp := new Bitmap(oldbmp, w, h);
|
||
gb := Graphics.FromImage(bmp);
|
||
gb.DrawImage(oldbmp, 0, 0);
|
||
oldbmp.Dispose;
|
||
// TODO не знаю, может, надо что-то делать для прозрачной
|
||
{ if istransp then
|
||
begin
|
||
end}
|
||
end;
|
||
|
||
function Picture.Intersect(p: Picture): boolean;
|
||
begin
|
||
// bmp.L
|
||
result := false;
|
||
// TODO
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
gr.DrawImage(bmp, x, y, bmp.Width, bmp.Height);
|
||
if DrawInBuffer then
|
||
gbmp.DrawImage(bmp, x, y, bmp.Width, bmp.Height);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y: integer; g: Graphics);
|
||
begin
|
||
g.DrawImage(bmp, x, y, bmp.Width, bmp.Height);
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y, w, h: integer);
|
||
// Draw bmp scaled to size w,h
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
gr.DrawImage(bmp, x, y, w, h);
|
||
if DrawInBuffer then
|
||
gbmp.DrawImage(bmp, x, y, w, h);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y, w, h: integer; g: Graphics);
|
||
// Draw bmp scaled to size w,h
|
||
begin
|
||
g.DrawImage(bmp, x, y, w, h);
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y: integer; r: System.Drawing.Rectangle);
|
||
// Draw bmp in rectangle r
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
gr.DrawImage(bmp, x, y, r, GraphicsUnit.Pixel);
|
||
if DrawInBuffer then
|
||
gbmp.DrawImage(bmp, x, y, r, GraphicsUnit.Pixel);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y: integer; r: System.Drawing.Rectangle; g: Graphics);
|
||
begin
|
||
g.DrawImage(bmp, x, y, r, GraphicsUnit.Pixel);
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y, w, h: integer; r: System.Drawing.Rectangle);
|
||
// Draw rectangle r portion of bmp scaled to size w,h
|
||
begin
|
||
var r1 := new System.Drawing.Rectangle(x, y, w, h);
|
||
var tempbmp := GetView(bmp, r);
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
gr.DrawImage(tempbmp, r1);
|
||
// gr.DrawImage(bmp,r1,r,GraphicsUnit.Pixel);
|
||
if DrawInBuffer then
|
||
gbmp.DrawImage(tempbmp, r1);
|
||
// gbmp.DrawImage(bmp,r1,r,GraphicsUnit.Pixel);
|
||
Monitor.Exit(f);
|
||
tempbmp.Dispose;
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y, w, h: integer; r: System.Drawing.Rectangle; g: Graphics);
|
||
begin
|
||
var tempbmp := GetView(bmp, r);
|
||
g.DrawImage(tempbmp, x, y, new System.Drawing.Rectangle(x, y, w, h), GraphicsUnit.Pixel);
|
||
tempbmp.Dispose;
|
||
end;
|
||
|
||
procedure Picture.Draw(x, y: integer; rotateAngle: real; w, h: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
var phi := (rotateAngle / 360) * 2 * Pi;//угол в радианах
|
||
|
||
//размер после поворота
|
||
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)));
|
||
|
||
var newImg: Bitmap := new Bitmap(new_w, new_h);
|
||
var g: Graphics := Graphics.FromImage(newImg);
|
||
|
||
g.Clear(Color.FromArgb(0, 0, 0, 0));
|
||
g.TranslateTransform(new_w / 2, new_h / 2);
|
||
g.RotateTransform(rotateAngle);
|
||
g.TranslateTransform(-new_w / 2, -new_h / 2);
|
||
|
||
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) - центр масштабированного и повернутого изображения
|
||
if NotLockDrawing then
|
||
gr.DrawImage(newImg, x - (new_w - w) / 2, y - (new_h - h) / 2, new_w, new_h);
|
||
if DrawInBuffer then
|
||
gbmp.DrawImage(newImg, x - (new_w - w) / 2, y - (new_h - h) / 2, new_w, new_h);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
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
|
||
CopyRect(dst, p.bmp, src);
|
||
end;
|
||
|
||
procedure Picture.CopyRect(dst: System.Drawing.Rectangle; bmp: Bitmap; src: System.Drawing.Rectangle);
|
||
begin
|
||
// Copy src portion of bmp on dst rectangle of this picture
|
||
var tempbmp := GetView(bmp, src);
|
||
// gb.DrawImage(bmp,dst,src,GraphicsUnit.Pixel);
|
||
gb.DrawImage(tempbmp, dst);
|
||
tempbmp.Dispose;
|
||
end;
|
||
|
||
procedure Picture.FlipHorizontal;
|
||
begin
|
||
bmp.RotateFlip(RotateFlipType.RotateNoneFlipX);
|
||
end;
|
||
|
||
procedure Picture.FlipVertical;
|
||
begin
|
||
bmp.RotateFlip(RotateFlipType.RotateNoneFlipY);
|
||
end;
|
||
|
||
procedure Picture.SetPixel(x, y: integer; c: Color);
|
||
begin
|
||
bmp.SetPixel(x, y, c);
|
||
end;
|
||
|
||
procedure Picture.PutPixel(x, y: integer; c: Color);
|
||
begin
|
||
bmp.SetPixel(x, y, c);
|
||
end;
|
||
|
||
function Picture.GetPixel(x, y: integer): Color;
|
||
begin
|
||
Result := bmp.GetPixel(x, y);
|
||
end;
|
||
|
||
procedure Picture.Line(x1, y1, x2, y2: integer);
|
||
begin
|
||
GraphABCHelper.Line(x1, y1, x2, y2, gb);
|
||
end;
|
||
|
||
procedure Picture.Line(x1, y1, x2, y2: integer; c: Color);
|
||
begin
|
||
GraphABCHelper.Line(x1, y1, x2, y2, c, gb);
|
||
end;
|
||
|
||
procedure Picture.FillCircle(x, y, r: integer);
|
||
begin
|
||
GraphABCHelper.FillEllipse(x - r, y - r, x + r, y + r, gb);
|
||
end;
|
||
|
||
procedure Picture.DrawCircle(x, y, r: integer);
|
||
begin
|
||
GraphABCHelper.DrawEllipse(x - r, y - r, x + r, y + r, gb);
|
||
end;
|
||
|
||
procedure Picture.FillEllipse(x1, y1, x2, y2: integer);
|
||
begin
|
||
GraphABCHelper.FillEllipse(x1, y1, x2, y2, gb);
|
||
end;
|
||
|
||
procedure Picture.DrawEllipse(x1, y1, x2, y2: integer);
|
||
begin
|
||
GraphABCHelper.DrawEllipse(x1, y1, x2, y2, gb);
|
||
end;
|
||
|
||
procedure Picture.FillRectangle(x1, y1, x2, y2: integer);
|
||
begin
|
||
GraphABCHelper.FillRectangle(x1, y1, x2, y2, gb);
|
||
end;
|
||
|
||
procedure Picture.FillRect(x1, y1, x2, y2: integer);
|
||
begin
|
||
GraphABCHelper.FillRectangle(x1, y1, x2, y2, gb);
|
||
end;
|
||
|
||
procedure Picture.DrawRectangle(x1, y1, x2, y2: integer);
|
||
begin
|
||
GraphABCHelper.DrawRectangle(x1, y1, x2, y2, gb);
|
||
end;
|
||
|
||
procedure Picture.Circle(x, y, r: integer);
|
||
begin
|
||
GraphABCHelper.Ellipse(x - r, y - r, x + r, y + r, gb);
|
||
end;
|
||
|
||
procedure Picture.Ellipse(x1, y1, x2, y2: integer);
|
||
begin
|
||
GraphABCHelper.Ellipse(x1, y1, x2, y2, gb);
|
||
end;
|
||
|
||
procedure Picture.Rectangle(x1, y1, x2, y2: integer);
|
||
begin
|
||
GraphABCHelper.Rectangle(x1, y1, x2, y2, gb);
|
||
end;
|
||
|
||
procedure Picture.RoundRect(x1, y1, x2, y2, w, h: integer);
|
||
begin
|
||
GraphABCHelper.RoundRect(x1, y1, x2, y2, w, h, gb);
|
||
end;
|
||
|
||
procedure Picture.Arc(x, y, r, a1, a2: integer);
|
||
begin
|
||
GraphABCHelper.Arc(x, y, r, a1, a2, gb);
|
||
end;
|
||
|
||
procedure Picture.FillPie(x, y, r, a1, a2: integer);
|
||
begin
|
||
GraphABCHelper.FillPie(x, y, r, a1, a2, gb);
|
||
end;
|
||
|
||
procedure Picture.DrawPie(x, y, r, a1, a2: integer);
|
||
begin
|
||
GraphABCHelper.DrawPie(x, y, r, a1, a2, gb);
|
||
end;
|
||
|
||
procedure Picture.Pie(x, y, r, a1, a2: integer);
|
||
begin
|
||
GraphABCHelper.Pie(x, y, r, a1, a2, gb);
|
||
end;
|
||
|
||
procedure Picture.DrawPolygon(points: array of Point);
|
||
begin
|
||
GraphABCHelper.DrawPolygon(points, gb);
|
||
end;
|
||
|
||
procedure Picture.FillPolygon(points: array of Point);
|
||
begin
|
||
GraphABCHelper.FillPolygon(points, gb);
|
||
end;
|
||
|
||
procedure Picture.Polygon(points: array of Point);
|
||
begin
|
||
GraphABCHelper.Polygon(points, gb);
|
||
end;
|
||
|
||
procedure Picture.Polyline(points: array of Point);
|
||
begin
|
||
GraphABCHelper.Polyline(points, gb);
|
||
end;
|
||
|
||
procedure Picture.Curve(points: array of Point);
|
||
begin
|
||
GraphABCHelper.Curve(points, gb);
|
||
end;
|
||
|
||
procedure Picture.DrawClosedCurve(points: array of Point);
|
||
begin
|
||
GraphABCHelper.DrawClosedCurve(points, gb);
|
||
end;
|
||
|
||
procedure Picture.FillClosedCurve(points: array of Point);
|
||
begin
|
||
GraphABCHelper.FillClosedCurve(points, gb);
|
||
end;
|
||
|
||
procedure Picture.ClosedCurve(points: array of Point);
|
||
begin
|
||
GraphABCHelper.ClosedCurve(points, gb);
|
||
end;
|
||
|
||
procedure Picture.TextOut(x, y: integer; s: string);
|
||
begin
|
||
GraphABCHelper.TextOut(x, y, s, gb);
|
||
end;
|
||
|
||
function ExtFloodFill(hdc: IntPtr; x, y: integer; color: integer; filltype: integer): boolean; external 'Gdi32.dll' name 'ExtFloodFill';
|
||
|
||
function SelectObject(hdc, hgdiobj: IntPtr): IntPtr; external 'Gdi32.dll' name 'SelectObject';
|
||
|
||
function CreateSolidBrush(c: integer): IntPtr; external 'Gdi32.dll' name 'CreateSolidBrush';
|
||
|
||
function DeleteObject(obj: IntPtr): integer; external 'Gdi32.dll' name 'DeleteObject';
|
||
|
||
function CreateCompatibleDC(obj: IntPtr): IntPtr; external 'Gdi32.dll' name 'CreateCompatibleDC';
|
||
|
||
procedure Picture.FloodFill(x, y: integer; c: Color);
|
||
var
|
||
hdc, hBrush, hOldBrush: IntPtr;
|
||
begin
|
||
var borderColor: Color := GetPixel(x, y);
|
||
|
||
var bc := ColorTranslator.ToWin32(borderColor);
|
||
var cc := ColorTranslator.ToWin32(c);
|
||
|
||
Monitor.Enter(f);
|
||
|
||
hdc := gbmp.GetHDC();
|
||
hBrush := CreateSolidBrush(cc);
|
||
|
||
hOldBrush := SelectObject(hdc, hBrush);
|
||
ExtFloodFill(hdc, x, y, bc, 1);
|
||
SelectObject(hdc, holdBrush);
|
||
|
||
DeleteObject(hBrush);
|
||
|
||
gbmp.ReleaseHdc();
|
||
|
||
DeleteObject(hdc);
|
||
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Picture.Clear;
|
||
begin
|
||
Monitor.Enter(f);
|
||
gb.FillRectangle(Brushes.White, 0, 0, WindowWidth, WindowHeight);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Picture.Clear(c: Color);
|
||
begin
|
||
Monitor.Enter(f);
|
||
gb.FillRectangle(new SolidBrush(c), 0, 0, WindowWidth, WindowHeight);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
// ABCControl
|
||
function ABCControl.IsInputKey(keyData: Keys): boolean;
|
||
begin
|
||
Result := True;
|
||
end;
|
||
|
||
procedure InitBMP;
|
||
begin
|
||
var ww := ScreenWidth;
|
||
var hh := ScreenHeight;
|
||
bmp := new Bitmap(ww, hh, gr);
|
||
gbmp := Graphics.FromImage(bmp);
|
||
__buffer := bmp;
|
||
gbmp.FillRectangle(Brushes.White, 0, 0, ww, hh);
|
||
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;
|
||
|
||
// These Events must be initialised in main form
|
||
// FormClosing += OnClosing;
|
||
|
||
// Initialization of global vars
|
||
|
||
Pen.NETPen := new System.Drawing.Pen(System.Drawing.Color.Black);
|
||
GraphABC.Font.NETFont := new System.Drawing.Font('Arial', 10);
|
||
|
||
PixelBrush := new SolidBrush(System.Drawing.Color.Black);
|
||
CurrentSolidBrush := new SolidBrush(System.Drawing.Color.White);
|
||
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);
|
||
Brush.NETBrush := CurrentSolidBrush;
|
||
|
||
// CurrentWriteFont := new System.Drawing.Font('Courier New',10);
|
||
|
||
NotLockDrawing := True;
|
||
DrawInBuffer := True;
|
||
RedrawProc := nil;
|
||
end;
|
||
|
||
constructor ABCControl.Create(w, h: integer);
|
||
begin
|
||
ClientSize := new System.Drawing.Size(w, h);
|
||
Init;
|
||
end;
|
||
|
||
procedure ABCControl.OnPaint(sender: object; e: PaintEventArgs);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if (e <> nil) and NotLockDrawing then
|
||
begin
|
||
if RedrawProc <> nil then
|
||
RedrawProc
|
||
else e.Graphics.DrawImage(bmp, 0, 0);
|
||
end;
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure ABCControl.OnClosing(sender: object; e: FormClosingEventArgs);
|
||
begin
|
||
if GraphABC.OnClose <> nil then
|
||
GraphABC.OnClose;
|
||
NotLockDrawing := False;
|
||
//Sleep(0);
|
||
Halt;
|
||
end;
|
||
|
||
procedure ABCControl.OnMouseDown(sender: Object; e: MouseEventArgs);
|
||
type
|
||
MouseButtons = System.Windows.Forms.MouseButtons;
|
||
var
|
||
mb: integer;
|
||
begin
|
||
if e.Button = MouseButtons.Left then
|
||
mb := 1
|
||
else if e.Button = MouseButtons.Right then
|
||
mb := 2;
|
||
if GraphABC.OnMouseDown <> nil then
|
||
GraphABC.OnMouseDown(e.x, e.y, mb);
|
||
end;
|
||
|
||
procedure ABCControl.OnMouseUp(sender: Object; e: MouseEventArgs);
|
||
type
|
||
MouseButtons = System.Windows.Forms.MouseButtons;
|
||
var
|
||
mb: integer;
|
||
begin
|
||
if e.Button = MouseButtons.Left then
|
||
mb := 1
|
||
else if e.Button = MouseButtons.Right then
|
||
mb := 2;
|
||
if GraphABC.OnMouseUp <> nil then
|
||
GraphABC.OnMouseUp(e.x, e.y, mb);
|
||
end;
|
||
|
||
procedure ABCControl.OnMouseMove(sender: Object; e: MouseEventArgs);
|
||
type
|
||
MouseButtons = System.Windows.Forms.MouseButtons;
|
||
var
|
||
mb: integer;
|
||
begin
|
||
if e.Button = MouseButtons.Left then
|
||
mb := 1
|
||
else if e.Button = MouseButtons.Right then
|
||
mb := 2;
|
||
if GraphABC.OnMouseMove <> nil then
|
||
GraphABC.OnMouseMove(e.x, e.y, mb);
|
||
end;
|
||
|
||
procedure ABCControl.OnKeyDown(sender: Object; e: KeyEventArgs);
|
||
begin
|
||
if GraphABC.OnKeyDown <> nil then
|
||
GraphABC.OnKeyDown(integer(e.KeyCode));
|
||
end;
|
||
|
||
procedure ABCControl.OnKeyUp(sender: Object; e: KeyEventArgs);
|
||
begin
|
||
if GraphABC.OnKeyUp <> nil then
|
||
GraphABC.OnKeyUp(integer(e.KeyCode));
|
||
end;
|
||
|
||
procedure ABCControl.OnKeyPress(sender: Object; e: KeyPressEventArgs);
|
||
begin
|
||
if GraphABC.OnKeyPress <> nil then
|
||
GraphABC.OnKeyPress(e.KeyChar);
|
||
end;
|
||
|
||
procedure ResizeHelper;
|
||
begin
|
||
Monitor.Enter(f);
|
||
var t := gr.SmoothingMode;
|
||
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;
|
||
if GraphABC.OnResize <> nil then
|
||
GraphABC.OnResize;
|
||
end;
|
||
|
||
// Extension methods
|
||
procedure System.Drawing.Rectangle.MoveTo(x, y: integer);
|
||
begin
|
||
Self.X := x;
|
||
Self.Y := y;
|
||
end;
|
||
|
||
function operator implicit(Self: Point): (integer, integer); extensionmethod;
|
||
begin
|
||
Result := (Self.X, Self.Y)
|
||
end;
|
||
|
||
function operator implicit(Self: (integer, integer)): Point; extensionmethod;
|
||
begin
|
||
Result := new Point(Self[0], Self[1])
|
||
end;
|
||
|
||
// Primitives
|
||
procedure SetPixel(x, y: integer; c: Color);
|
||
begin
|
||
PutPixel(x,y,c);
|
||
{lock f do
|
||
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);
|
||
end;}
|
||
end;
|
||
|
||
procedure PutPixel(x, y: integer; c: Color);
|
||
begin
|
||
Monitor.Enter(f);
|
||
var b := SmoothingIsOn;
|
||
SetSmoothingOff;
|
||
PixelBrush.Color := c;
|
||
if NotLockDrawing then
|
||
gr.FillRectangle(PixelBrush, x, y, 1, 1);
|
||
if DrawInBuffer then
|
||
gbmp.FillRectangle(PixelBrush, x, y, 1, 1);
|
||
SetSmoothing(b);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
function GetPixel(x, y: integer): Color;
|
||
begin
|
||
Monitor.Enter(f);
|
||
Result := bmp.GetPixel(x, y);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure MoveTo(x, y: integer);
|
||
begin
|
||
x_coord := x;
|
||
y_coord := y;
|
||
end;
|
||
|
||
procedure MoveRel(dx, dy: integer);
|
||
begin
|
||
x_coord += dx;
|
||
y_coord += dy;
|
||
end;
|
||
|
||
procedure LineTo(x, y: integer);
|
||
begin
|
||
Line(x_coord, y_coord, x, y);
|
||
x_coord := x;
|
||
y_coord := y;
|
||
end;
|
||
|
||
procedure LineTo(x, y: integer; c: Color);
|
||
begin
|
||
Line(x_coord, y_coord, x, y, c);
|
||
x_coord := x;
|
||
y_coord := y;
|
||
end;
|
||
|
||
procedure LineRel(dx, dy: integer);
|
||
begin
|
||
LineTo(x_coord + dx, y_coord + dy);
|
||
end;
|
||
|
||
procedure LineRel(dx, dy: integer; c: Color);
|
||
begin
|
||
LineTo(x_coord + dx, y_coord + dy, c);
|
||
end;
|
||
|
||
procedure Line(x1, y1, x2, y2: integer; c: Color);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
Line(x1, y1, x2, y2, c, gr);
|
||
if DrawInBuffer then
|
||
Line(x1, y1, x2, y2, c, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Line(p1, p2: Point; c: Color);
|
||
begin
|
||
Line(p1.X, p1.Y, p2.X, p2.Y, c)
|
||
end;
|
||
|
||
procedure Line(x1, y1, x2, y2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
Line(x1, y1, x2, y2, gr);
|
||
if DrawInBuffer then
|
||
Line(x1, y1, x2, y2, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Line(p1, p2: Point);
|
||
begin
|
||
Line(p1.X, p1.Y, p2.X, p2.Y)
|
||
end;
|
||
|
||
procedure FillCircle(x, y, r: integer);
|
||
begin
|
||
// SSM 14.5.10
|
||
FillEllipse(x - r, y - r, x + r + 1, y + r + 1);
|
||
end;
|
||
|
||
procedure DrawCircle(x, y, r: integer);
|
||
begin
|
||
// SSM 14.5.10
|
||
DrawEllipse(x - r, y - r, x + r + 1, y + r + 1);
|
||
end;
|
||
|
||
procedure Circle(x, y, r: integer);
|
||
begin
|
||
// SSM 14.5.10
|
||
Ellipse(x - r, y - r, x + r + 1, y + r + 1);
|
||
end;
|
||
|
||
procedure FillEllipse(x1, y1, x2, y2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
FillEllipse(x1, y1, x2, y2, gr);
|
||
if DrawInBuffer then
|
||
FillEllipse(x1, y1, x2, y2, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure DrawEllipse(x1, y1, x2, y2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
DrawEllipse(x1, y1, x2, y2, gr);
|
||
if DrawInBuffer then
|
||
DrawEllipse(x1, y1, x2, y2, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Ellipse(x1, y1, x2, y2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if Brush.NETBrush <> nil then
|
||
FillEllipse(x1, y1, x2, y2);
|
||
if Pen.NETPen.DashStyle <> DashStyle.Custom then
|
||
DrawEllipse(x1, y1, x2, y2);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure FillRectangle(x1, y1, x2, y2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
FillRectangle(x1, y1, x2, y2, gr);
|
||
if DrawInBuffer then
|
||
FillRectangle(x1, y1, x2, y2, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure DrawRectangle(x1, y1, x2, y2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
DrawRectangle(x1, y1, x2, y2, gr);
|
||
if DrawInBuffer then
|
||
DrawRectangle(x1, y1, x2, y2, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Rectangle(x1, y1, x2, y2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if x1 > x2 then
|
||
Swap(x1, x2);
|
||
if y1 > y2 then
|
||
Swap(y1, y2);
|
||
if Brush.NETBrush <> nil then
|
||
FillRectangle(x1, y1, x2 - 1, y2 - 1);
|
||
if Pen.NETPen.DashStyle <> DashStyle.Custom then
|
||
DrawRectangle(x1, y1, x2, y2);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure DrawRoundRect(x1, y1, x2, y2, w, h: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
DrawRoundRect(x1, y1, x2, y2, w, h, gr);
|
||
if DrawInBuffer then
|
||
DrawRoundRect(x1, y1, x2, y2, w, h, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure FillRoundRect(x1, y1, x2, y2, w, h: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
FillRoundRect(x1, y1, x2, y2, w, h, gr);
|
||
if DrawInBuffer then
|
||
FillRoundRect(x1, y1, x2, y2, w, h, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure RoundRect(x1, y1, x2, y2, w, h: integer);
|
||
begin
|
||
if Brush.NETBrush <> nil then
|
||
FillRoundRect(x1, y1, x2, y2, w, h);
|
||
if Pen.NETPen.DashStyle <> DashStyle.Custom then
|
||
DrawRoundRect(x1, y1, x2, y2, w, h);
|
||
end;
|
||
|
||
procedure Arc(x, y, r, a1, a2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
Arc(x, y, r, a1, a2, gr);
|
||
if DrawInBuffer then
|
||
Arc(x, y, r, a1, a2, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure FillPie(x, y, r, a1, a2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
FillPie(x, y, r, a1, a2, gr);
|
||
if DrawInBuffer then
|
||
FillPie(x, y, r, a1, a2, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure DrawPie(x, y, r, a1, a2: integer);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
DrawPie(x, y, r, a1, a2, gr);
|
||
if DrawInBuffer then
|
||
DrawPie(x, y, r, a1, a2, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Pie(x, y, r, a1, a2: integer);
|
||
begin
|
||
if Brush.NETBrush <> nil then
|
||
FillPie(x, y, r, a1, a2);
|
||
if Pen.NETPen.DashStyle <> DashStyle.Custom then
|
||
DrawPie(x, y, r, a1, a2);
|
||
end;
|
||
|
||
procedure TextOut(x, y: integer; s: string);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
TextOut(x, y, s, gr);
|
||
if DrawInBuffer then
|
||
TextOut(x, y, s, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure TextOut(x, y: integer; n: integer);
|
||
begin
|
||
TextOut(x, y, n.ToString);
|
||
end;
|
||
|
||
procedure TextOut(x, y: integer; r: real);
|
||
begin
|
||
var nfi := new System.Globalization.NumberFormatInfo();
|
||
nfi.NumberGroupSeparator := '.';
|
||
|
||
TextOut(x, y, r.ToString(nfi));
|
||
end;
|
||
|
||
procedure DrawTextCentered(x, y, x1, y1: integer; s: string);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
DrawTextCentered(x, y, x1, y1, s, gr);
|
||
if DrawInBuffer then
|
||
DrawTextCentered(x, y, x1, y1, s, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure DrawTextCentered(x, y, x1, y1: integer; n: integer);
|
||
begin
|
||
DrawTextCentered(x, y, x1, y1, n.ToString);
|
||
end;
|
||
|
||
procedure DrawTextCentered(x, y, x1, y1: integer; r: real);
|
||
begin
|
||
var nfi := new System.Globalization.NumberFormatInfo();
|
||
nfi.NumberGroupSeparator := '.';
|
||
|
||
DrawTextCentered(x, y, x1, y1, r.ToString(nfi));
|
||
end;
|
||
|
||
procedure DrawTextCentered(x, y: integer; s: string);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
DrawTextCentered(x, y, s, gr);
|
||
if DrawInBuffer then
|
||
DrawTextCentered(x, y, s, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure DrawTextCentered(x, y: integer; n: integer);
|
||
begin
|
||
DrawTextCentered(x, y, n.ToString);
|
||
end;
|
||
|
||
procedure DrawTextCentered(x, y: integer; r: real);
|
||
begin
|
||
var nfi := new System.Globalization.NumberFormatInfo();
|
||
nfi.NumberGroupSeparator := '.';
|
||
|
||
DrawTextCentered(x, y, r.ToString(nfi));
|
||
end;
|
||
|
||
|
||
function Pnt(x, y: integer): Point;
|
||
begin
|
||
Result := new Point(x, y);
|
||
end;
|
||
|
||
procedure DrawPolygon(points: array of Point);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
DrawPolygon(points, gr);
|
||
if DrawInBuffer then
|
||
DrawPolygon(points, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure DrawPolygon(params points: array of (integer, integer));
|
||
begin
|
||
var pnts := points.Select(p -> Pnt(p[0], p[1]));
|
||
DrawPolygon(pnts.ToArray);
|
||
end;
|
||
|
||
procedure FillPolygon(points: array of Point);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
FillPolygon(points, gr);
|
||
if DrawInBuffer then
|
||
FillPolygon(points, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure FillPolygon(params points: array of (integer, integer));
|
||
begin
|
||
var pnts := points.Select(p -> Pnt(p[0], p[1]));
|
||
FillPolygon(pnts.ToArray);
|
||
end;
|
||
|
||
procedure Polygon(points: array of Point);
|
||
begin
|
||
if Brush.NETBrush <> nil then
|
||
FillPolygon(points);
|
||
if Pen.NETPen.DashStyle <> DashStyle.Custom then
|
||
DrawPolygon(points);
|
||
end;
|
||
|
||
procedure Polygon(params points: array of (integer, integer));
|
||
begin
|
||
var pnts := points.Select(p -> Pnt(p[0], p[1]));
|
||
Polygon(pnts.ToArray);
|
||
end;
|
||
|
||
procedure Polyline(points: array of Point);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
Polyline(points, gr);
|
||
if DrawInBuffer then
|
||
Polyline(points, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Polyline(params points: array of (integer, integer));
|
||
begin
|
||
var pnts := points.Select(p -> Pnt(p[0], p[1]));
|
||
Polyline(pnts.ToArray);
|
||
end;
|
||
|
||
procedure Curve(points: array of Point);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
Curve(points, gr);
|
||
if DrawInBuffer then
|
||
Curve(points, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure Curve(params points: array of (integer, integer));
|
||
begin
|
||
var pnts := points.Select(p -> Pnt(p[0], p[1]));
|
||
Curve(pnts.ToArray);
|
||
end;
|
||
|
||
procedure DrawClosedCurve(points: array of Point);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
DrawClosedCurve(points, gr);
|
||
if DrawInBuffer then
|
||
DrawClosedCurve(points, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure DrawClosedCurve(params points: array of (integer, integer));
|
||
begin
|
||
var pnts := points.Select(p -> Pnt(p[0], p[1]));
|
||
DrawClosedCurve(pnts.ToArray);
|
||
end;
|
||
|
||
procedure FillClosedCurve(points: array of Point);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
FillClosedCurve(points, gr);
|
||
if DrawInBuffer then
|
||
FillClosedCurve(points, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure FillClosedCurve(params points: array of (integer, integer));
|
||
begin
|
||
var pnts := points.Select(p -> Pnt(p[0], p[1]));
|
||
FillClosedCurve(pnts.ToArray);
|
||
end;
|
||
|
||
procedure ClosedCurve(points: array of Point);
|
||
begin
|
||
Monitor.Enter(f);
|
||
if NotLockDrawing then
|
||
ClosedCurve(points, gr);
|
||
if DrawInBuffer then
|
||
ClosedCurve(points, gbmp);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure ClosedCurve(params points: array of (integer, integer));
|
||
begin
|
||
var pnts := points.Select(p -> Pnt(p[0], p[1]));
|
||
ClosedCurve(pnts.ToArray);
|
||
end;
|
||
|
||
// Fills
|
||
procedure FloodFill(x, y: integer; c: Color);
|
||
var
|
||
hdc, hBrush, hOldBrush: IntPtr;
|
||
begin
|
||
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);
|
||
|
||
var bc := ColorTranslator.ToWin32(borderColor);
|
||
var cc := ColorTranslator.ToWin32(c);
|
||
|
||
Monitor.Enter(f);
|
||
|
||
hdc := gr.GetHDC();
|
||
hBrush := CreateSolidBrush(cc);
|
||
|
||
hOldBrush := SelectObject(hdc, hBrush);
|
||
ExtFloodFill(hdc, x, y, bc, 1);
|
||
SelectObject(hdc, holdBrush);
|
||
|
||
var hbmp := bmp.GetHbitmap(); // Создается GDI Bitmap
|
||
var memdc: IntPtr := CreateCompatibleDC(hdc);
|
||
SelectObject(memdc, hbmp);
|
||
|
||
hOldBrush := SelectObject(memdc, hBrush);
|
||
ExtFloodFill(memdc, x, y, bc, 1);
|
||
SelectObject(hdc, holdBrush);
|
||
|
||
var bmp1 := Bitmap.FromHbitmap(hbmp);
|
||
gbmp.DrawImage(bmp1, 0, 0);
|
||
|
||
bmp1.Dispose();
|
||
// bmp := Bitmap.FromHbitmap(hbmp);
|
||
|
||
DeleteObject(memdc);
|
||
DeleteObject(hbmp);
|
||
DeleteObject(hBrush);
|
||
|
||
gr.ReleaseHdc();
|
||
|
||
DeleteObject(hdc);
|
||
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure FillRect(x1, y1, x2, y2: integer);
|
||
begin
|
||
FillRectangle(x1, y1, x2, y2);
|
||
end;
|
||
|
||
// Colors
|
||
function RGB(r, g, b: byte): Color;
|
||
begin
|
||
Result := System.Drawing.Color.FromArgb(r, g, b);
|
||
end;
|
||
|
||
//------------------------------------------------------------------------------
|
||
// Color from component
|
||
//------------------------------------------------------------------------------
|
||
const
|
||
AlphaBase = $FF000000;
|
||
|
||
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;
|
||
//------------------------------------------------------------------------------
|
||
|
||
function ARGB(a, r, g, b: byte): Color;
|
||
begin
|
||
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;
|
||
end;
|
||
|
||
function clRandom: Color;
|
||
begin
|
||
Result := System.Drawing.Color.FromArgb(255, PABCSystem.Random(255), PABCSystem.Random(255), PABCSystem.Random(255));
|
||
end;
|
||
|
||
function GetRed(c: Color): integer;
|
||
begin
|
||
Result := c.R;
|
||
// Result := (c shr 16) and 255;
|
||
end;
|
||
|
||
function GetGreen(c: Color): integer;
|
||
begin
|
||
Result := c.G;
|
||
// Result := (c shr 8) and 255;
|
||
end;
|
||
|
||
function GetBlue(c: Color): integer;
|
||
begin
|
||
Result := c.B;
|
||
// Result := c and 255;
|
||
end;
|
||
|
||
function GetAlpha(c: Color): integer;
|
||
begin
|
||
Result := c.A;
|
||
end;
|
||
|
||
// Pens
|
||
procedure SetPenColor(c: Color);
|
||
begin
|
||
//if Pen.NETPen.Color <> c then
|
||
lock f do
|
||
Pen.NETPen.Color := c;
|
||
end;
|
||
|
||
function PenColor: Color;
|
||
begin
|
||
Result := Pen.NETPen.Color;
|
||
end;
|
||
|
||
procedure SetPenWidth(Width: integer);
|
||
begin
|
||
lock f do
|
||
begin
|
||
Pen.NETPen.Width := Width;
|
||
_ColorLinePen.Width := Width;
|
||
end;
|
||
end;
|
||
|
||
function PenWidth: integer;
|
||
begin
|
||
Result := round(Pen.NETPen.Width);
|
||
end;
|
||
|
||
procedure SetPenStyle(style: DashStyle);
|
||
begin
|
||
LockGraphics;
|
||
// try
|
||
case style of
|
||
psSolid: Pen.NETPen.DashStyle := DashStyle.Solid;
|
||
psClear: Pen.NETPen.DashStyle := DashStyle.Custom;
|
||
psDash: Pen.NETPen.DashStyle := DashStyle.Dash;
|
||
psDot: Pen.NETPen.DashStyle := DashStyle.Dot;
|
||
psDashDot: Pen.NETPen.DashStyle := DashStyle.DashDot;
|
||
psDashDotDot: Pen.NETPen.DashStyle := DashStyle.DashDotDot;
|
||
end;
|
||
{ except
|
||
on e: System.InvalidOperationException do
|
||
writeln(e);
|
||
end;}
|
||
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;
|
||
DashStyle.DashDotDot: Result := psDashDotDot;
|
||
DashStyle.Custom: Result := psClear;
|
||
end;
|
||
end;
|
||
|
||
procedure SetPenMode(m: integer);
|
||
begin
|
||
// TODO
|
||
end;
|
||
|
||
function PenMode: integer;
|
||
begin
|
||
result := -1;
|
||
// TODO
|
||
end;
|
||
|
||
|
||
//2015.01>
|
||
procedure SetPenRoundCap(isRoundCap: boolean);
|
||
var
|
||
lCap: LineCap;
|
||
begin
|
||
if isRoundCap then
|
||
lCap := LineCap.Round
|
||
else
|
||
lCap := LineCap.Flat;
|
||
lock f do
|
||
begin
|
||
Pen.NETPen.StartCap := lCap;
|
||
Pen.NETPen.EndCap := lCap;
|
||
end;
|
||
end;
|
||
|
||
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
|
||
CurrentHatchBrush := new HatchBrush(CurrentHatchBrush.HatchStyle, c, CurrentHatchBrush.BackgroundColor);
|
||
Brush.NETBrush := CurrentHatchBrush;
|
||
end
|
||
else
|
||
begin
|
||
// try
|
||
CurrentSolidBrush.Color := c;
|
||
{ except
|
||
on e: System.InvalidOperationException do
|
||
writeln(e.StackTrace);
|
||
end;}
|
||
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
|
||
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;
|
||
CurrentHatchBrush := new HatchBrush(HatchStyle(bh), CurrentHatchBrush.ForegroundColor, CurrentHatchBrush.BackgroundColor);
|
||
if flag then
|
||
Brush.NETBrush := CurrentHatchBrush;
|
||
end;
|
||
end;
|
||
|
||
function BrushHatch: HatchStyle;
|
||
begin
|
||
Result := CurrentHatchBrush.HatchStyle;
|
||
end;
|
||
|
||
procedure SetHatchBrushBackgroundColor(c: Color);
|
||
var
|
||
flag: boolean;
|
||
begin
|
||
lock f do
|
||
begin
|
||
flag := CurrentHatchBrush = Brush.NETBrush;
|
||
CurrentHatchBrush := new HatchBrush(CurrentHatchBrush.HatchStyle, CurrentHatchBrush.ForegroundColor, c);
|
||
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
|
||
Font.NETFont := new System.Drawing.Font(Font.NETFont.Name, Convert.ToSingle(size), Font.NETFont.Style);
|
||
end;
|
||
|
||
function FontSize: integer;
|
||
begin
|
||
Result := round(Font.NETFont.SizeInPoints);
|
||
end;
|
||
|
||
procedure SetFontName(name: string);
|
||
begin
|
||
lock f do
|
||
Font.NETFont := new System.Drawing.Font(name, Font.NETFont.SizeInPoints, Font.NETFont.Style);
|
||
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
|
||
Font.NETFont := new System.Drawing.Font(Font.NETFont.name, Font.NETFont.SizeInPoints, System.Drawing.FontStyle(integer(fs)));
|
||
end;
|
||
|
||
function FontStyle: FontStyleType;
|
||
begin
|
||
Result := FontStyleType(integer(Font.NETFont.Style));
|
||
end;
|
||
|
||
function TextWidth(s: string): integer;
|
||
begin
|
||
// добавил 1. Без нее рисует, занимая 1 лишний пиксел
|
||
Result := round(gr.MeasureString(s, Font.NETFont, 0, sf).Width) + 1;
|
||
end;
|
||
|
||
function TextHeight(s: string): integer;
|
||
begin
|
||
Result := round(gr.MeasureString(s, Font.NETFont).Height);
|
||
end;
|
||
|
||
// Window
|
||
procedure ClearWindow;
|
||
begin
|
||
ClearWindow(clWhite);
|
||
end;
|
||
|
||
procedure ClearWindow(c: Color);
|
||
var
|
||
i: Color;
|
||
begin
|
||
Monitor.Enter(f);
|
||
i := BrushColor;
|
||
SetBrushColor(c);
|
||
var m := gr.Transform;
|
||
gr.ResetTransform;
|
||
gbmp.ResetTransform;
|
||
FillRect(0, 0, GraphABCControl.Width, GraphABCControl.Height);
|
||
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
|
||
Result := new Point(WindowWidth div 2, WindowHeight div 2);
|
||
end;
|
||
|
||
function WindowIsFixedSize: boolean;
|
||
begin
|
||
Result := (MainForm.FormBorderStyle = FormBorderStyle.FixedSingle) and (MainForm.MaximizeBox = False);
|
||
end;
|
||
|
||
function WindowWidth: integer;
|
||
begin
|
||
// Result := MainForm.ClientSize.Width;
|
||
Result := f.Width;
|
||
end;
|
||
|
||
function WindowHeight: integer;
|
||
begin
|
||
// Result := MainForm.ClientSize.Height;
|
||
Result := f.Height;
|
||
end;
|
||
|
||
procedure SetWindowWidth(w: integer);
|
||
begin
|
||
// SetWindowSize(w,MainForm.ClientSize.Height);
|
||
SetWindowSize(w, WindowHeight);
|
||
end;
|
||
|
||
procedure SetWindowHeight(h: integer);
|
||
begin
|
||
// SetWindowSize(MainForm.ClientSize.Width,h);
|
||
SetWindowSize(WindowWidth, h);
|
||
end;
|
||
|
||
procedure SetWindowLeft(l: integer);
|
||
begin
|
||
SetWindowPos(l, MainForm.Top);
|
||
end;
|
||
|
||
procedure SetWindowTop(t: integer);
|
||
begin
|
||
SetWindowPos(MainForm.Left, t);
|
||
end;
|
||
|
||
procedure SetMaximizeBoxInternal(b: boolean);
|
||
begin
|
||
MainForm.MaximizeBox := b;
|
||
end;
|
||
|
||
procedure SetBorderStyleInternal(st: FormBorderStyle);
|
||
begin
|
||
MainForm.FormBorderStyle := st;
|
||
end;
|
||
|
||
procedure SetWindowIsFixedSize(b: boolean);
|
||
var
|
||
p: Proc1Boolean;
|
||
q: Proc1BorderStyle;
|
||
begin
|
||
p := SetMaximizeBoxInternal;
|
||
q := SetBorderStyleInternal;
|
||
if b then
|
||
MainForm.Invoke(q, FormBorderStyle.FixedSingle)
|
||
else MainForm.Invoke(q, FormBorderStyle.Sizable);
|
||
MainForm.Invoke(p, not b);
|
||
end;
|
||
|
||
procedure ChangeFormPos(l, t: integer);// вспомогательная
|
||
begin
|
||
MainForm.Left := l;
|
||
MainForm.Top := t;
|
||
end;
|
||
|
||
procedure SetWindowPos(l, t: integer);
|
||
begin
|
||
f.Invoke(ChangeFormPos, l, t);
|
||
end;
|
||
|
||
procedure ChangeFormClientSize(w, h: integer);// вспомогательная
|
||
begin
|
||
MainForm.ClientSize := new System.Drawing.Size(w, h);
|
||
ResizeHelper;
|
||
end;
|
||
|
||
procedure SetWindowSize(w, h: integer);
|
||
begin
|
||
f.Invoke(ChangeFormClientSize, w, h);
|
||
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;
|
||
|
||
procedure InitWindow(Left, Top, Width, Height: integer; BackColor: Color);
|
||
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
|
||
f.Invoke(ChangeFormTitle, s);
|
||
end;
|
||
|
||
procedure SetWindowCaption(s: string);
|
||
begin
|
||
SetWindowTitle(s);
|
||
end;
|
||
|
||
procedure SaveWindow(fname: string);
|
||
begin
|
||
var tempbmp := GetView(bmp, new System.Drawing.Rectangle(0, 0, Window.Width, Window.Height));
|
||
tempbmp.Save(fname);
|
||
tempbmp.Dispose;
|
||
end;
|
||
|
||
procedure LoadWindow(fname: string);
|
||
//2015.01>
|
||
var
|
||
b: Bitmap;
|
||
tmp: Image;
|
||
fs: System.IO.FileStream;
|
||
//2015.01<
|
||
begin
|
||
//2015.01>
|
||
// var b: Bitmap := new Bitmap(fname);
|
||
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;
|
||
except
|
||
on ex: System.ArgumentException do
|
||
raise new System.IO.FileNotFoundException(string.Format(FILE_NOT_FOUND_MESSAGE, fname));
|
||
end;
|
||
//2015.01<
|
||
SetWindowSize(b.Width, b.Height);
|
||
Monitor.Enter(f);
|
||
gr.DrawImage(b, 0, 0);
|
||
gbmp.DrawImage(b, 0, 0);
|
||
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));
|
||
FillRect(0, 0, GraphABCControl.Width, GraphABCControl.Height);
|
||
Brush.NETBrush := b;
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure CloseWindow;
|
||
begin
|
||
// MainForm.Close;
|
||
Halt;
|
||
end;
|
||
|
||
var scale: real := -1;
|
||
|
||
function ScreenScale: real;
|
||
begin
|
||
if scale <= 0 then
|
||
try
|
||
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) := (System.Windows.SystemParameters.PrimaryScreenWidth,System.Windows.SystemParameters.PrimaryScreenHeight);
|
||
Result := new System.Drawing.Size(Round(w*ScreenScale),Round(h*ScreenScale))
|
||
end;
|
||
|
||
function ScreenWidth: integer;
|
||
begin
|
||
Result := Round(Screen.PrimaryScreen.Bounds.Width);
|
||
end;
|
||
|
||
function ScreenHeight: integer;
|
||
begin
|
||
Result := Round(Screen.PrimaryScreen.Bounds.Height);
|
||
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;
|
||
var
|
||
tempbmp: Bitmap;
|
||
begin
|
||
if IsUnix then
|
||
exit;
|
||
//TODO Без этого падает если свернуто
|
||
if MainForm.WindowState = FormWindowState.Minimized then
|
||
exit;
|
||
tempbmp := GetView(bmp, new System.Drawing.Rectangle(0, 0, WindowWidth, WindowHeight));
|
||
tempbmp.SetResolution(gr.DpiX, gr.DpiY);
|
||
Monitor.Enter(f);
|
||
if gr <> nil then
|
||
begin
|
||
var m := gr.Transform;
|
||
gr.ResetTransform;
|
||
gr.DrawImage(tempbmp, 0, 0);
|
||
gr.Transform := m;
|
||
end;
|
||
Monitor.Exit(f);
|
||
tempbmp.Dispose();
|
||
end;
|
||
|
||
procedure FullRedraw;
|
||
begin
|
||
if IsUnix then
|
||
exit;
|
||
Monitor.Enter(f);
|
||
if gr <> nil then
|
||
gr.DrawImage(bmp, 0, 0);
|
||
Monitor.Exit(f);
|
||
end;
|
||
|
||
procedure LockDrawing;
|
||
begin
|
||
if IsUnix then
|
||
exit;
|
||
NotLockDrawing := False;
|
||
end;
|
||
|
||
procedure UnlockDrawing;
|
||
begin
|
||
NotLockDrawing := True;
|
||
Redraw;
|
||
end;
|
||
|
||
function RobotUnitUsed: boolean;
|
||
var
|
||
t: &Type;
|
||
begin
|
||
t := System.Reflection.Assembly.GetExecutingAssembly.GetType('Robot.Robot');
|
||
if t = nil then
|
||
result := false
|
||
else
|
||
result := t.GetField('__IS_ROBOT_UNIT') <> nil;
|
||
end;
|
||
|
||
procedure HideForm;
|
||
begin
|
||
_MainForm.Hide;
|
||
end;
|
||
|
||
procedure CreatePicture(var p: Picture; w, h: integer);
|
||
begin
|
||
p := new Picture(w, h);
|
||
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;
|
||
|
||
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;
|
||
|
||
procedure GraphABCWindow.SetSize(w, h: integer);
|
||
begin
|
||
SetWindowSize(w, h)
|
||
end;
|
||
|
||
procedure GraphABCWindow.SetPos(l, t: integer);
|
||
begin
|
||
SetWindowPos(l, t)
|
||
end;
|
||
|
||
procedure GraphABCWindow.Init(Left, Top, Width, Height: integer; BackColor: Color);
|
||
begin
|
||
InitWindow(Left, Top, Width, Height, BackColor);
|
||
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;
|
||
|
||
function Rect(x1, y1, x2, y2: integer): System.Drawing.Rectangle;
|
||
begin
|
||
Result := new System.Drawing.Rectangle(x1, y1, x2 - x1, y2 - y1);
|
||
end;
|
||
|
||
function ClientRectangle: System.Drawing.Rectangle;
|
||
begin
|
||
Result := MainForm.ClientRectangle
|
||
end;
|
||
|
||
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));
|
||
end;
|
||
|
||
procedure Draw(f: real-> real; a, b, min, max: real; x1, y1, x2, y2: integer);
|
||
begin
|
||
var coefx := (x2 - x1) / (b - a);
|
||
var coefy := (y2 - y1) / (max - min);
|
||
|
||
Pen.Color := Color.Black;
|
||
Rectangle(x1, y1, x2 + 1, y2 + 1);
|
||
|
||
var fso := new FS(coefx, coefy, a, min, max, x1, y1, f);
|
||
|
||
// Линии
|
||
{Pen.Color := Color.LightGray;
|
||
|
||
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;
|
||
|
||
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;
|
||
|
||
yy := -hy;
|
||
while yy>min do
|
||
begin
|
||
var y0 := fso.RealToScreenY(yy);
|
||
Line(x1,y0,x2,y0);
|
||
yy -= hy
|
||
end;
|
||
|
||
// Оси
|
||
Pen.Color := Color.Blue;
|
||
|
||
var x0 := fso.RealToScreenX(0);
|
||
var y0 := fso.RealToScreenY(0);
|
||
|
||
Line(x0,y1,x0,y2);
|
||
Line(x1,y0,x2,y0);}
|
||
|
||
// График
|
||
|
||
Pen.Color := Color.Black;
|
||
var n := (x2 - x1) div 3;
|
||
Polyline(PartitionPoints(a, b, n).Select(fso.Apply).ToArray);
|
||
end;
|
||
|
||
procedure Draw(f: real-> real; a, b, min, max: real; r: System.Drawing.Rectangle);
|
||
var
|
||
x1 := r.X; y1 := r.Y;
|
||
x2 := r.X + r.Width - 1;
|
||
y2 := r.Y + r.Height - 1;
|
||
begin
|
||
Draw(f, a, b, min, max, x1, y1, x2, y2);
|
||
end;
|
||
|
||
procedure Draw(f: real-> real; a, b, min, max: real);
|
||
begin
|
||
Draw(f, a, b, min, max, ClientRectangle);
|
||
end;
|
||
|
||
procedure Draw(f: real-> real; a, b: real; x1, y1, x2, y2: integer);
|
||
begin
|
||
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)
|
||
end;
|
||
|
||
procedure Draw(f: real-> real; a, b: real; r: System.Drawing.Rectangle);
|
||
var
|
||
x1 := r.X; y1 := r.Y;
|
||
x2 := r.X + r.Width - 1;
|
||
y2 := r.Y + r.Height - 1;
|
||
begin
|
||
Draw(f, a, b, x1, y1, x2, y2);
|
||
end;
|
||
|
||
procedure Draw(f: real-> real; r: System.Drawing.Rectangle);
|
||
begin
|
||
Draw(f, -5, 5, r);
|
||
end;
|
||
|
||
procedure Draw(f: real-> real; a, b: real);
|
||
var
|
||
x1 := 0; y1 := 0;
|
||
x2 := Window.Width - 1;
|
||
y2 := Window.Height - 1;
|
||
begin
|
||
Draw(f, a, b, x1, y1, x2, y2);
|
||
end;
|
||
|
||
procedure Draw(f: real-> real);
|
||
begin
|
||
Draw(f, -5, 5);
|
||
end;
|
||
|
||
var
|
||
dpic := new Dictionary<string, Picture>;
|
||
|
||
procedure Draw(fname: string; x, y: integer);
|
||
begin
|
||
if not dpic.ContainsKey(fname) then
|
||
dpic[fname] := new Picture(fname);
|
||
dpic[fname].Draw(x, y);
|
||
end;
|
||
|
||
procedure Draw(fname: string; x, y, w, h: integer);
|
||
begin
|
||
if not dpic.ContainsKey(fname) then
|
||
dpic[fname] := new Picture(fname);
|
||
dpic[fname].Draw(x, y, w, h);
|
||
end;
|
||
|
||
procedure Draw(fname: string; x, y: integer; Scale: real);
|
||
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);
|
||
dpic[fname].Draw(x, y, w, h);
|
||
end;
|
||
|
||
var
|
||
firstcall := True;
|
||
|
||
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;
|
||
e.SuppressKeyPress := true;
|
||
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);
|
||
|
||
f := new ABCControl(defaultWindowWidth, defaultWindowHeight);
|
||
_MainForm := new Form;
|
||
_MainForm.Text := 'GraphABC.NET';
|
||
_MainForm.ClientSize := new Size(defaultWindowWidth, defaultWindowHeight);
|
||
_MainForm.BackColor := Color.White;
|
||
_MainForm.Controls.Add(f);
|
||
//_MainForm.TopMost := True;
|
||
_MainForm.StartPosition := FormStartPosition.CenterScreen;
|
||
_MainForm.FormClosing += f.OnClosing;
|
||
// Поле ввода
|
||
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;
|
||
IOPanel.Size := new Size(defaultWindowWidth, ed.Height);
|
||
IOPanel.Controls.Add(ed);
|
||
IOPanel.Controls.Add(EnterButton);
|
||
_MainForm.KeyPreview := True;
|
||
_MainForm.KeyDown += ReadlnTextBoxKeyDown;
|
||
_MainForm.Controls.Add(IOPanel);
|
||
|
||
gr := Graphics.FromHwnd(f.Handle);
|
||
|
||
//if (System.Environment.OSVersion.Version.Major >= 6) then SetProcessDPIAware();
|
||
InitBMP;
|
||
|
||
end;
|
||
|
||
procedure InitForm0;
|
||
begin
|
||
InitForm;
|
||
StartIsComplete := True;
|
||
Application.Run(MainForm);
|
||
end;
|
||
|
||
procedure InitGraphABC;
|
||
begin
|
||
if not firstcall then exit;
|
||
sf := new StringFormat(StringFormat.GenericTypographic);
|
||
sf.FormatFlags := StringFormatFlags.MeasureTrailingSpaces;
|
||
firstcall := False;
|
||
clMoneyGreen := RGB(192, 220, 192);
|
||
StartIsComplete := False;
|
||
MainFormThread := new System.Threading.Thread(InitForm0);
|
||
MainFormThread.Start;
|
||
while not StartIsComplete do
|
||
Sleep(30);
|
||
Sleep(30);
|
||
SetSmoothingOn;
|
||
_GraphABCControl := f;
|
||
CurrentIOSystem := new IOGraphABCSystem;
|
||
end;
|
||
|
||
procedure SetConsoleIO;
|
||
begin
|
||
CurrentIOSystem := new IOStandardSystem;
|
||
end;
|
||
|
||
procedure SetGraphABCIO;
|
||
begin
|
||
CurrentIOSystem := new IOGraphABCSystem;
|
||
end;
|
||
|
||
procedure __InitModule;
|
||
begin
|
||
MainThread := Thread.CurrentThread;
|
||
InitGraphABC;
|
||
end;
|
||
|
||
var
|
||
__initialized := false;
|
||
|
||
procedure __InitModule__;
|
||
begin
|
||
if not __initialized then
|
||
begin
|
||
__initialized := true;
|
||
GraphABCHelper.__InitModule__;
|
||
__InitModule;
|
||
end;
|
||
end;
|
||
|
||
initialization
|
||
__InitModule;
|
||
finalization
|
||
// Application.Run(MainWindow);
|
||
end. |