TestSuite/CompilationSamples/Coords.pas - master - n-dimens/pascalabcnet

TestSuite/CompilationSamples/Coords.pas
768 строк24 KB
Mikhalkovich Stanislav
3.11.0.3671
15 окт 2025, 18:51
15 окт 2025, 18:51c33a0ce
/// Координатная сетка с возможностью масштабирования мышью
unit Coords;

uses GraphWPFBase;
uses GraphWPF;
uses System.Threading.Tasks;

type
  Globals = static class
    static PointRadius: real := 2.0;
    static LineWidth: real := 1.0;
    static FontBackgroundColor: Color := Colors.Transparent;
    static FontBorderWidth: real := 1.0;
  end;

type 
  Colors = GraphWPF.Colors;
  Point = System.Windows.Point;
  Alignment = GraphWPF.Alignment;
  Command = class
    procedure Play(dc: DrawingContext); abstract;
    function AddToListAndPlay: Command;
  end;
  TypeFace = System.Windows.Media.Typeface;
  FormattedText = System.Windows.Media.FormattedText;
  
var 
// Команды для "проигрывания" при перерисовке (изменении масштаба и сдвиге)
  Commands := new List<Command>;

function Command.AddToListAndPlay: Command;
begin
  Commands.Add(Self);
  FastDraw(dc -> Self.Play(dc));
  Result := Self;
end;

const InitialPenWidth = 1.4;

var 
  CurrentPen := ColorPen(Colors.Black,InitialPenWidth); // Для LineTo
  
  CurrentFontFace := new Typeface('Arial');

  Palette: array of Color := Arr(Colors.Green, Colors.Blue, Colors.Red, Colors.Orange, 
    Colors.Magenta, Colors.LightGreen, Colors.LightBlue, Colors.Coral, Colors.Gray, Colors.LightGray);
  PaletteIndex := 0;
  
function Pnt(x,y: real): Point := GraphWPF.Pnt(x,y);

function CurrentPenColor: Color 
  := (CurrentPen.Brush as System.Windows.Media.SolidColorBrush).Color;

function CurrentPenWidth: real := CurrentPen.Thickness;

{$region Класс координатной сетки FS}

var MinLen := 25;

