FAQ VCL
Графика

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

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

:: MVP ::

:: RSS ::

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

Как залить цветом фигуру произвольной формы?

// Способ первый
interface

//  function ExtFloodFill(DC: HDC; nXStart, nYStart: Integer;
//    crColor: COLORREF; fuFillType: Cardinal): Boolean; stdcall; external Gdi32;

implementation

///
/// Заливка области, ограниченной контуром
///
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then
   begin
      Canvas.Brush.Color := clRed; // Цвет заливки
      // clBlack - цвет контура заливаемой области
      ExtFloodFill( Canvas.Handle, X, Y, clBlack, FLOODFILLBORDER );
   end;
end;

// или

///
/// Заливка области, закрашенной цветом
///
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then
   begin
      Canvas.Brush.Color := clRed; // Цвет заливки
      // clBlue - цвет заливаемой области
      ExtFloodFill( Canvas.Handle, X, Y, clBlue, FLOODFILLSURFACE );
   end;
end;

// Способ второй
///
/// Заливка области, ограниченной контуром
///
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then
   begin
      Canvas.Brush.Color := clRed; // Цвет заливки
      // clBlack - цвет контура заливаемой области
      Canvas.FloodFill( X, Y, clBlack, fsBorder );
   end;
end;

// или

///
/// Заливка области, закрашенной цветом
///
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then
   begin
      Canvas.Brush.Color := clRed; // Цвет заливки
      // clBlue - цвет заливаемой области
      Canvas.FloodFill( X, Y, clBlue, fsSurface );
   end;
end;


Как вывести текст с "обрезанием", если он не помещается?

procedure TForm1.FormPaint(Sender: TObject);
var
  r: TRect;
begin
   r := Rect( 20, 20, 110, 70 );
   // DT_PATH_ELLIPSIS or DT_WORD_ELLIPSIS or DT_END_ELLIPSIS
   DrawTextEx( Form1.Canvas.Handle, 'О-о-о-чень длинны-ы-ы-ый текст',
               25, r, DT_WORD_ELLIPSIS, nil );
end;


Как вывести на Canvas иконку с глубиной цвета 32?

uses
  {...,} CommCtrl;

procedure TForm1.Button1Click(Sender: TObject);
var
  Ico: TIcon;
begin
   Ico := TIcon.Create;
   Ico.LoadFromFile('c:\test.ico');

   with TImageList.Create(Self) do
   begin
      Handle := ImageList_Create(Ico.Width, Ico.Height, ILC_COLOR32 or ILC_MASK,
         4 {ImageList.AllocBy}, 4 {ImageList.AllocBy});
      ImageList_AddIcon(Handle, Ico.Handle);
      Draw(Canvas, 0, 0, 0 {ImageIndex});
      ImageList_Destroy(Handle);
      Free;
   end;

   Ico.Free;
end;


Как определить яркость пикселя?

function GetColorLuminance(AColor: TColor): Integer;
var
  rgb: Integer;
begin
   rgb := ColorToRGB(AColor);
   Result := (GetRValue(rgb) * 77 +
              GetGValue(rgb) * 150 +
              GetBValue(rgb) * 29) shr 8; // div 256
end;

procedure TForm1.Image1Click(Sender: TObject);
var
  x, y: Integer;
  p: TPoint;
begin
   GetCursorPos(p);
   p := Image1.ScreenToClient(p);
   ShowMessage(IntToStr(GetColorLuminance(Image1.Canvas.Pixels[p.X, p.Y])));
end;


Как преобразовать RGB в HSL?

// Цветовая модель HSL является представлением модели RGB в цилиндрической системе координат.
// HSL представляет цвета более интуитивным и понятным для восприятия образом, чем типичное RGB.
// Модель часто используется в графических приложениях, в палитрах цветов, и для анализа изображений.
//
// HSL расшифровывается как Hue (цвет/оттенок), Saturation (насыщенность),
// Lightness/Luminance (светлота/светлость/светимость, не путать с яркостью).
//
// Hue задаёт положение цвета на цветовом круге (от 0 до 360). Saturation является процентным
// значением насыщенности (от 0% до 100%). Lightness является процентным значением светлости
// (от 0% до 100%).

uses
  Math;

type
  TRGB = record
    Red,
    Green,
    Blue: Byte;
  end;

  THSL = record
    Hue,
    Saturation,
    Lightness: Double;
  end;

/// <param name="v.Red">0..255</param>
/// <param name="v.Green">0..255</param>
/// <param name="v.Blue">0..255</param>
function RGB2HSL(v: TRGB): THSL;
var
  mx, mn: Double;
