1 сем 1 курс Бельтюков БТС / ЛБ 5 / Unit1

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Menus, Vcl.StdCtrls,
  Vcl.Buttons;

type
  TEPaint = class(TForm)
    PM: TPopupMenu;
    TEyes: TTimer;
    TMig: TTimer;
    dsd1: TMenuItem;
    procedure onPaint(Sender: TObject);
    procedure TMigTimer(Sender: TObject);
    procedure TEyesTimer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure dsd1Click(Sender: TObject);
  private
    { Private declarations }
   procedure WMNCHitTest(var Message: TWMNCHitTest);
   message WM_NCHITTEST;
   protected
    m_lastPos : TPoint;
    procedure DrawPupil(const in_eyeRect : TRect);


  public
    { Public declarations }
  end;

var
  EPaint: TEPaint;

implementation

{$R *.dfm}
const
  // положение глаз и тела
  LEFT_EYE  : TRect = (Left:60; Top:85;  Right:285; Bottom:310);
  RIGHT_EYE : TRect = (Left:315; Top:85;  Right:540; Bottom:310);
  BODY : TRect = (Left:0; Top:0;  Right:600; Bottom:600);
  MASK :  TRect = (Left:170; Top:295;  Right:430; Bottom:555);
  LEFT_MASK :  TRect = (Left:235; Top:340;  Right:285; Bottom:390);
  RIGHT_MASK :  TRect = (Left:315; Top:340;  Right:365; Bottom:390);
  LEFT_ears :  TRect = (Left:0; Top:0;  Right:60; Bottom:60);
  RIGHT_ears :  TRect = (Left:540; Top:0;  Right:600; Bottom:60);

var
  Mig : Boolean = True;




procedure TEPaint.dsd1Click(Sender: TObject);
begin
close
end;

procedure TEPaint.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbRight) then
    PM.Popup(m_lastPos.X, m_lastPos.Y);

end;

procedure TEPaint.onPaint(Sender: TObject);

 begin
 with canvas do //Обращаемся к свойствам холста
   begin
  //Область рисования
      // рисуем тело зеленым цветом
    Brush.Color := clGreen;
    Brush.Style  := bsSolid;
    Pen.Color     := clGreen;
    Pen.Style      := psSolid;
    Pen.Width    := 1;
    Canvas.Ellipse(BODY);
    // рисуем радужку глаз салатным цветом
    Brush.Color  := clBlack;
    Brush.Style   := bsSolid;
    Pen.Color      := clBlack;
    Pen.Style       := psSolid;
    Pen.Width     := 1;
    Canvas.Ellipse(LEFT_EYE);
    Canvas.Ellipse(RIGHT_EYE);
    // рисуем зрачки черным цветом
    Brush.Color  := clWhite;
    Brush.Style   := bsSolid;
    Pen.Style      := psClear;
    drawPupil(LEFT_EYE);
    drawPupil(RIGHT_EYE);
      // рисуем маску голубым цветом
    Brush.Color := clSkyBlue;
    Brush.Style  := bsSolid;
    Pen.Color     := clSkyBlue;
    Pen.Style      := psSolid;
    Pen.Width    := 1;
    Canvas.Ellipse(MASK);
    Brush.Color  := clBlack;
    Brush.Style   := bsSolid;
    Pen.Color      := clBlack;
    Pen.Style       := psSolid;
    Pen.Width     := 1;
    Canvas.Ellipse(LEFT_MASK);
    Canvas.Ellipse(RIGHT_MASK);
    Brush.Color  := clSkyBlue;
    Brush.Style   := bsSolid;
    Pen.Color      := clSkyBlue;
    Pen.Style       := psSolid;
    Pen.Width     := 5;
    PolyGon([Point(0,300),Point(196,347)]);
    PolyGon([Point(0,300),Point(180,475)]);
    PolyGon([Point(600,300),Point(404,347)]);
    PolyGon([Point(600,300),Point(420,475)]);
       // рисуем ушки зеленым цветом
    Brush.Color  := clGreen;
    Brush.Style   := bsSolid;
    Pen.Color      := clGreen;
    Pen.Style       := psSolid;
    Pen.Width     := 1;
    Canvas.Ellipse(LEFT_ears);
    Canvas.Ellipse(RIGHT_ears);
    PolyGon([Point(71,106),Point(43,57),Point(57,43),Point(107,71)]);
    PolyGon([Point(529,106),Point(557,57),Point(543,43),Point(493,71)]);
    // рисуем ресницы для глаз
    Brush.Color  := clGray;
    Brush.Style   := bsSolid;
    Pen.Color      := clGray;
    Pen.Style       := psSolid;
    Pen.Width     := 3;
    PolyGon([Point(173,55),Point(173,85)]);
    PolyGon([Point(428,55),Point(428,85)]);
    PolyGon([Point(93,118),Point(72,98)]);
    PolyGon([Point(252,118),Point(273,98)]);
    PolyGon([Point(349,118),Point(327,98)]);
    PolyGon([Point(507,118),Point(527,98)]);