// Сделаем в логических координатах fso.LineToReal, fso.MoveToReal, fso.CircleReal
type
  FS = class
    // origin - точка по центру графика в логических координатах
    origin: Point; 
    // scale - количество пикселей на одну единицу
    scale: real; 
    mx, my: real;
    a, b, min, max: real; // реальные координаты [a.b] x [min,max]
    x, y, w, h: real; // экранные координаты - левый верхний угол, ширина и высота
    // XTicks, YTicks - сколько логических единиц занимает одно деление (по умолчанию 1) 
    XTicks, YTicks: real; 
    // XTicks = YTicks = FindP(Scale)/Scale
    // Ticks будет меняться по стратегии: 0.1 0.2 0.5 1 2 5 10
    MarginY := 6;
    MarginX := 6;
    XTicksPrecision := 4;
    YTicksPrecision := 5;
    spaceBetweenTextAndGraph := 0;
    
    constructor (scale, x, y, w, h: real; origin: Point := Pnt(0,0));
    begin
      Self.Scale := scale;
      Self.x := x; Self.y := y; Self.w := w; Self.h := h; 
      Self.origin := origin;
      CorrectBounds; 
    end;
    
    function PointInside(p: Point): boolean;
    begin
      Result := (p.X >= a) and (p.X <= b) and (p.Y >= min) and (p.Y <= max);
    end;
    
    function FindP(Scale: real): real;
    begin // MinLen = 25 - то самое число
      var p := Scale;
      if p < MinLen then
        while p < MinLen do
          p *= 10
      else begin
        while p >= MinLen * 10 do
          p /= 10;
      end;
      // p in [MinLen..MinLen * 10)
      if p >= MinLen * 5 then
        p /= 5
      else if p >= MinLen *2 then
        p /= 2;
      Result := p;
    end;
    
    procedure CorrectBounds;
    begin
      mx := Scale;
      my := Scale;
      a := -w/2/mx;
      b := -a;
      max := h/2/my;
      min := - max;
      
      XTicks := FindP(Scale)/Scale;
      YTicks := XTicks;

      var th := TextHeightP('0'); // высота текста
      // tw - ширина текста - максимум по всем числам
      var RY0 := GetRY0; // самое маленькое логическое значение по y. Соответствует нижней части экрана
      var tw := RY0.Step(YTicks).TakeWhile(ry -> ry <= max + origin.y)
        .Select(y -> TextWidthP(y.Round(YTicksPrecision).ToString)).DefaultIfEmpty.Max;
      if tw = 0 then
        tw := TextWidthP('0');  
      var dd := TextWidthP(b.Round(xTicksPrecision).ToString)/2;
      // dd - это половинка ширины последней цифры
      //var tw := TextWidth('-99.9');
      w -= {MarginX * 2 +} spaceBetweenTextAndGraph + tw + dd;
      h -= MarginY * 2 + spaceBetweenTextAndGraph + th;
      x += MarginX + spaceBetweenTextAndGraph + tw; 
      y += MarginY;
      
      // И ещё раз пересчитаем!
      a := -w/2/mx;
      b := -a;
      max := h/2/my;
      min := - max;
      
      XTicks := FindP(Scale)/Scale;
      YTicks := XTicks;
    end;
    
    // a,b,min,max - логические
    function RealToScreenX(xx: real) := x + mx * (xx - origin.x - a);
    function RealToScreenY(yy: real) := y + h - my * (yy - origin.y - min); // ?
    function ScreenToRealX(xx: real) := (xx - x) / mx + a + origin.x;
    function ScreenToRealY(yy: real) := (y + h - yy) / my + min + origin.y;
    function ScreenToReal(p: Point): Point := Pnt(ScreenToRealX(p.X),ScreenToRealY(p.Y));
    function RealToScreen(p: Point): Point := Pnt(RealToScreenX(p.X),RealToScreenY(p.Y));
    
    /// Самое маленькое логическое значение по x
    function GetRX0: real;
    begin
      var xt := XTicks * Trunc(Abs(a + origin.x)/XTicks);
      var rx0: real; 
      if a + origin.x <= 0 then 
        rx0 := -xt 
      else rx0 := xt + XTicks;
      Result := rx0;
    end;
    
    /// Самое маленькое логическое значение по y
    function GetRY0: real;
    begin
      var yt: real := YTicks * Trunc(Abs(min + origin.y)/YTicks);
      var ry0: real;
      if min + origin.y <= 0 then 
        ry0 := -yt 
      else ry0 := yt + YTicks;
      Result := ry0;
    end;

    procedure DrawDC(dc: DrawingContext);
    begin
      var AxisColor := GrayColor(112);
      var GridPen := ColorPen(Colors.LightGray,1);
      var AxisPen := ColorPen(AxisColor,1);

      var stepx := mx * XTicks; // Экранный шаг по оси x
      var rx0 := GetRX0; // реальная начальная координата по x. При запуске = 14
      var x0 := RealToScreenX(rx0); // Экранная начальная координата по x. 
      
      // ширина надписи по оси ox
      var www := PABCSystem.max(TextWidthP(rx0.Round(XTicksPrecision).ToString),
                   TextWidthP((rx0+XTicks).Round(XTicksPrecision).ToString)) + 3;
      var numTicks := Trunc(w / 2 / stepx);
                   
      var it := 0;
      if numTicks.IsEven then
        it += 1;

      while x0<=x+w+0.000001 do
      begin
        if Abs(rx0)<0.000001 then
          dc.DrawLine(AxisPen,Pnt(x0,y),Pnt(x0,y+h))
        else dc.DrawLine(GridPen,Pnt(x0,y),Pnt(x0,y+h));
        var text := rx0.Round(XTicksPrecision).ToString;
        if (www <= stepx) or (it mod 2 = 1) then
          TextOutDC(dc,x0,y+h+4,text,Alignment.CenterTop);
        x0 += stepx;
        rx0 += XTicks;
        it += 1;
      end;
      
      var stepy := my * YTicks;
      var ry0 := GetRY0;
      var y0 := RealToScreenY(ry0);
      
      while y0>=y-0.000001 do
      begin
        if Abs(ry0)<0.000001 then
          DrawLineDC(dc,x,y0,x+w,y0,AxisPen)
        else DrawLineDC(dc,x,y0,x+w,y0,GridPen);  
        TextOutDC(dc,x-4,y0,ry0.Round(YTicksPrecision).ToString,Alignment.RightCenter);
        y0 -= stepy;
        ry0 += YTicks;
      end;
      
      DrawRectangleDC(dc, x, y, w, h, nil, ColorPen(Colors.Black,1));
    end;
    
    // Рисование координат
    procedure Draw := FastDraw(DrawDC);
    
    // Рисование точек в целочисленных координатах. Специфический метод системы координат
    procedure DrawPoints := FastDraw(dc -> begin
      var sz := 1.2;
      if Scale < 10 then
        exit;
      var a := ScreenToRealX(x); var b := ScreenToRealX(x+w);
      var min := ScreenToRealY(y+h); var max := ScreenToRealY(y);
      for var x := Ceil(a) to Floor(b) do
      for var y := Ceil(min) to Floor(max) do
      begin
        var p := RealToScreen(Pnt(x,y));
        dc.DrawEllipse(ColorBrush(Colors.Black),nil,p,sz,sz);
      end;
    end);
  end;
  