begin
   mx := Max(Max(v.Red, v.Green), v.Blue);
   mn := Min(Min(v.Red, v.Green), v.Blue);

   Result.Lightness := (mx + mn) / 510 * 100; // 510 = 2 * 255

   if (Result.Lightness = 0) or (mx = mn) then
      Result.Saturation := 0
   else if Result.Lightness <= 0.5 then
      Result.Saturation := (mx - mn) / (mx + mn)
   else if Result.Lightness <> 1 then
      Result.Saturation := (mx - mn) / (510 - mx - mn)
   else
      Result.Saturation := 1;
   Result.Saturation := Result.Saturation * 100;

   if mx = mn then
      Result.Hue := 0
   else if mx = v.Red then
      Result.Hue := 60 * (v.Green - v.Blue) / (mx - mn) + IfThen(v.Green < v.Blue, 360, 0)
   else if mx = v.Green then
      Result.Hue := 60 * (v.Blue - v.Red) / (mx - mn) + 120
   else
      Result.Hue := 60 * (v.Red - v.Green) / (mx - mn) + 240;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  _rgb: TRGB;
  _hsl: THSL;
begin
   _rgb.Red := $AA;
   _rgb.Green := $BB;
   _rgb.Blue := $CC;

   _hsl := RGB2HSL(_rgb);

   ShowMessage('Hue (H): ' + FloatToStr(_hsl.Hue) + Chr(176) + #13 +
               'Saturation (S): ' + Format('%.1f%%', [_hsl.Saturation]) + #13 +
               'Lightness (L): ' + Format('%.1f%%', [_hsl.Lightness]));
end;


Как преобразовать HSL в RGB?

// Цветовая модель HSL является представлением модели RGB в цилиндрической системе координат.
// HSL представляет цвета более интуитивным и понятным для восприятия образом, чем типичное RGB.
// Модель часто используется в графических приложениях, в палитрах цветов, и для анализа изображений.
//
// HSL расшифровывается как Hue (цвет/оттенок), Saturation (насыщенность),
// Lightness/Luminance (светлота/светлость/светимость, не путать с яркостью).
//
// Hue задаёт положение цвета на цветовом круге (от 0 до 360). Saturation является процентным
// значением насыщенности (от 0% до 100%). Lightness является процентным значением светлости
// (от 0% до 100%).

uses
  Math;

type
  TRGB = record
    Red,
    Green,
    Blue: Byte;
  end;

  THSL = record
    Hue,
    Saturation,
    Lightness: Double;
  end;

/// <param name="v.Hue">0..360</param>
/// <param name="v.Saturation">0..100</param>
/// <param name="v.Lightness">0..100</param>
function HSL2RGB(v: THSL): TRGB;
var
  q, p, h: Double;
  t, c: array[1..3] of Double;
  i: Integer;
begin
   v.Saturation := v.Saturation / 100;
   v.Lightness := v.Lightness / 100;

   if v.Lightness < 0.5 then
      q := v.Lightness * (1 + v.Saturation)
   else
      q := v.Lightness + v.Saturation - (v.Lightness * v.Saturation);

   p := 2 * v.Lightness - q;
   h := v.Hue / 360;
   t[1] := h + 1/3;
   t[2] := h;
   t[3] := h - 1/3;

   for i := 1 to 3 do
      if t[i] < 0 then
         t[i] := t[i] + 1
      else if t[i] > 1 then
         t[i] := t[i] - 1;

   for i := 1 to 3 do
      if t[i] < 1/6 then
         c[i] := (q - p) * 6 * t[i] + p
      else if InRange(t[i], 1/6, 0.5) then
         c[i] := q
      else if InRange(t[i], 0.5, 2/3) then
         c[i] := (q - p) * (2/3 - t[i]) * 6 + p
      else
         c[i] := p;

   Result.Red := Round(c[1] * 255);
   Result.Green := Round(c[2] * 255);
   Result.Blue := Round(c[3] * 255);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  _hsl: THSL;
  _rgb: TRGB;
begin
   _hsl.Hue := 210;
   _hsl.Saturation := 25.0;
   _hsl.Lightness := 73.3;

   _rgb := HSL2RGB(_hsl);

   ShowMessage('Red: ' + IntToStr(_rgb.Red) + #13 +
               'Green: ' + IntToStr(_rgb.Green) + #13 +
               'Blue: ' + IntToStr(_rgb.Blue));
end;


Как преобразовать RGB в HSB/HSV?

// HSB (также известна как HSV) похожа на HSL, но это две разные цветовые модели.
// Они обе основаны на цилиндрической геометрии, но HSB/HSV основана на модели «hexcone»,
// в то время как HSL основана на модели «bi-hexcone». Художники часто предпочитают
// использовать эту модель, принято считать что устройство HSB/HSV ближе к естественному
// восприятию цветов. В частности, цветовая модель HSB применяется в Adobe Photoshop.
//
// HSB/HSV расшифровывается как Hue (цвет/оттенок), Saturation (насыщенность),
// Brightness/Value (яркость/значение).
//
// Hue задаёт положение цвета на цветовом круге (от 0 до 360). Saturation является процентным
// значением насыщенности (от 0% до 100%). Brightness является процентным значением яркости
// (от 0% до 100%).

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

