unit LineUnit;
{   Этот пример показывает, как можно сделать "резиновую" линию - то есть такую,
    которая тянется за курсором, пока пользователь удерживает кнопку мыши. Такие
    линии применяются во всех современных графических редакторах. Второе, что делает
    этот пример - рисует особые линии, которые невозможно нарисовать с помощью
    стандартных перьев. В этом примере пять типов линий:
     1) Линия, состоящая из чередующихся отрезков по пять точек красного, зелёного и
        синего цветов.
     2) Каждая точка линии имеет свой случайным образом выбранный цвет.
     3) Линия, состоящая из отдельных крестиков.
     4) Линия с переменной толщиной.
     5) Линия в виде "ёлочки".
    Метод рисования таких линий очень универсален. При этом не надо программировать
    алгоритмы построения линий (например, алгоритм Брезенхэма), всё делает Win API.
    Создание новых типов линий очень просто и ограничивается, в основном, только
    фантазией программиста. Но, к сожалению, описанный метод пригоден только для
    прямых линий. Эллипс или дугу так не нарисуешь.

    Автор: Григорьев Антон (grigorievab@mail.ru), Черноголовка, 1999
    Специально для Королевства Delphi (http://delphi.vitpc.com)                     }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,Math;

type
  TLinesForm = class(TForm)
    RGroupLine: TRadioGroup;
    procedure FormMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
    procedure FormMouseMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
    procedure FormMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
    procedure FormCreate(Sender: TObject);
   private
    LineDrawing:Boolean;  //  Эта переменная True, если программа находится в режиме
                          //  рисования линии.
    BegX,BegY:Integer;    //  Здесь хранятся координаты начала "резиновой" линии.
    OldX,OldY:Integer;    //  Здесь хранятся координаты конца "резиновой" линии на
                          //  момент её последнего обновления на экране.
    procedure Line(X1,Y1,X2,Y2:Integer);
  end;

var
  LinesForm: TLinesForm;

implementation

{$R *.DFM}

var Counter:Integer;    //   Счётчик точек линии
    DX1,DY1,DX2,DY2:Integer;   //   Вспомогательные переменные для построения "ёлочки"

{   Процедуры LineDrawXXX - это функции косвенного вызова (callback-функции) для
    LineDDE. Подробнее о том, что такое функции косвенного вызова, написано в статье
    "Основы работы с Windows API", которую можно взять в Свитках. Windows строит
    линию, но вместо того, чтобы рисовать её, вызывает для каждой точки одну из этих
    процедур, передавая ей координаты этой точки. А процедура решает, что дальше делать
    с этой точкой - пропустить, окрасить в какой-то цвет или нарисовать на этом месте
    сложную фигуру.   }

procedure LineDrawRGB(X,Y:Integer;Canvas:TCanvas);stdcall;
 //  Линия, состоящая из чередующихся отрезков по пять точек красного, зелёного и
 //  синего цветов.
 begin
  case Counter mod 15 of
   0..4:Canvas.Pixels[X,Y]:=clRed;
   5..9:Canvas.Pixels[X,Y]:=clLime;
   10..14:Canvas.Pixels[X,Y]:=clBlue
  end;
  Inc(Counter)
 end;

procedure LineDrawRandom(X,Y:Integer;Canvas:TCanvas);stdcall;
 //   Каждая точка линии имеет свой случайным образом выбранный цвет.
 begin
  Canvas.Pixels[X,Y]:=RGB(Random(256),Random(256),Random(256))
 end;

procedure LineDrawCross(X,Y:Integer;Canvas:TCanvas);stdcall;
 //   Линия, состоящая из отдельных крестиков.
 begin
  if Counter mod 7=0 then
   with Canvas do
    begin
     MoveTo(X-2,Y);
     LineTo(X+3,Y);
     MoveTo(X,Y-2);
     LineTo(X,Y+3)
     {   Человеку, не слишком хорошо знакомому с графикой Windows, может показаться,
         что этот код рисует несимметричный крестик, что его правый и нижний лучи
         будут длиннее, чем левый и верхний. Но это не так. Почему-то в Microsoft
         решили, что будет удобнее, если последняя точка линии не будет рисоваться.
         Не знаю, откуда им пришла в голову такая мысль. Это означает, что программист
         должен указывать не ту точку, которая должна быть концом линии, а следующую
         за ней. Ну хорошо нам сейчас, для горизонтальных и вертикальных линий легко
         понять, какая точка будет следующей. А если линия идёт под углом? Помните
         песню "Голубой огонёк" Бориса Гребенщикова?

              Попадись мне, кто всё так придумал,
              Я бы сам его здесь придушил.

         Кстати, в Windows вся графика такая же кривая. Если нарисовать прямоугольник
         Rectangle(10, 10, 100, 100), то в какой точке окажется его правый нижний
         угол? Правильно, в точке (99, 99). Ну, а фирме Borland (пардон, Inprise),
         да и всем нам тоже, остаётся только следовать этим идиотским правилам.    }
    end;
  Inc(Counter)
 end;

procedure LineDrawThick(X,Y:Integer;Canvas:TCanvas);stdcall;
 //   Линия с переменной толщиной.
 begin
  case Counter mod 28 of
   0..6:Canvas.Ellipse(X-2,Y-2,X+3,Y+3);
   7..13,21..27:Canvas.Ellipse(X-1,Y-1,X+2,Y+2);
   14..20:Canvas.Pixels[X,Y]:=clRed
  end;
  {   Тем, кто подумал, что эллипсы будут несимметричными, советую ещё раз внимательно
      прочитать предыдущий комментарий.   }
  Inc(Counter)
 end;

procedure LineDrawFir(X,Y:Integer;Canvas:TCanvas);stdcall;
 //   Линия в виде "ёлочки".
 begin
  with Canvas do
   case Counter mod 10 of
    0:begin
       MoveTo(X,Y);
       LineTo(X+DX1,Y+DY1)
      end;
    5:begin
       MoveTo(X,Y);
       LineTo(X+DX2,Y+DY2)
      end
   end;
  Inc(Counter)
 end;

procedure TLinesForm.Line;
 var Angle:Extended;
  //   А здесь мы определяем, какую линию хочет пользователь, инициализируем
  //   все переменные и вызываем LineDDA с соответствующей callback-функцией.
  //   По каким-то своим соображениям фирмы Microsoft Win API не содержит
  //   функций ArcDDA, EllipseDDA и т. п., поэтому так просто можно нарисовать
  //   только прямую линию.
  begin
   case RGroupLine.ItemIndex of
    0:begin
       Counter:=0;
       LineDDA(X1,Y1,X2,Y2,@LineDrawRGB,Integer(Canvas))
      end;
    1:LineDDA(X1,Y1,X2,Y2,@LineDrawRandom,Integer(Canvas));
    2:begin
       Counter:=0;
       LineDDA(X1,Y1,X2,Y2,@LineDrawCross,Integer(Canvas))
      end;
    3:begin
       Counter:=0;
       LineDDA(X1,Y1,X2,Y2,@LineDrawThick,Integer(Canvas))
      end;
    4:begin
       Counter:=0;
       Angle:=ArcTan2(Y2-Y1,X2-X1);
       DX1:=Round(8*Cos(Angle+Pi/6));
       DY1:=Round(8*Sin(Angle+Pi/6));
       DX2:=Round(8*Cos(Angle-Pi/6));
       DY2:=Round(8*Sin(Angle-Pi/6));
       LineDDA(X1,Y1,X2,Y2,@LineDrawFir,Integer(Canvas))
      end
   end
  end;

procedure TLinesForm.FormMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
 begin
  if Button=mbLeft then
   begin
    MouseCapture:=True;
    OldX:=X;
    OldY:=Y;
    BegX:=X;
    BegY:=Y;
    LineDrawing:=True
    {   При нажатии на левую кнопку мыши начинаем рисовать "резиновую" линию.
        Инициализируем все переменные и захватываем мышь в монопольное пользование.   }
   end
 end;

procedure TLinesForm.FormMouseMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
 begin
  if LineDrawing and ((X<>OldX) or (Y<>OldY)) then
   with Canvas do
    begin
     SetROP2(Handle,R2_Not);
     {   Должен разочаровать всех, кто думает, что если они установили, например,
         красный карандаш и зелёную кисть, то всё, что они рисуют, будет иметь красный
         контур и зелёные внутренности. На самом деле так происходит только при
         растровой операции R2_CopyPen, установленной по умолчанию. А если поменять
         растровую операцию, то цвет будет зависеть не только от цвета пера и кисти,
         но и от того цвета точки, который она имела до начала рисования. Более того,
         в некоторых случаях цвет пера и кисти может вообще игнорироваться. Например,
         операция R2_Not просто инвертирует цвет точки. Это очень удобно, потому что
         для любого цвета X верно равенство not not X = X. Поэтому, если дважды нарисовать
         таким образом некий объект, то после второго раза никто и не заметит, что здесь
         что-то рисовали, потому что восстановится первоначальное изображение. Более того,
         равенство выполняется не только при двух "not" перед X, но и при любом другом
         чётном их количестве. Поэтому сказанное выше остаётся верным и для сложных фигур
         с самопересечением. Вот только после однократного рисования такие фигуры могут
         выглядеть далеко не на пять с плюсом. Например, когда рисуется "резиновая" линия
         из крестиков, можно заметить, что середина крестика выколота, потому что по этой
         точке перо проходит два раза: один раз при рисовании горизонтальной, другой раз -
         вертикальной линии. Ну, а уж как выглядит "резиновая" линия переменной толщины,
         мне даже вспоминать не хочется. Улучшить ситуацию, в принципе, можно либо применив
         алгоритм, в котором по каждой точке проходятся нечётное число раз (кто может -
         пусть придумает), либо рисовать эту линию сначала на растре (bitmap), а потом
         переносить этот растр с нужной операцией на экран. Задача вполне выполнимая,
         но потребуется много памяти, да и скорость уменьшится. Кстати, в справочной
         системе Win32 Developer's Refernce написано, что функция SetROP2 влияет на
         рисование пером и кистью. Экспериментально установлено, что она ещё влияет на
         изменение цвета точки с помощью функции SetPixel, через которую работает
         свойство TCanvas.Pixels.    }
     Line(BegX,BegY,OldX,OldY);    //    Стираем старую линию.
     Line(BegX,BegY,X,Y);          //    Рисуем новую.
     OldX:=X;
     OldY:=Y
    end
 end;

procedure TLinesForm.FormMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
 begin
  if (Button=mbLeft) and LineDrawing then
   begin
    case RGroupLine.ItemIndex of
     2:Canvas.Pen.Color:=clBlue;
     3:begin
        Canvas.Brush.Color:=clRed;
        Canvas.Pen.Color:=clRed
       end;
     4:Canvas.Pen.Color:=clGreen
    end;
    Line(BegX,BegY,X,Y);
    LineDrawing:=False;
    MouseCapture:=False
    {   Рисуем линию уже с нормальной растровой операцией и нормальным цветом, завершаем
        процесс рисования "резиновой" линии и освобождаем мышь. Обратите внимание, что
        к началу работы этой процедуры на экране остаётся нестёртая "резиновая" линия.
        В данном случае её можно не стирать, потому что нормальная линия ляжет на неё
        точка в точку и полностью закроет.    }
   end
 end;

procedure TLinesForm.FormCreate(Sender: TObject);
 begin
  LineDrawing:=False;
  Randomize
 end;

end.