const Scale0 = 27.1;
  
{$endregion}  

// Переменные для системы координат
var 
  Scale := Scale0;
  Origin := Pnt(0,0);

var  
  // Система координат  
  fso: FS;

// Вспомогательная переменная для задачи перерисовки
var tsk: System.Threading.Tasks.Task := nil; // Задача для перерисовки. В каждый момент одна

var RusCultureInfo := new System.Globalization.CultureInfo('ru-ru');

function FormText(text: string; size: real := 14; color: GColor := Colors.Black): FormattedText := 
  new FormattedText(text, RusCultureInfo, System.Windows.FlowDirection.LeftToRight, 
    CurrentFontFace, size, Brushes.Black);

function FormTextWithName(text: string; FontName: string := 'Arial'; size: real := 14; color: GColor := Colors.Black): FormattedText := 
  new FormattedText(text, RusCultureInfo, System.Windows.FlowDirection.LeftToRight, 
    new Typeface(FontName), size, Brushes.Black);

{$region Команды при "проигрывании"}
var PointRadius := 2.0;

var x := FormText('sdfgh');

procedure PointPlay(dc: DrawingContext; x,y: real; c: GColor; PointRadius: real);
begin
  if PointRadius = -1 then
    PointRadius := Globals.PointRadius;
  var p := fso.RealToScreen(Pnt(x,y));
  dc.DrawEllipse(ColorBrush(c),nil,p,PointRadius,PointRadius);
end;  

procedure PointsPlay(dc: DrawingContext; points: array of Point; c: GColor; PointRadius: real);
begin
  if PointRadius = -1 then
    PointRadius := Globals.PointRadius;
  var cc := ColorBrush(c);
  foreach var p in points do
  begin  
    var pp := fso.RealToScreen(p);
    dc.DrawEllipse(cc,nil,pp,PointRadius,PointRadius);
  end;  
end;

procedure LineToPlay(dc: DrawingContext; x,y: real);
begin
  var p := fso.RealToScreen(Pnt(x,y));
  dc.DrawLine(CurrentPen,Pnt(Pen.X,Pen.Y),p);
  GraphWPF.MoveTo(p.X,p.Y);
end;

procedure CirclePlay(dc: DrawingContext; x,y,r: real; c: Color; borderc: Color);
begin
  var cb := ColorBrush(c);
  var cp := ColorPen(borderc,CurrentPenWidth);
  var p := fso.RealToScreen(Pnt(x,y));
  r := r * Scale;
  dc.DrawEllipse(cb,cp,p,r,r);
end;