end; // Конец рисования на холсте

  end;



procedure TEPaint.DrawPupil(const in_eyeRect: TRect);

const
  // ширина зрачка
  PUPIL_WIDTH  = 50;
  // высота зрачка
  PUPIL_HEIGHT = 50;
  // радиус перемещения зрачка
  MOVE_RADIUS  = 90;
  // дистанция направления взгляда
  FULL_DIST    = 200;
  var
  // точка рисования зрачка
  eyePos    : TPoint;
  // направление взгляда
  eyeDist   : integer;
  // смещение по x и y
  dx, dy    : integer;
  // зона, занимаемая глазами
  pupilRect : TRect;
  // нарисовать зрачки
  // eyePos присвоить значение точки
  {Функция Point берет параметры X и Y и

  возвращает значение TPoint, содержащее их.}
 begin
  eyePos    := Point((in_eyeRect.Left + in_eyeRect.Right) div 2,
                     (in_eyeRect.Top + in_eyeRect.Bottom) div 2);
  // задает координаты прямоугольника
  {в Delphi функция Rect создает объект TRect (прямоугольник),
  для создания прямоугольника необходимо указать 4 координаты или 2 точки.}
  pupilRect := Rect(eyePos.X - PUPIL_WIDTH div 2,
                                eyePos.Y - PUPIL_HEIGHT div 2,
                                eyePos.X + PUPIL_WIDTH div 2 + 1,
                                eyePos.Y + PUPIL_HEIGHT div 2 + 1);
  // определить позицию глаз
  eyePos  := ClientToScreen(eyePos);
  dx      := m_lastPos.X - eyePos.X;
  dy      := m_lastPos.Y - eyePos.Y;
  eyeDist := Round(Sqrt(Sqr(dx) + Sqr(dy)));
  // граница перемещения зрачка не превышает диаметр радужки
  if (eyeDist > FULL_DIST) then
  // изменяет координаты прямоугольника на указанное смещение
     {procedure OffsetRect(var Rect: TRect; X, Y: Integer);
     изменяет координаты прямоугольника на указанные смещения по X и Y.}
    OffsetRect(pupilRect,
               MulDiv(dx, MOVE_RADIUS, eyeDist),
     {function MulDiv(Number, Numerator, Denominator: Integer): Integer;
     умножает Numerator на Number и делит результат на Denominator,
     округляя получаемое значение до ближайшего целого.}
               MulDiv(dy, MOVE_RADIUS, eyeDist))
  else
    if (eyeDist > 0) then
      OffsetRect(pupilRect,
                 MulDiv(dx, MulDiv(MOVE_RADIUS, eyeDist, FULL_DIST), eyeDist),
                 MulDiv(dy, MulDiv(MOVE_RADIUS, eyeDist, FULL_DIST), eyeDist));
  Canvas.Ellipse(pupilRect);


  end;
procedure TEPaint.TEyesTimer(Sender: TObject);

var
  mousePos : TPoint;
    begin
  mousePos := Mouse.CursorPos;
  // отслеживаем и перерисовываем глаза
  if (mousePos.X <> m_lastPos.X) or (mousePos.Y <> m_lastPos.Y) then
       begin
        self.Invalidate;
        m_lastPos := mousePos;
      end;

   end;


  procedure TEPaint.TMigTimer(Sender: TObject);
// таймер мигания глаза
var
  Color1, Color2 : TColor;
  Interval       : Word;
begin
  if Mig then
  begin
    // если глаз мигает, цвет фона (зеленый)
    Color1 := clGreen ;
    Color2 := clGreen ;
    // интервал мигания 0,2 с
    Interval := 200;
  end
  else
  begin
    // радужка черная
    Color1 := clBlack;
    // зрачки белые
    Color2 := clWhite;
    // интервал мигания 5 с
    Interval := 5000;
  end;
  with Canvas do
  begin
    // нарисовать глаза (радужку)
    Brush.Color := Color1;
    Brush.Style := bsSolid;
    Pen.Color   := Color1;
    Pen.Style   := psSolid;
    Pen.Width   := 1;
    Canvas.Ellipse(LEFT_EYE);
    Canvas.Ellipse(RIGHT_EYE);
    // нарисовать зрачки
    Brush.Color := Color2;
    Brush.Style := bsSolid;
    Pen.Style   := psClear;
    // левый глаз
    drawPupil(LEFT_EYE);
    // правый глаз
    drawPupil(RIGHT_EYE);
    TMig.Interval := Interval;
  end;
  // фазу мигания сменить
  Mig := not Mig;

end;

procedure TEPaint.WMNCHitTest(var Message: TWMNCHitTest);
begin
// унаследовать все свойства предка
inherited;
// дать возможность вызывать контекстное меню по правой кнопке мыши
if ((GetAsyncKeyState(VK_RBUTTON) and $F000) = 0) and
     (Message.Result = htClient) then
  // перенаправление команд – вся форма – заголовок
    Message.Result := htCaption;

end;


end.