FAQ VCL
Графика

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как изменить цветовые каналы битового изображения?

function SetRGBChannelValue(Bitmap: TBitmap; Red, Green, Blue: Integer): Boolean;
type
  pRGB = ^TRGB;
  TRGB = record
    B, G, R: Byte;
  end;

var
  x, y: Integer;
  rgbc: array[0..2] of Byte;
  Dest: pRGB;
begin
  if (Red = 0) and (Green = 0) and (Blue = 0) then
  begin
    Result := False;
    Exit;
  end;

  for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];

    for x := 0 to Bitmap.Width - 1 do
    begin
       rgbc[0] := Dest^.R;
       rgbc[1] := Dest^.G;
       rgbc[2] := Dest^.B;

       if not (rgbc[0] + Red < 0) and not (rgbc[0] + Red > 255) then
         rgbc[0] := rgbc[0] + Red;
       if not (rgbc[1] + Green < 0) and not (rgbc[1] + Green > 255) then
         rgbc[1] := rgbc[1] + Green;
       if not (rgbc[2] + Blue < 0) and not (rgbc[2] + Blue > 255) then
         rgbc[2] := rgbc[2] + Blue;

       Dest^.R := rgbc[0];
       Dest^.G := rgbc[1];
       Dest^.B := rgbc[2];
       Inc(Dest);
     end;
   end;
   Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;

  try
    Bitmap.LoadFromFile('c:\in.bmp');
    SetRGBChannelValue(Bitmap, 10, 50, 180);
    Bitmap.SaveToFile('c:\out.bmp')
  finally
    Bitmap.Free;
  end;
end;


Как изменить контрастность изображения?

// Спрсоб первый
/// <summary>
/// Изменение контрастности изображения
/// </summary>
/// <param name="Value">значение контрастности на отрезке [-100..100]</param>
/// <param name="Local">true - применяется "местный контраст", false - "общий" (более красивый)</param>
procedure Contrast(Bitmap: TBitmap; Value: Integer; Local: Boolean);

  function BLimit(B: Integer): Byte;
  begin
    if B < 0 then
      Result := 0
    else if B > 255 then
      Result := 255
    else
      Result := B;
  end;

var
  Dest: pRGBTriple;
  x, y, mr, mg, mb, W, H, tr, tg, tb: Integer;
  vd: Double;
begin
  if Value = 0 then
    Exit;

  W := Bitmap.Width - 1;
  H := Bitmap.Height - 1;
  if Local then
  begin
    mR := 128;
    mG := 128;
    mB := 128;
  end
  else
  begin
    tr := 0;
    tg := 0;
    tb := 0;
    for y := 0 to H do
    begin
      Dest := Bitmap.ScanLine[y];
      for x := 0 to W do
      begin
        with Dest^ do
        begin
          Inc(tb, rgbtBlue);
          Inc(tg, rgbtGreen);
          Inc(tr, rgbtRed);
        end;
        Inc(Dest);
      end;
    end;
    mB := Trunc(tb / (W * H));
    mG := Trunc(tg / (W * H));
    mR := Trunc(tr / (W * H));
  end;

  if Value > 0 then
    vd := 1 + (Value / 10)
  else
    vd := 1 - (Sqrt(-Value) / 10);

  for y := 0 to H do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to W do
    begin
      with Dest^ do
      begin
        rgbtBlue := BLimit(mB + Trunc((rgbtBlue - mB) * vd));
        rgbtGreen := BLimit(mG + Trunc((rgbtGreen - mG) * vd));
        rgbtRed := BLimit(mR + Trunc((rgbtRed - mR) * vd));
      end;
      Inc(Dest);
    end;
  end;
end;

// Спрсоб второй
uses
  {...,} Math;

procedure Gamma(Bitmap: TBitmap; L: Double); {0.0 < L < 7.0}
type
  pRGB = ^TRGB;
  TRGB = record
    B, G, R: Byte;
  end;

var
  Dest: pRGB;
  X, Y: Word;
  GT: array[0..255] of Byte;
begin
  Bitmap.PixelFormat := pf24Bit;
  GT[0] := 0;
  if L = 0 then
    L := 0.01;
  for X := 1 to 255 do
    GT[X] := Round(255 * Power(X / 255, 1 / L));
  for Y := 0 to Bitmap.Height-1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for X := 0 to Bitmap.Width-1 do
    begin
      with Dest^ do
      begin
        R := GT[R];
        G := GT[G];
        B := GT[B];
      end;
      Inc(Dest);
    end;
  end;
end;


Как отобразить Bitmap зеркально?