procedure ArcPlay(dc: DrawingContext; x,y,r,startAngle,endAngle: real; c: Color);
begin
  var cp := ColorPen(c,CurrentPenWidth);
  var center := fso.RealToScreen(Pnt(x,y));
  r := r * Scale;
  
  var geometry := new System.Windows.Media.StreamGeometry();
  var context := geometry.Open();
  var startAngleRad := startAngle * PI / 180;
  var endAngleRad := endAngle * PI / 180;
  var startPoint := new Point(
    center.X + r * Cos(startAngleRad),
    center.Y - r * Sin(startAngleRad)
  );
  var endPoint := new Point(
    center.X + r * Cos(endAngleRad),
    center.Y - r * Sin(endAngleRad)
  );
            
  context.BeginFigure(startPoint, false, false);
            
  var cw := endAngle - startAngle < 0;
  var dir := System.Windows.Media.SweepDirection.Counterclockwise;
  if cw then
    dir := System.Windows.Media.SweepDirection.Clockwise;
  context.ArcTo(endPoint,
      new System.Windows.Size(r, r),
      0,
      False,
      dir,
      true,
      false
  );
  context.Close;

  dc.DrawGeometry(nil, cp, geometry);
end;


procedure RectanglePlay(dc: DrawingContext; x,y,w,h: real; c: Color; borderc: Color);
begin
  var cb := ColorBrush(c);
  var cp := ColorPen(borderc,CurrentPenWidth);
  var p := fso.RealToScreen(Pnt(x,y));
  w := w * Scale;
  h := h * Scale;
  dc.DrawRectangle(cb,cp,Rect(p.x,p.y,w,h));
end;

procedure LinePlay(dc: DrawingContext; x,y,x1,y1: real; c: Color; Width: real);
begin
  if Width = -1 then
    Width := Globals.LineWidth;
  var cp := ColorPen(c,Width);
  var p := fso.RealToScreen(Pnt(x,y));
  var p1 := fso.RealToScreen(Pnt(x1,y1));
  dc.DrawLine(cp,p,p1);
end;

procedure CorrectXYForTextHelper(var p: Point; w,h: real; Align: Alignment);
begin
  case Align of
    Alignment.LeftTop: {ничего};
    Alignment.LeftCenter: p.y -= h/2;
    Alignment.LeftBottom: p.y -= h;
    Alignment.CenterTop: begin p.x -= w/2 end;
    Alignment.Center: begin p.x -= w/2; p.y -= h/2 end;
    Alignment.CenterBottom: begin p.x -= w/2; p.y -= h end;
    Alignment.RightTop: begin p.x -= w; end;
    Alignment.RightCenter: begin p.x -= w; p.y -= h/2 end;
    Alignment.RightBottom: begin p.x -= w; p.y -= h end;
  end;
end;

procedure TextPlay(dc: DrawingContext; x,y: real; text,fontname: string; size: real; color: GColor; 
  Align: Alignment; unscaled: boolean; backgroundColor: GColor; borderWidth: real);
begin
  if unscaled = False then 
    size := size*Scale/Scale0;
  if size > 30000 then
    size := 30000;
  var p := fso.RealToScreen(Pnt(x,y));
  var ft: FormattedText := 
    fontname = nil ? FormText(text,size,color) : FormTextWithName(text,fontname,size,color);
  var (w,h) := (ft.Width,ft.Height);
  CorrectXYForTextHelper(p,w,h,Align);
  if backgroundColor = Colors.Transparent then
    backgroundColor := Globals.FontBackgroundColor;
  if borderWidth = -1 then
    borderWidth := Globals.FontBorderWidth;
  if backgroundColor <> Colors.Transparent then
    dc.DrawRectangle(ColorBrush(backgroundColor),ColorPen(Colors.Black,borderWidth),Rect(p.x-3,p.y-2,w+6,h+4));
  dc.DrawText(ft,p);
end;