type
  TRGB = record
    Red,
    Green,
    Blue: Byte;
  end;

  THSB = record
    Hue,
    Saturation,
    Brightness: Double;
  end;

/// <param name="c.Red">0..255</param>
/// <param name="c.Green">0..255</param>
/// <param name="c.Blue">0..255</param>
function RGB2HSB(c: TRGB): THSB;
var
  mn, mx, Delta: Double;
  H, S, V: Double;
begin
   H := 0.0;
   mn := Min(Min(c.Red, c.Green), c.Blue);
   mx := Max(Max(c.Red, c.Green), c.Blue);
   Delta := mx - mn;

   V := mx;

   if mx <> 0.0 then
      S := 255.0 * Delta / mx
   else
      S := 0.0;

   if S <> 0.0 then
   begin
      if c.Red = mx then
         H := (c.Green - c.Blue) / Delta
      else
         if c.Green = mx then
            H := 2.0 + (c.Blue - c.Red) / Delta
         else
            if c.Blue = mx then
               H := 4.0 + (c.Red - c.Green) / Delta
   end
   else
      H := -1.0;
   H := H * 60 ;
   if H < 0.0 then
      H := H + 360.0;

   with Result do
   begin
      Hue := H ;                   // Hue -> 0..360
      Saturation := S * 100 / 255; // Saturation -> 0..100 %
      Brightness := V * 100 / 255; // Brightness -> 0..100 %
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  _rgb: TRGB;
  _hsb: THSB;
begin
   _rgb.Red := $AA;
   _rgb.Green := $BB;
   _rgb.Blue := $CC;

   _hsb := RGB2HSB(_rgb);

   ShowMessage('Hue (H): ' + FloatToStr(_hsb.Hue) + Chr(176) + #13 +
               'Saturation (S): ' + Format('%.1f%%', [_hsb.Saturation]) + #13 +
               'Brightness (B): ' + Format('%.1f%%', [_hsb.Brightness]));
end;

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

type
  TRGB = record
    Red,
    Green,
    Blue: Byte;
  end;

  THSB = record
    Hue,
    Saturation,
    Brightness: Double;
  end;

/// <param name="v.Red">0..255</param>
/// <param name="v.Green">0..255</param>
/// <param name="v.Blue">0..255</param>
function RGB2HSB(v: TRGB): THSB;
var
  r, g, b, dt: Double;
  mx, mn: Double;
begin
   r := v.Red / 255;
   g := v.Green / 255;
   b := v.Blue / 255;

   mx := Max(Max(r, g), b);
   mn := Min(Min(r, g), b);
   dt := mx - mn;

   // Hue -> 0..360
   if SameValue(dt, 0) then
      Result.Hue := 0
   else if SameValue(mx, r) then
      Result.Hue := 60 * Frac(((g - b) / dt) / 6)
   else if SameValue(mx, g) then
      Result.Hue := 60 * ((b - r) / dt + 2)
   else if SameValue(mx, b) then
      Result.Hue := 60 * ((r - g) / dt + 4);

   // Saturation -> 0..100 %
   if SameValue(mx, 0) then
      Result.Saturation := 0
   else
      Result.Saturation := dt / mx * 100;

   // Brightness -> 0..100 %
   Result.Brightness := mx * 100;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  _rgb: TRGB;
  _hsb: THSB;
begin
   _rgb.Red := $AA;
   _rgb.Green := $BB;
   _rgb.Blue := $CC;

   _hsb := RGB2HSB(_rgb);

   ShowMessage('Hue (H): ' + FloatToStr(_hsb.Hue) + Chr(176) + #13 +
               'Saturation (S): ' + Format('%.1f%%', [_hsb.Saturation]) + #13 +
               'Brightness (B): ' + Format('%.1f%%', [_hsb.Brightness]));
end;


Как преобразовать HSB/HSV в RGB?

// HSB (также известна как HSV) похожа на HSL, но это две разные цветовые модели.
// Они обе основаны на цилиндрической геометрии, но HSB/HSV основана на модели «hexcone»,
// в то время как HSL основана на модели «bi-hexcone». Художники часто предпочитают
// использовать эту модель, принято считать что устройство HSB/HSV ближе к естественному
// восприятию цветов. В частности, цветовая модель HSB применяется в Adobe Photoshop.
//
// HSB/HSV расшифровывается как Hue (цвет/оттенок), Saturation (насыщенность),
// Brightness/Value (яркость/значение).
//
// Hue задаёт положение цвета на цветовом круге (от 0 до 360). Saturation является процентным
// значением насыщенности (от 0% до 100%). Brightness является процентным значением яркости
// (от 0% до 100%).