// Способ первый
procedure FlipBitmap(Bitmap: TBitmap; FlipHor: Boolean);
var
  x, y, W, H: Integer;
  Pixel_1, Pixel_2: PRGBTriple;
  MemPixel: TRGBTriple;
begin
  Bitmap.PixelFormat := pf24Bit;
  W := Bitmap.Width-1;
  H := Bitmap.Height-1;
  if FlipHor then {отражение по горизонтали}
    for y := 0 to H do
    begin
      // помещаем оба указателя на строку H:
      Pixel_1 := Bitmap.ScanLine[y];
      Pixel_2 := Bitmap.ScanLine[y];
      // помещаем второй указатель в конец строки:
      Inc(Pixel_2, W);
      // цикл идёт только до середины строки:
      for x := 0 to W div 2 do
      begin
        // симметричные точки обмениваются цветами:
        MemPixel := Pixel_1^;
        Pixel_1^ := Pixel_2^;
        Pixel_2^ := MemPixel;
        Inc(Pixel_1); // смещаем указатель вправо
        Dec(Pixel_2); // смещаем указатель влево
      end;
    end
  else // отражение по вертикали
    // цикл идёт только до средней строки:
    for y := 0 to H div 2 do
    begin
      // помещаем первый указатель на строку H,
      // а второй на строку симметричную H:
      Pixel_1 := Bitmap.ScanLine[y];
      Pixel_2 := Bitmap.ScanLine[H-y];
      for x := 0 to W do
      begin
        // симметричные точки обмениваются цветами:
        MemPixel := Pixel_1^;
        Pixel_1^ := Pixel_2^;
        Pixel_2^ := MemPixel;
        Inc(Pixel_1); // смещаем указатель вправо
        Inc(Pixel_2); // смещаем указатель вправо
      end;
    end;
end;