{$endregion}

 
type
  PointC = auto class(Command)
    x,y: real;
    c: Color;
    pointradius: real;
  public  
    procedure Play(dc: DrawingContext); override := PointPlay(dc,x,y,c,pointradius);
  end;
  PointsC = auto class(Command)
    points: array of Point;
    c: Color;
    pointradius: real;
  public  
    procedure Play(dc: DrawingContext); override := PointsPlay(dc,points,c,pointradius);
  end;
  CircleC = auto class(Command)
    x,y,r: real;
    c,borderc: Color;
  public  
    procedure Play(dc: DrawingContext); override := CirclePlay(dc,x,y,r,c,borderc);
  end;
  RectangleC = auto class(Command)
    x,y,w,h: real;
    c,borderc: Color;
  public  
    procedure Play(dc: DrawingContext); override := RectanglePlay(dc,x,y,w,h,c,borderc);
  end;
  LineC = auto class(Command)
    x,y,x1,y1: real;
    c: Color;
    width: real;
  public  
    procedure Play(dc: DrawingContext); override := LinePlay(dc,x,y,x1,y1,c,width);
  end;
  ArcC = auto class(Command)
    x,y,radius,startAngle,endAngle: real;
    c: Color;
  public  
    procedure Play(dc: DrawingContext); override := ArcPlay(dc,x,y,radius,startAngle,endAngle,c);
  end;
  TextC = auto class(Command)
    x,y: real;
    text: string;
    size: real;
    c: Color;
    fontname: string;
    Align: Alignment;
    unscaled: boolean;
    backgroundColor: Color;
    borderWidth: real;
  public  
    procedure Play(dc: DrawingContext); override := TextPlay(dc,x,y,text,fontname,size,c,Align,unscaled,backgroundColor,borderWidth);
  end;

procedure AddCommand(c: Command);
begin
  Commands.Add(c);
end;

{$endregion}

function Window := GraphWPF.Window;

// fso - глобальная и всегда инициализированная!!!
// tp - в логических (это точка Черепахи)

{$region Примитивы рисования, вносимые в список команд}

/// Рисует точку заданным цветом
procedure DrawPoint(x,y: real; Color: GColor := Colors.Black; PointRadius: real := -1)
  := PointC.Create(x,y,color,PointRadius).AddToListAndPlay;

/// Рисует точку заданным цветом
procedure DrawPoint(p: Point; Color: GColor := Colors.Black; PointRadius: real := -1)
  := DrawPoint(p.x,p.y,Color,PointRadius);

/// Рисует прямоугольник
procedure DrawRectangle(x,y,w,h: real; color: GColor := Colors.White; borderColor: GColor := Colors.Black)
  := RectangleC.Create(x,y,w,h,color,borderColor).AddToListAndPlay;

/// Рисует отрезок
procedure DrawLine(x,y,x1,y1: real; Color: GColor := Colors.Black; Width: real := -1)
  := LineC.Create(x,y,x1,y1,color,width).AddToListAndPlay;

/// Рисует отрезок
procedure DrawLine(p1,p2: Point; Color: GColor := Colors.Black; Width: real := -1)
  := DrawLine(p1.x,p1.y,p2.x,p2.y,Color,Width);

/// Рисует прямоугольник без границы
procedure FillRectangle(x,y,w,h: real; Color: GColor := Colors.White)
  := RectangleC.Create(x,y,w,h,color,Colors.Transparent).AddToListAndPlay;

/// Рисует круг
procedure DrawCircle(x,y,r: real; Color: GColor := Colors.White; borderColor: GColor := Colors.Black)
  := CircleC.Create(x,y,r,color,borderColor).AddToListAndPlay;

/// Рисует круг
procedure DrawCircle(p: Point; r: real; Color: GColor := Colors.White; borderColor: GColor := Colors.Black)
  := DrawCircle(p.X,p.Y,r,Color,borderColor);

/// Рисует круг без границы
procedure FillCircle(x,y,r: real; Color: GColor := Colors.White)
  := CircleC.Create(x,y,r,color,Colors.Transparent).AddToListAndPlay;

/// Рисует круг без границы
procedure FillCircle(p: Point; r: real; Color: GColor := Colors.White)
  := FillCircle(p.X,p.Y,r,color);

/// Выводит текст в указанную позицию
procedure DrawText(x,y: real; text: string; Size: real := 14; Color: GColor := Colors.Black; 
  FontName: string := nil; Align: Alignment := Alignment.LeftTop;
  BackgroundColor: GColor := Colors.Transparent; BorderWidth: real := -1);
