:: 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;
|
При использовании материала - ссылка на сайт обязательна
|
|