uses
  {...,} Math;

type
  THSB = record
    Hue,
    Saturation,
    Brightness: Double;
  end;

/// <param name="c.Hue">0..360</param>
/// <param name="c.Saturation">0..100</param>
/// <param name="c.Brightness">0..100</param>
function HSVtoRGB(c: THSB): TColor;

  function RGBFP(R, G, B: Double): TColor;
  const
    RGBmax = 255;
  begin
     Result := RGB(Round(RGBmax * R), Round(RGBmax * G), Round(RGBmax * B));
  end;

var
  i: Integer;
  f, p, q, t: Double;
begin
   if c.Saturation = 0.0 then
   begin
      // achromatic (grey)
      Result := RGBFP(c.Brightness, c.Brightness, c.Brightness);
      Exit;
    end;

   c.Saturation := c.Saturation / 100;
   c.Brightness := c.Brightness / 100;

   c.Hue := c.Hue / 60; // sector 0 to 5
   i := Floor(c.Hue);
   f := c.Hue - i; // fractional part of H
   p := c.Brightness * (1 - c.Saturation);
   q := c.Brightness * (1 - c.Saturation * f);
   t := c.Brightness * (1 - c.Saturation * (1 - f));
   case i of
      0: Result := RGBFP(c.Brightness, t, p);
      1: Result := RGBFP(q, c.Brightness, p);
      2: Result := RGBFP(p, c.Brightness, t);
      3: Result := RGBFP(p, q, c.Brightness);
      4: Result := RGBFP(t, p, c.Brightness);
      5: Result := RGBFP(c.Brightness, p, q);
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  _hsb: THSB;
  c: TColor;
begin
   _hsb.Hue := 210;
   _hsb.Saturation := 16.7;
   _hsb.Brightness := 80;

   c := HSVtoRGB(_hsb);

   ShowMessage('Red: ' + IntToStr(GetRValue(c)) + #13 +
               'Green: ' + IntToStr(GetGValue(c)) + #13 +
               'Blue: ' + IntToStr(GetBValue(c)));
end;


Как проверить попадает ли точка в полигон?

const
  P: array[0..21] of TPoint = (
    (X: 196; Y: 362), (X: 283; Y: 392), (X: 368; Y: 381),
    (X: 432; Y: 341), (X: 482; Y: 386), (X: 455; Y: 430),
    (X: 352; Y: 458), (X: 270; Y: 461), (X: 165; Y: 434),
    (X: 92;  Y: 360), (X: 74;  Y: 276), (X: 67;  Y: 187),
    (X: 91;  Y: 101), (X: 185; Y: 43 ), (X: 293; Y: 23 ),
    (X: 415; Y: 24 ), (X: 495; Y: 80 ), (X: 513; Y: 168),
    (X: 488; Y: 279), (X: 383; Y: 312), (X: 296; Y: 315),
    (X: 180; Y: 298)
  );

procedure TForm1.Button1Click(Sender: TObject);
begin
   Canvas.Polygon(P);
end;

procedure TForm1.Button2Click(Sender: TObject);

  function PointInPolygon(Point: TPoint; const Polygon: array of TPoint): Boolean;
  var
    rgn: HRGN;
  begin
     rgn := CreatePolygonRgn(Polygon[0], Length(Polygon), WINDING);
     Result := PtInRegion(rgn, Point.X, Point.Y);
     DeleteObject(rgn);
  end;

var
  x, y: Integer;
begin
   x := Random(500);
   y := Random(500);
   ShowMessage(PointInPolygon(Point(x, y), P).ToString);
end;


Как нарисовать звезду?

/// <summary>
///   R - радиус описанного круга
///   r - радиус вписанного круга
///   d = R-r
/// </summary>
/// <param name="cx">Центр по x</param>
/// <param name="cy">Центр по y</param>
procedure TForm1.DrawStar(cx, cy, R: Integer; d: Integer = 0);
var
  i: Byte;
  a1, a2: Single;
begin
   Canvas.MoveTo(cx, cy-R);
   a1 := Pi/5 - Pi/2;
   a2 := -Pi/2;

   if d = 0 then
      d := R div 2;

   for i := 1 to 5 do
   begin
      Canvas.LineTo(cx + Round((R * Cos(Pi/5)-d) * Cos(a1+(i-1) * 2*Pi/5)),
                    cy + Round((R * Cos(Pi/5)-d) * Sin(a1+(i-1) * 2*Pi/5)));
      Canvas.LineTo(cx + Round(R * Cos(i*2*Pi/5+a2)),
                    cy + Round(R * Sin(i*2*Pi/5+a2)));
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   DrawStar(100, 100, 50);
   DrawStar(200, 100, 50);
   DrawStar(300, 100, 50);
   DrawStar(400, 100, 50);
end;

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