begin
  TextC.Create(x,y,text,Size,Color,fontname,Align,false,BackgroundColor,BorderWidth).AddToListAndPlay
end;  

/// Выводит текст в указанную позицию
procedure DrawText(p: Point; text: string; Size: real := 14; Color: GColor := Colors.Black; 
  FontName: string := nil; Align: Alignment := Alignment.LeftTop;
  BackgroundColor: GColor := Colors.Transparent; BorderWidth: real := -1);
begin
  DrawText(p.X,p.Y,text,Size,Color,FontName,Align,BackgroundColor,BorderWidth);
end;  

/// Выводит текст в указанную позицию
procedure DrawTextUnscaled(x,y: real; text: string; Size: real := 14; Color: GColor := Colors.Black; 
  FontName: string := nil; Align: Alignment := Alignment.LeftTop;
  BackgroundColor: GColor := Colors.Transparent; BorderWidth: real := -1);
begin
  TextC.Create(x,y,text,Size,Color,fontname,Align,true,BackgroundColor,BorderWidth).AddToListAndPlay
end;  

/// Выводит текст в указанную позицию
procedure DrawTextUnscaled(p: Point; text: string; Size: real := 14; Color: GColor := Colors.Black; 
  FontName: string := nil; Align: Alignment := Alignment.LeftTop;
  BackgroundColor: GColor := Colors.Transparent; BorderWidth: real := -1);
begin
  DrawTextUnscaled(p.X,p.Y,text,Size,Color,FontName,Align,BackgroundColor,BorderWidth);
end;  


/// Рисует точки заданным цветом
procedure DrawPoints(points: array of Point; color: GColor; PointRadius: real := -1)
  := PointsC.Create(points,color,PointRadius).AddToListAndPlay;

/// Рисует точки следующим цветом в палитре цветов
procedure DrawPoints(points: array of Point; PointRadius: real := -1);
begin
  var color := Palette[PaletteIndex];
  PaletteIndex += 1;
  if PaletteIndex >= Palette.Length then
    PaletteIndex := 0;
  DrawPoints(points,color,PointRadius);
end;  

/// Рисует точки заданным цветом
procedure DrawPoints(xx,yy: array of real; color: GColor; PointRadius: real := -1);
begin
  var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray;
  DrawPoints(points,color,PointRadius);
end;  

/// Рисует точки следующим цветом в палитре цветов
procedure DrawPoints(xx,yy: array of real; PointRadius: real := -1);
begin
  var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray;
  DrawPoints(points,PointRadius);
end;

/// Рисует дугу
procedure DrawArc(x,y,r,startAngle,endAngle: real; Color: GColor := Colors.Black)
  := ArcC.Create(x,y,r,startAngle,endAngle,Color).AddToListAndPlay;


/// Расстояние между точками
function Distance(p1,p2: Point): real := Sqrt((p2.x-p1.x)**2 + (p2.y-p1.y)**2);
/// Расстояние между точками
function Distance(x1,y1,x2,y2: real): real := Sqrt((x2-x1)**2 + (y2-y1)**2);

/// Расстояние между точками
function Distance(Self: Point; p2: Point): real; extensionmethod := Distance(Self,p2);

/// Середина отрезка
function Middle(p1,p2: Point): Point := Pnt((p1.X + p2.X)/2, (p1.Y + p2.Y)/2);


{$endregion}

procedure PlayCommands;
begin
  FastDraw(dc -> begin
    dc.PushClip(new System.Windows.Media.RectangleGeometry(Rect(fso.x,fso.y,fso.w,fso.h)));
    foreach var command in commands do
      command.Play(dc);
    dc.Pop;  
  end);  
end;

var DrawCoords := 1;

procedure InitCoordGrid;
begin
  fso := new FS(Scale,0,0,Window.Width,Window.Height,Origin);
  if DrawCoords = 1 then
    fso.Draw
  else if DrawCoords = 2 then
  begin
    fso.Draw;
    fso.DrawPoints;
  end;
