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;

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