Как заменить все цвета Bitmap`a оттенками одного цвета?

procedure ModColors(Bitmap: TBitmap; Color: TColor);

  function BLimit(B: Integer): Byte;
  begin
    if B < 0 then
      Result := 0
    else if B > 255 then
      Result := 255
    else
      Result := B;
  end;

type
  pRGB = ^TRGB;
  TRGB = record
    B, G, R: Byte;
  end;

var
  r1, g1, b1: Byte;
  x, y: Integer;
  Dest: pRGB;
  A: Double;
begin
  Bitmap.PixelFormat := pf24Bit;
  r1 := Round(255 / 100 * GetRValue(Color));
  g1 := Round(255 / 100 * GetGValue(Color));
  b1 := Round(255 / 100 * GetBValue(Color));
  for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width-1 do
    begin
      with Dest^ do
      begin
        A := (r + b + g) / 300;
        with Dest^ do
        begin
          R := BLimit(Round(r1 * A));
          G := BLimit(Round(g1 * A));
          B := BLimit(Round(b1 * A));
        end;
      end;
      Inc(Dest);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ModColors(FBitmap, RGB(218, 219, 230));
end;


Как залить канву градиентом?

// Способ первый
type
  TOrientation = (orVertical, orHorizontal);

  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
  private
    procedure PaintGradientRect(StartColor, EndColor: TColor;
      Orientation: TOrientation);
    procedure PaintGradientTriangle;
  end;

  // Переопределение типа из Windows.pas
  COLOR16 = $0000..$FF00;

  TTriVertex = packed record
    x, y: DWORD; // Координаты вершины
    Red, Green, Blue, Alpha: COLOR16; // Каналы цветов
  end;

  function GradientFill(DC: HDC; Vertex: Pointer; NumVertex: Cardinal;
    Mesh: Pointer; NumMesh, Mode: DWORD): BOOL; stdcall;
    external 'msimg32.dll' name 'GradientFill';

{...}

implementation

{...}

procedure TForm1.PaintGradientRect(StartColor, EndColor: TColor;
  Orientation: TOrientation);
var 
  // Массив вершин (нужны две - верхнелевая и нижнеправая)
  vert: array[0..1] of TTriVertex;
  gRect: TGradientRect; // Индексы вершин в массиве vert (из Windows.pas)
begin
  // Определяем вершины
  vert[0].x := 0; // Верхняя левая точка
  vert[0].y := 0;
  vert[0].Red := GetRValue(StartColor) shl 8;
  vert[0].Green := GetGValue(StartColor) shl 8;
  vert[0].Blue := GetBValue(StartColor) shl 8;
  vert[0].Alpha := $0000; // Видать прозрачность?..

  vert[1].x := ClientWidth; // Нижняя правая точка
  vert[1].y := ClientHeight;
  vert[1].Red := GetRValue(EndColor) shl 8;
  vert[1].Green := GetGValue(EndColor) shl 8;
  vert[1].Blue := GetBValue(EndColor) shl 8;
  vert[1].Alpha := $0000;

  gRect.UpperLeft := 0; // Назначаем вершины верхнелевому
  gRect.LowerRight := 1; // и нижнеправому углам.

  // Заливаем в зависимости от ориентации
  if Orientation = orHorizontal then
    GradientFill(Canvas.Handle, @vert, 2, @gRect, 1, GRADIENT_FILL_RECT_H)
  else
    GradientFill(Canvas.Handle, @vert, 2, @gRect, 1, GRADIENT_FILL_RECT_V);
end;

procedure TForm1.PaintGradientTriangle;
var
  vert: array[0..3] of TTriVertex; // 4 точки для 2 треугольников<
  gTri: array[0..1] of TGradientTriangle; // массив из 2 треугольников
begin
  // Красная вершина
  vert[0].x := 80;
  vert[0].y := 50;
  vert[0].Alpha := $0000;
  vert[0].Red := $FF00;
  vert[0].Green := $0000;
  vert[0].Blue := $0000;

  // Желтая вершина
  vert[1].x := 50;
  vert[1].y := 120;
  vert[1].Alpha := $0000;
  vert[1].Red := $FF00;
  vert[1].Green := $FF00;
  vert[1].Blue := $0000;

  // Синяя вершина
  vert[2].x := 150;
  vert[2].y := 80;
  vert[2].Alpha := $0000;
  vert[2].Red := $0000;
  vert[2].Green := $0000;
  vert[2].Blue := $FF00;

  // Зеленая вершина
  vert[3].x := 120;
  vert[3].y := 150;
  vert[3].Alpha := $0000;
  vert[3].Red := $0000;
  vert[3].Green := $FF00;
  vert[3].Blue := $0000;

  // Назначаем индексы вершин углам треугольников
  gTri[0].Vertex1 := 0; gTri[0].Vertex2 := 1; gTri[0].Vertex3 := 2;
  gTri[1].Vertex1 := 3; gTri[1].Vertex2 := 1; gTri[1].Vertex3 := 2;

  // Рисуем красивый градиент
  GradientFill(Canvas.Handle, @vert, 4, @gTri, 2, GRADIENT_FILL_TRIANGLE);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  PaintGradientRect(clRed, clLime, orVertical);
  PaintGradientTriangle;
end;

// **********************************************
// В полседних версиях Delphi это уже реализовано
// **********************************************
uses
  GraphUtil;

procedure TForm1.FormPaint(Sender: TObject);
begin
  GradientFillCanvas(Canvas, clMaroon, clWhite, ClientRect, gdVertical);
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
const
  N = 200;
  M = 100;
var
  i, j, a: Integer;
begin
  a := 255 div N;
  for i := 1 to N do
    for j := 1 to M do
      Form1.Canvas.Pixels[20+i, 30+j] := RGB(255, 255-i*a, 255);
end;

// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
var
  StartC, EndC: TColor; // Начальный и конечный цвета
  GradRECT: TRect; // Размер области, на которой будем рисовать
  StartRGB, EndRGB: array[0..2] of Byte; // Разложенный цвет
  Colors, i, Delta: Word; // Число цветов, которые использовать для создания градиента
begin
  // Область заливки
  GradRECT := Image1.ClientRect;
  // Цвета
  StartC := ColorToRGB(clRed);
  EndC := ColorToRGB(clLime);
  // Массив с исходными цветами (1)
  StartRGB[0] := GetRValue(StartC);
  StartRGB[1] := GetGValue(StartC);
  StartRGB[2] := GetBValue(StartC);
  // Массив с конечными цветами (2)
  EndRGB[0] := GetRValue(EndC);
  EndRGB[1] := GetGValue(EndC);
  EndRGB[2] := GetBValue(EndC);
  // Число градаций на ширину
  Colors := Image1.Width div 2;
  // Число пикселей для одной градации
  Delta := Image1.Width div Colors;
  for i := 0 to Colors do
  begin
    // Определяем область для градации
    GradRECT.Left := i * Delta;
    GradRECT.Right := GradRECT.Left + Delta;
    with Image1.Canvas do
    begin
      Pen.Style := psSolid;
      Brush.Color := RGB((StartRGB[0] + MulDiv(i, EndRGB[0] - StartRGB[0], Colors{-1})),
                         (StartRGB[1] + MulDiv(i, EndRGB[1] - StartRGB[1], Colors{-1})),
                         (StartRGB[2] + MulDiv(i, EndRGB[2] - StartRGB[2], Colors{-1})));
      // Заливаем
      FillRect(GradRect);
    end;
  end;
end;


Как просмотреть все стили кисти?

var
  BrushStyle: Byte = 0;

implementation

uses
  {...,} TypInfo;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := GetEnumName(TypeInfo(TBrushStyle), BrushStyle);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  with Canvas do
  begin
    Brush.Style:= bsSolid;
    Brush.Color:= clWhite;
    Rectangle(0, 0, ClientWidth, ClientHeight);

    Brush.Style := TBrushStyle(BrushStyle);
    Brush.Color := clRed;
    Rectangle(0, 0, ClientWidth, ClientHeight);
  end;
end;

// Timer1.Interval = 1000
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Inc(BrushStyle);
  if BrushStyle > 7 then
    BrushStyle := 0;
  InvalidateRect(Handle, nil, False);
  Caption := GetEnumName(TypeInfo(TBrushStyle), BrushStyle);
end;


Как преобразовать EMF (Enhanced Metafile) в BMP?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  Met: TMetafile;
begin
  Bitmap := TBitmap.Create;

  try
    Metafile := TMetafile.Create;

    try
      Metafile.LoadFromFile('c:\test.emf');
      Bitmap.Width := Metafile.Width;
      Bitmap.Height := Metafile.Height;
      Bitmap.Canvas.Draw(0, 0, Metafile);
      Bitmap.SaveToFile('c:\test.bmp');
    finally
      Metafile.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;

// Способ второй
procedure ConvertEMF2BMP(const EMFFileName, BMPFileName: TFileName);
var
  p: Pointer;
  Metafile: TMetafile;
  Bitmap: TBitmap;
begin
  Metafile := TMetaFile.Create;
  try
    Bitmap := TBitmap.Create;
    try
      Metafile.LoadFromFile(EMFFileName);
      Bitmap.Width := Metafile.Width;
      Bitmap.Height := Metafile.Height;
      Bitmap.SetSize(Metafile.Width, Metafile.Height);
      PlayEnhMetaFile(Bitmap.Canvas.Handle, Metafile.Handle, Bitmap.Canvas.ClipRect);
    finally
      Metafile.Free;
    end;
    Bitmap.SaveToFile(BMPFileName);
  finally
    Bitmap.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ConvertEMF2BMP('c:\123456.emf', 'c:\123456.bmp');
end;


Как сделать эффект "муравьев"?

const
  ANT_WIDTH = 10;
  ANT_MOVE_STEP = 2;

var
  antPos: Word = 0;

procedure ant_Line(x1, y1, x2, y2: integer; Canvas: TCanvas; Otstup, Interval: Word);
var
  i, d, a, b: Word;
  znx, zny: SmallInt;
  px, py: integer;
begin
  d := Trunc(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));
  znx := 1;
  zny := 1;
  if x2-x1 < 0 then
    znx := -1;
  if y2-y1 < 0 then
    zny := -1;
  a := Trunc(Interval * (x2-x1) * znx / d);
  b := Trunc(Interval * (y2-y1) * zny / d);
  if Otstup >= Interval * 2 then
    Otstup := Otstup mod (Interval * 2);
  for i := 0 to Trunc(d / Interval) do
  begin
    if i mod 2 <> 0 then
      Continue;
    px := x1 + i * a * znx + Trunc(Otstup * (x2-x1) / d);
    py := y1 + i * b * zny + Trunc(Otstup * (y2-y1) / d);
    if (d < Trunc(Sqrt(Sqr(px-x1) + Sqr(py-y1)))) or
       ((px * znx > x2) or (py * zny > y2)) then
      Continue;
    Canvas.MoveTo(px, py);
    px := x1 + (i+1) * a * znx + Trunc(Otstup * (x2-x1) / d);
    py := y1 + (i+1) * b * zny + Trunc(Otstup * (y2-y1) / d);
    if d < Trunc(Sqrt(Sqr(px-x1) + Sqr(py-y1))) then
    begin
      px := x2;
      py := y2;
    end;
    if px * znx > x2 then
      px := x2;
    if py * zny > y2 then
      py := y2;
    Canvas.LineTo(px, py);
    if Otstup > Interval then
    begin
      Canvas.MoveTo(x1, y1);
      px := x1 + Trunc((Otstup-Interval) * (x2-x1) / d);
      py := y1 + Trunc((Otstup-Interval) * (y2-y1) / d);
      Canvas.LineTo(px, py);
    end;
  end;
end;

// Otstup - смещение для рисования "муравьев"
// Interval - длина линий ("муравьев")
procedure ant_Rectangle(x1, y1, x2, y2: integer; Canvas: TCanvas; Otstup, Interval: Word);
var
  pogr, pogr1: Word;
begin
  if (x1 = x2) or (y1 = y2) then
    Exit;

  ant_Line(x1, y1, x2, y1, Canvas, Otstup, Interval);
  pogr := (Abs(x2-x1) div Interval) mod 2;

  if pogr = 0 then
    pogr := Interval * 2 - (Abs(x2-x1) mod (Interval))
  else
    pogr := Interval - (Abs(x2-x1) mod (Interval));

  ant_Line(x2, y1, x2, y2, Canvas, Otstup + pogr, Interval);
  pogr1 := (Abs(y1-y2) div Interval) mod 2;

  if pogr1 = 0 then
    pogr1 := Interval * 2 - (Abs(y1-y2) mod (Interval))
  else
    pogr1 := Interval - (Abs(y1-y2) mod (Interval));

  ant_Line(x2, y2, x1, y2, Canvas, Otstup + pogr + pogr1, Interval);
  ant_Line(x1, y2, x1, y1, Canvas, otstup + 2 * pogr + pogr1, Interval);
end;

// Timer.Interval = 50
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Refresh;
  Canvas.Pen.Width := 2;
  Canvas.Pen.Color := clNavy;
  ant_Rectangle(10, 10, 200, 200, Canvas, antPos, ANT_WIDTH);
  antPos := antPos + ANT_MOVE_STEP;
  if antPos >= ANT_WIDTH * 2 then
    antPos := 0;
end;


Как ограничить область рисования на канве?

// Установка области клиппинга - данные вне этой области не отображаются
procedure TForm1.Button1Click(Sender: TObject);
var
  ClipRect: TRect;
begin
  ClipRect := ClientRect;
  with ClipRect do
  begin
    InflateRect(ClipRect, -(Right div 4), -(Bottom div 4));
    IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
  end;

  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(ClientRect);
end;

// Удаление области рисования - данные в этой области не отображаются
procedure TForm1.Button1Click(Sender: TObject);
var
  ClipRect: TRect;
begin
  ClipRect := ClientRect;
  with ClipRect do
  begin
    InflateRect(ClipRect, -(Right div 4), -(Bottom div 4));
    ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
  end;

  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(ClientRect);
end;


Как нарисовать Bitmap с прозрачностью?

procedure DrawTransparentBmp(Canvas: TCanvas; X,Y: Integer; Bmp: TBitmap;
                             clTransparent: TColor);
var
  bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
  OldCol: Longint;
begin
  try
    bmpAND := TBitmap.Create;
    bmpAND.Width := Bmp.Width;
    bmpAND.Height := Bmp.Height;
    bmpAND.Monochrome := True;
    OldCol := SetBkColor(Bmp.Canvas.Handle, ColorToRGB(clTransparent));
    BitBlt(bmpAND.Canvas.Handle, 0, 0, Bmp.Width,Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    SetBkColor(Bmp.Canvas.Handle, OldCol);
    bmpINVAND := TBitmap.Create;
    bmpINVAND.Width := Bmp.Width;
    bmpINVAND.Height := Bmp.Height;
    bmpINVAND.Monochrome := True;
    BitBlt(bmpINVAND.Canvas.Handle, 0, 0, Bmp.Width,Bmp.Height, bmpAND.Canvas.Handle, 0, 0, NOTSRCCOPY);
    bmpXOR := TBitmap.Create;
    bmpXOR.Width := Bmp.Width;
    bmpXOR.Height := Bmp.Height;
    BitBlt(bmpXOR.Canvas.Handle, 0, 0, Bmp.Width,Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(bmpXOR.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpINVAND.Canvas.Handle, 0, 0, SRCAND);
    bmpTarget := TBitmap.Create;
    bmpTarget.Width := Bmp.Width;
    bmpTarget.Height := Bmp.Height;
    BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Canvas.Handle, X, Y, SRCCOPY);
    BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpAND.Canvas.Handle, 0, 0, SRCAND);
    BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpXOR.Canvas.Handle, 0, 0, SRCINVERT);
    BitBlt(Canvas.Handle, X, Y, Bmp.Width,Bmp.Height, bmpTarget.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    bmpXOR.Free;
    bmpAND.Free;
    bmpINVAND.Free;
    bmpTarget.Free;
  end;
end;

При использовании материала - ссылка на сайт обязательна