Вращение изображения
Вот быстрый и примитивный способ вращения изображения. Должно работать. По крайней мере хоть какой-то выход из-положения, поскольку Windows этого делать не умеет. Но сначала попробуйте на небольший изображениях.
procedure RotateRight(BitMap: tImage);
var
FirstC, LastC, c, r: integer;
procedure FixPixels(c, r: integer);
var
SavePix, SavePix2: tColor;
i, NewC, NewR: integer;
begin
SavePix := Bitmap.Canvas.Pixels[c, r];
for i := 1 to 4 do
begin
newc := BitMap.Height - r + 1;
newr := c;
SavePix2 := BitMap.Canvas.Pixels[newc, newr];
Bitmap.Canvas.Pixels[newc, newr] := SavePix;
SavePix := SavePix2;
c := Newc;
r := NewR;
end;
end;
begin
if BitMap.Width <> BitMap.Height then
exit;
BitMap.Visible := false;
with Bitmap.Canvas do
begin
firstc := 0;
lastc := BitMap.Width;
for r := 0 to BitMap.Height div 2 do
begin
for c := firstc to lastc do
begin
FixPixels(c, r);
end;
inc(FirstC);
Dec(LastC);
end;
end;
BitMap.Visible := true;
end;
Взято с https://delphiworld.narod.ru
...я думаю над принудительным грубым методом, но его эффективность может быть сомнительна, и не вздумайте пробовать его без сопроцессора!
Сделайте наложение пиксель-на-пиксель из исходного изображение на целевой (используя свойство Canvas.Pixels). Для каждого пикселя осуществите преобразование полярных координат, добавьте компенсирующий угол к полярной координате, затем спозиционируйте это обратно на координаты прямоугольника, и разместите пиксель с новыми координатами на целевом изображении. Также вы можете добавлять какой-либо псевдослучайный пиксель через определенное их количество, если хотите задать какую-то точность вашей операции.
Для преобразования X- и Y-координат объявлены следующие переменные:
X,Y = старые координаты пикселя
X1,Y1 = новые координаты пикселя
T = угол вращения (в радианах)
R, A - промежуточные величины, представляющие собой полярные координаты
R = Sqrt(Sqr(X) + Sqr(Y));
A = Arctan(Y/X);
X1 = R * Cos(A+T);
Y1 = R * Sin(A+T);
Я отдаю себе отчет, что это не оптимальное решение, поэтому, если вы найдете еще какое-либо решение, дайте мне знать. В действительности мой метод работает, но делает это очень медленно.
Создайте наложение пиксель-на-пиксель исходного изображение на целевое (используя свойство Canvas.Pixels).
...это хорошее начало, но я думаю другой способ будет немного лучшим. Создайте наложение пиксель-на-пиксель целевого изображения на исходное так, чтобы нам было нужно вычислять откуда брать нужные пиксели, а не думать над тем, куда их нужно поместить.
Для начала вот мой вариант формулы вращения:
x, y = координаты в целевом изображении
t = угол
u, v = координаты в исходном изображении
x = u * cos(t) - v * sin(t)
y = v * cos(t) + u * sin(t)
Теперь, если я захочу решить эти уравнения и вычислить u и v (привести их к правой части уравнения), то формулы будут выглядеть следующим образом (без гарантии, по этой причине я и включил исходные уравнения!):
x * cos(t) + y
u = --------------------
sqr(cos(t)) + sin(t)
v = y * cos(t) - x
--------------------
sqr(cos(t)) + sin(t)
Так, подразумевая, что вы уже знаете угол вращения, можно вычислить константы cos(t) и 1/sqr(cos(t))+sin(t) непосредственно перед самим циклом; это может выглядеть примерно так (приблизительный код):
ct := cos(t);
ccst := 1/sqr(cos(t))+sin(t);
for x := 0 to width do
for y := 0 to height do
dest.pixels[x,y] := source.pixels[Round((x * ct + y) * ccst),
Round((y * ct - x) * ccst)];
Если вы хотите ускорить этот процесс, и при этом волнуетесь за накопление ошибки округления, то вам следует обратить внимание на используемую нами технологию: мы перемещаем за один раз один пиксель, дистанция между пикселями равна u, v содержит константу, определяющую колонку с перемещаемым пикселем. Я использую расчитанные выше переменные как рычаг с коротким плечом (с вычисленной длиной и точкой приложения). Просто поместите в (x,y) = (1,0) и (x,y) = (0,1) и уравнение, приведенное выше:
duCol := ct * ccst;
dvCol := -ccst;
duRow := ccst;
dvRow := ct * ccst;
uStart := 0;
vStart := 0;
for x := 0 to width do
begin
u := uStart;
v := vStart;
for y := 0 to height do
begin
dest.pixels[x, y] := source.pixels[Round(u), Round(v)];
u := u + rowdu;
v := v + rowdv;
end;
uStart := uStart + duCol;
vStart := vStart + dvCol;
end;
Приведенный выше код можно использовать "как есть", и я не даю никаких гарантий отностительно его использования!
Если вы в душе испытатель, и хотите попробовать вращение вокруг произвольной точки, попробуйте поиграться со значенияим u и v:
Xp, Yp (X-sub-p, Y-sub-p) точка оси вращения, другие константы определены выше
x = Xp + (u - Xp) * cos(t) - (y - Yp) * sin(t)
y = Yp + (y - Yp) * cos(t) - (x - Xp) * sin(t)
Оригинальные уравнения:
x = u * cos(t) - v * sin(t)
y = v * cos(t) + u * sin(t)
верны, но когда я решаю их для u и v, я получаю это:
x * cos(t) + y * sin(t)
u = -----------------------
sqr(cos(t)) + sqr(sin(t))
y * cos(t) - x * sin(t)
v = ------------------------
sqr(cos(t)) + sqr(sin(t))
Взято с https://delphiworld.narod.ru
{**** UBPFD *********** by delphibase.endimus.ru ****
>> Вращение изображения на заданный угол
Зависимости: Windows, Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор Федоровских Николай
Дата: 2 июня 2002 г.
**************************************************** }
procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
type TRGB = record
B, G, R: Byte;
end;
pRGB = ^TRGB;
pByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
TRectList = array [1..4] of TPoint;
var x, y, W, H, v1, v2: Integer;
Dest, Src: pRGB;
VertArray: array of pByteArray;
Bmp: TBitmap;
procedure SinCos(AngleRad: Double; var ASin, ACos: Double);
begin
ASin := Sin(AngleRad);
ACos := Cos(AngleRad);
end;
function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double): TRectList;
var DX, DY: Integer;
SinAng, CosAng: Double;
function RotPoint(PX, PY: Integer): TPoint;
begin
DX := PX - Center.x;
DY := PY - Center.y;
Result.x := Center.x + Round(DX * CosAng - DY * SinAng);
Result.y := Center.y + Round(DX * SinAng + DY * CosAng);
end;
begin
SinCos(Angle * (Pi / 180), SinAng, CosAng);
Result[1] := RotPoint(Rect.Left, Rect.Top);
Result[2] := RotPoint(Rect.Right, Rect.Top);
Result[3] := RotPoint(Rect.Right, Rect.Bottom);
Result[4] := RotPoint(Rect.Left, Rect.Bottom);
end;
function Min(A, B: Integer): Integer;
begin
if A < B then Result := A
else Result := B;
end;
function Max(A, B: Integer): Integer;
begin
if A > B then Result := A
else Result := B;
end;
function GetRLLimit(const RL: TRectList): TRect;
begin
Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x));
Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y));
Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x));
Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y));
end;
procedure Rotate;
var x, y, xr, yr, yp: Integer;
ACos, ASin: Double;
Lim: TRect;
begin
W := Bmp.Width;
H := Bmp.Height;
SinCos(-Angle * Pi/180, ASin, ACos);
Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0), Angle));
Bitmap.Width := Lim.Right - Lim.Left;
Bitmap.Height := Lim.Bottom - Lim.Top;
Bitmap.Canvas.Brush.Color := BackColor;
Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
for y := 0 to Bitmap.Height - 1 do begin
Dest := Bitmap.ScanLine[y];
yp := y + Lim.Top;
for x := 0 to Bitmap.Width - 1 do begin
xr := Round(((x + Lim.Left) * ACos) - (yp * ASin));
yr := Round(((x + Lim.Left) * ASin) + (yp * ACos));
if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then begin
Src := Bmp.ScanLine[yr];
Inc(Src, xr);
Dest^ := Src^;
end;
Inc(Dest);
end;
end;
end;
begin
Bitmap.PixelFormat := pf24Bit;
Bmp := TBitmap.Create;
try
Bmp.Assign(Bitmap);
W := Bitmap.Width - 1;
H := Bitmap.Height - 1;
if Frac(Angle) <> 0.0
then Rotate
else
case Trunc(Angle) of
-360, 0, 360, 720: Exit;
90, 270: begin
Bitmap.Width := H + 1;
Bitmap.Height := W + 1;
SetLength(VertArray, H + 1);
v1 := 0;
v2 := 0;
if Angle = 90.0 then v1 := H
else v2 := W;
for y := 0 to H do VertArray[y] := Bmp.ScanLine[Abs(v1 - y)];
for x := 0 to W do begin
Dest := Bitmap.ScanLine[x];
for y := 0 to H do begin
v1 := Abs(v2 - x)*3;
with Dest^ do begin
B := VertArray[y, v1];
G := VertArray[y, v1+1];
R := VertArray[y, v1+2];
end;
Inc(Dest);
end;
end
end;
180: begin
for y := 0 to H do begin
Dest := Bitmap.ScanLine[y];
Src := Bmp.ScanLine[H - y];
Inc(Src, W);
for x := 0 to W do begin
Dest^ := Src^;
Dec(Src);
Inc(Dest);
end;
end;
end;
else Rotate;
end;
finally
Bmp.Free;
end;
end;
Пример использования:
RotateBitmap(FBitmap, 17.23, clWhite);
Взято из https://forum.sources.ru
const
PixelMax = 32768;
type
pPixelArray = ^TPixelArray;
TPixelArray = array [0..PixelMax-1] of TRGBTriple;
procedure RotateBitmap_ads(SourceBitmap: TBitmap;
out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
Radians : Double;
RotatedRow : pPixelArray;
sinRadians : Double;
begin
DestBitmap.Width := SourceBitmap.Width;
DestBitmap.Height := SourceBitmap.Height;
DestBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
sinRadians := Sin(Radians);
cosRadians := Cos(Radians);
for inX := DestBitmap.Height-1 downto 0 do
begin
RotatedRow := DestBitmap.Scanline[inX];
inXPrime := 2*(inX - Center.y) + 1;
for inY := DestBitmap.Width-1 downto 0 do
begin
inYPrime := 2*(inY - Center.x) + 1;
inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
inYOriginal := (inYPrimeRotated - 1) div 2 + Center.x;
inXOriginal := (inXPrimeRotated - 1) div 2 + Center.y;
if (inYOriginal >= 0) and (inYOriginal <= SourceBitmap.Width-1) and
(inXOriginal >= 0) and (inXOriginal <= SourceBitmap.Height-1) then
begin
OriginalRow := SourceBitmap.Scanline[inXOriginal];
RotatedRow[inY] := OriginalRow[inYOriginal]
end
else
begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
end;
end;
end;
end;
{Usage:}
procedure TForm1.Button1Click(Sender: TObject);
var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
try
Center.y := (Image.Height div 2)+20;
Center.x := (Image.Width div 2)+0;
RotateBitmap_ads(
Image.Picture.Bitmap,
Bitmap,
Center,
Angle);
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap);
finally
Bitmap.Free;
end;
end;
DelphiWorld 6.0
WEB-сайт: http://rax.ru/click?apg67108864.narod.ru/
Здесь я бы хотел рассказать не о том, как работать с DelphiX, OpenGL или Direct, а о том, как можно вращать многогранники с помощью простых действий: moveto и lineto.
Здесь рассмотрим пример вращения куба. Будем рисовать на Canvase (например Listbox). Сначала нарисуем врашающийся квадрат (точнее 2 квадрата и соединим их). Пусть q - угол поворота квадрата, который мы рисуем. Очевидно, что нам надо задать координаты вершин квадрата - a:array [1..5,1..2] of integer. 1..4+1 - количество вершин квадрата (почему +1 будет объяснено позже). 1..2 - координата по X и Y. Кто учился в школе, наверное помнит, что уравнение окружности: X^2+Y^2=R^2, кто хорошо учился в школе, возможно вспомнит уравнение эллипса: (X^2)/(a^2)+ (Y^2)/(b^2)=1. Но это нам не надо. Нам понадобится уравнение эллипса в полярных координатах: x=a*sin(t); y=a*cos(t);t=0..2*PI; (учащиеся университетов и институтов ликуют).
С помощью данного уравнения мы заполняем массив с координатами.
for i:=1 to 5 do
begin
// координата по Х; q+i*pi/2 - угол поворота
// i-той вершины квадрата.
a[i,1]:=trunc(80*sin(q+i*pi/2));
// координата по Y; знак минус - потому что координаты
// считаются с верхнего левого угла
a[i,1]:=trunc(-30*cos(q+i*pi/2));
end;
Сейчас будем рисовать квадрат:
for i:=1 to 4 do
begin
moveto(100+a[i,1],50+a[i,2]); //Встаем на i-ую точку квадрата.
lineto(100+a[i+1,1],50+a[i+1,2]); //Рисуем линию к i+1-ой точке.
Вот почему array[1..5,1..2], иначе - выход за границы. end;
Затем рисуем второй такой же квадрат, но пониже (или повыше). Соединяем линиями первый со вторым:
for i:=1 to 4 do
begin
moveto(100+a[i,1],50+a[i,2]);
lineto(100+a[i,1],130+a[i,2]);
end;
Осталось очистить Listbox, увеличить q и сделать сначала. Все!!!
Можно также скрывать невидимые линии - когда q находится в определенном интервале. Также можно поизвращаться: повернуть куб в другой плоскости - поворот осей(для тех, кто знает формулу).
DelphiWorld 6.0
function RotateBitmap(var hDIB: HGlobal; radang: Double; clrBack: TColor): Boolean;
// (c) Copyright original C Code: Code Guru
var
lpDIBBits: Pointer;
lpbi, hDIBResult: PBitmapInfoHeader;
bpp, nColors, nWidth, nHeight, nRowBytes: Integer;
cosine, sine: Double;
x1, y1, x2, y2, x3, y3, minx, miny, maxx, maxy, ti, x, y, w, h: Integer;
nResultRowBytes, nHeaderSize: Integer;
i, len: longint;
lpDIBBitsResult: Pointer;
dwBackColor: DWORD;
PtrClr: PRGBQuad;
RbackClr, GBackClr, BBackClr: Word;
sourcex, sourcey: Integer;
mask: Byte;
PtrByte: PByte;
dwpixel: DWORD;
PtrDWord: PDWord;
hDIBResInfo: HGlobal;
begin;
// Get source bitmap info
lpbi := PBitmapInfoHeader(GlobalLock(hdIB));
nHeaderSize := lpbi^.biSize + lpbi^.biClrUsed * SizeOf(TRGBQUAD);
lpDIBBits := Pointer(Longint(lpbi) + nHeaderSize);
bpp := lpbi^.biBitCount; // Bits per pixel
ncolors := lpbi^.biClrUsed; // Already computed when bitmap was loaded
nWidth := lpbi^.biWidth;
nHeight := lpbi^.biHeight;
nRowBytes := ((((nWidth * bpp) + 31) and (not 31)) shr 3);
// Compute the cosine and sine only once
cosine := cos(radang);
sine := sin(radang);
// Compute dimensions of the resulting bitmap
// First get the coordinates of the 3 corners other than origin
x1 := ceil(-nHeight * sine); // Originally floor at all places
y1 := ceil(nHeight * cosine);
x2 := ceil(nWidth * cosine - nHeight * sine);
y2 := ceil(nHeight * cosine + nWidth * sine);
x3 := ceil(nWidth * cosine);
y3 := ceil(nWidth * sine);
minx := min(0, min(x1, min(x2, x3)));
miny := min(0, min(y1, min(y2, y3)));
maxx := max(0, max(x1, max(x2, x3)));// added max(0,
maxy := max(0, max(y1, max(y2, y3)));// added max(0,
w := maxx - minx;
h := maxy - miny;
// Create a DIB to hold the result
nResultRowBytes := ((((w * bpp) + 31) and (not 31)) div 8);
len := nResultRowBytes * h;
hDIBResInfo := GlobalAlloc(GMEM_MOVEABLE, len + nHeaderSize);
if hDIBResInfo = 0 then
begin
Result := False;
Exit;
end;
hDIBResult := PBitmapInfoHeader(GlobalLock(hDIBResInfo));
// Initialize the header information
CopyMemory(hDIBResult, lpbi, nHeaderSize);
//BITMAPINFO &bmInfoResult = *(LPBITMAPINFO)hDIBResult ;
hDIBResult^.biWidth := w;
hDIBResult^.biHeight := h;
hDIBResult^.biSizeImage := len;
lpDIBBitsResult := Pointer(Longint(hDIBResult) + nHeaderSize);
// Get the back color value (index)
ZeroMemory(lpDIBBitsResult, len);
case bpp of
1:
begin //Monochrome
if (clrBack = RGB(255, 255, 255)) then
FillMemory(lpDIBBitsResult, len, $ff);
end;
4,
8:
begin //Search the color table
PtrClr := PRGBQuad(Longint(lpbi) + lpbi^.bisize);
RBackClr := GetRValue(clrBack);
GBackClr := GetGValue(clrBack);
BBackClr := GetBValue(clrBack);
for i := 0 to nColors - 1 do // Color table starts with index 0
begin
if (PtrClr^.rgbBlue = BBackClr) and
(PtrClr^.rgbGreen = GBackClr) and
(PtrClr^.rgbRed = RBackClr) then
begin
if (bpp = 4) then //if(bpp==4) i = i | i<<4;
ti := i or (i shl 4)
else
ti := i;
FillMemory(lpDIBBitsResult, ti, len);
break;
end;
Inc(PtrClr);
end;// If not match found the color remains black
end;
16:
begin
(* When the Compression field is set to BI_BITFIELDS,
Windows 95 supports
only the following 16bpp color masks: A 5-5-5 16-bit image, where the blue mask
is $001F, the green mask is $03E0, and the red mask is $7C00; and a 5-6-5
16-bit image, where the blue mask is $001F, the green mask is $07E0,
and the red mask is $F800. *)
PtrClr := PRGBQuad(Longint(lpbi) + lpbi^.bisize);
if (PtrClr^.rgbRed = $7c00) then // Check the Red mask
begin // Bitmap is RGB555
dwBackColor := ((GetRValue(clrBack) shr 3) shl 10) +
((GetRValue(clrBack) shr 3) shl 5) +
(GetBValue(clrBack) shr 3);
end
else
begin // Bitmap is RGB565
dwBackColor := ((GetRValue(clrBack) shr 3) shl 11) +
((GetRValue(clrBack) shr 2) shl 5) +
(GetBValue(clrBack) shr 3);
end;
end;
24,
32:
begin
dwBackColor := ((GetRValue(clrBack)) shl 16) or
((GetGValue(clrBack)) shl 8) or
((GetBValue(clrBack)));
end;
end;
// Now do the actual rotating - a pixel at a time
// Computing the destination point for each source point
// will leave a few pixels that do not get covered
// So we use a reverse transform - e.i. compute the source point
// for each destination point
for y := 0 to h - 1 do
begin
for x := 0 to w - 1 do
begin
sourcex := floor((x + minx) * cosine + (y + miny) * sine);
sourcey := floor((y + miny) * cosine - (x + minx) * sine);
if ((sourcex >= 0) and (sourcex < nWidth) and
(sourcey >= 0) and (sourcey < nHeight)) then
begin // Set the destination pixel
case bpp of
1:
begin //Monochrome
mask := PByte(Longint(lpDIBBits) +
nRowBytes * sourcey +
(sourcex div 8))^ and ($80 shr
(sourcex mod 8));
if mask <> 0 then
mask := $80 shr (x mod 8);
PtrByte := PByte(Longint(lpDIBBitsResult) +
nResultRowBytes * y + (x div
8));
PtrByte^ := PtrByte^ and (not ($80 shr (x mod
8)));
PtrByte^ := PtrByte^ or mask;
end;
4:
begin
if ((sourcex and 1) <> 0) then
mask := $0f
else
mask := $f0;
mask := PByte(Longint(lpDIBBits) +
nRowBytes * sourcey +
(sourcex div 2))^ and mask;
if ((sourcex and 1) <> (x and 1)) then
begin
if (mask and $f0) <> 0 then
mask := (mask shr 4)
else
mask := (mask shl 4);
end;
PtrByte := PByte(Longint(lpDIBBitsResult) +
nResultRowBytes * y + (x div
2));
if ((x and 1) <> 0) then
PtrByte^ := PtrByte^ and (not $0f)
else
PtrByte^ := PtrByte^ and (not $f0);
PtrByte^ := PtrByte^ or Mask;
end;
8:
begin
mask := PByte(Longint(lpDIBBits) +
nRowBytes * sourcey +
sourcex)^;
PtrByte := PByte(Longint(lpDIBBitsResult) +
nResultRowBytes * y + x);
PtrByte^ := mask;
end;
16:
begin
dwPixel := PDWord(Longint(lpDIBBits) +
nRowBytes * sourcey +
sourcex * 2)^;
PtrDword := PDWord(Longint(lpDIBBitsResult) +
nResultRowBytes * y + x * 2);
PtrDword^ := Word(dwpixel);
end;
24:
begin
dwPixel := PDWord(Longint(lpDIBBits) +
nRowBytes * sourcey +
sourcex * 3)^ and $ffffff;
PtrDword := PDWord(Longint(lpDIBBitsResult) +
nResultRowBytes * y + x * 3);
PtrDword^ := PtrDword^ or dwPixel;
end;
32:
begin
dwPixel := PDWord(Longint(lpDIBBits) +
nRowBytes * sourcey +
sourcex * 4)^;
PtrDword := PDWord(Longint(lpDIBBitsResult) +
nResultRowBytes * y + x * 4);
PtrDword^ := dwpixel;
end;
end; // Case
end
else
begin
// Draw the background color. The background color
// has already been drawn for 8 bits per pixel and less
case bpp of
16:
begin
PtrDWord := PDWord(Longint(lpDIBBitsResult) +
nResultRowBytes * y + x * 2);
PtrDword^ := Word(dwBackColor);
end;
24:
begin
PtrDWord := PDWord(Longint(lpDIBBitsResult) +
nResultRowBytes * y + x * 3);
PtrDword^ := PtrDword^ or dwBackColor;
end;
32:
begin
PtrDWord := PDWord(Longint(lpDIBBitsResult) +
nResultRowBytes * y + x * 4);
PtrDword^ := dwBackColor;
end;
end;
end;
end;
end;
GlobalUnLock(hDIBResInfo);
GlobalUnLock(hDIB);
GlobalFree(hDIB);
hDIB := hDIBResInfo;
Result := True;
end;
Взято с сайта: https://www.swissdelphicenter.ch