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.