end;

var 
  // Процедура дополнительной инициализации для модулей на основе Coords
  InitProc: procedure := nil;

/// Установка положения начала координат 
procedure SetOrigin(x,y: real);
begin
  Origin := Pnt(x,y);
end;

/// Установка масштаба 
procedure SetScale(sc: real); 
begin
  Scale := sc;
  Window.Clear;
  InitCoordGrid;
  if InitProc <> nil then
    InitProc;
end;

procedure Redraw;
begin
  if (tsk <> nil) and not tsk.IsCompleted then
    exit;
  tsk := Task.Run(() -> begin
    GraphWPF.Redraw(()->begin
    Window.Clear;
    InitCoordGrid;
    if InitProc <> nil then
      InitProc;
    PlayCommands;
    end)
  end)
end;

type 
  Handlers = static class
// Вспомогательные переменные для событий
  static StartPoint,MousePoint: Point; 
  static deltaMultScale := 1.2; // на сколько увеличивать-уменьшать при прокручивании колёсика мыши
  static AfterResize := False;
  
  static procedure MouseDown(x,y: real; mb: integer);
  begin
    StartPoint := Pnt(x,y);
  end;
  
  static procedure MouseMove(x,y: real; mb: integer);
  begin
    if AfterResize then
    begin
      AfterResize := False;
      exit;
    end;
    if (tsk<>nil) and not tsk.IsCompleted then
      exit;
    MousePoint := Pnt(x,y);
    if mb<>1 then
      exit;
    var v := fso.ScreenToReal(MousePoint) - fso.ScreenToReal(StartPoint);
    Origin.X -= v.X;
    Origin.Y -= v.Y;
    StartPoint := MousePoint;
    Redraw;
  end;
  
  static procedure MouseWheel(delta: real);
  begin
    if (tsk<>nil) and not tsk.IsCompleted then
      exit;
      
    if delta > 0 then // вверх - увеличение
    begin
      if MinLen/Scale > 0.0001 then
        Scale *= deltaMultScale
      else exit;
      Origin := Origin + (deltaMultScale - 1)/deltaMultScale * (fso.ScreenToReal(mousePoint) - Origin);
    end  
    else 
    begin 
      if MinLen/Scale < 500 then
        Scale /= deltaMultScale
      else exit;  
      Origin := Origin - (deltaMultScale - 1) * (fso.ScreenToReal(mousePoint) - Origin);
    end;
    Redraw; 
  end;
  
  static procedure KeyPress(c: char);
  begin
    if c.ToLower = 's' then
      Window.SaveToClipboard;
  end;
  
  static procedure Resize;
  begin
    Redraw;
    AfterResize := True;
  end;
  end;
  
procedure SetMouseDown(handler: (real,real,integer) -> ());
begin
  OnMouseDown += handler;
end;

procedure SetMouseUp(handler: (real,real,integer) -> ());
begin
  OnMouseUp += handler;
end;

procedure SetMouseMove(handler: (real,real,integer) -> ());
begin
  OnMouseMove += handler;
end;

procedure SetKeyPress(handler: char -> ());
begin
  OnKeyPress += handler;
end;

procedure SetKeyDown(handler: Key -> ());
begin
  OnKeyDown += handler;
end;

function RealToScreenX(xx: real) := fso.RealToScreenX(xx);
function RealToScreenY(yy: real) := fso.RealToScreenY(yy);
function ScreenToRealX(xx: real) := fso.ScreenToRealX(xx);
function ScreenToRealY(yy: real) := fso.ScreenToRealY(yy);
function ScreenToReal(p: Point): Point := fso.ScreenToReal(p);
function RealToScreen(p: Point): Point := fso.RealToScreen(p);


initialization
  InitCoordGrid;
  Window.Title := 'Система координат';
finalization  
  Redraw;
  OnMouseWheel += Handlers.MouseWheel;
  OnMouseDown += Handlers.MouseDown;
  OnMouseMove += Handlers.MouseMove;
  OnResize += Handlers.Resize;
  OnKeyPress += Handlers.KeyPress;
end.