Вращение изображения
Материал из DRKB
Поворот на 90 градусов[править | править код]
Вот быстрый и примитивный способ вращения изображения. Должно работать. По крайней мере хоть какой-то выход из-положения, поскольку 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;
Source: http://delphiworld.narod.ru
ID: 03843
Поворот на заданный угол[править | править код]
...я думаю над принудительным грубым методом, но его эффективность может быть сомнительна, и не вздумайте пробовать его без сопроцессора!
Сделайте наложение пиксель-на-пиксель из исходного изображение на целевой (используя свойство 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) y * cos(t) - x v = -------------------- 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
begin
for y := 0 to height do
begin
Dest.Pixels[x, y] := Source.Pixels[Round((x * ct + y) * ccst), Round((y * ct - x) * ccst)];
end;
end;
Если вы хотите ускорить этот процесс, и при этом волнуетесь за накопление ошибки округления, то вам следует обратить внимание на используемую нами технологию: мы перемещаем за один раз один пиксель, дистанция между пикселями равна 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))
Source: http://delphiworld.narod.ru
ID: 03844
Вращение изображения на заданный угол[править | править код]
{**** 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);
Author: Fenik
Source: Взято из http://forum.sources.ru
ID: 03845
Поворот на заданный угол с записью в новый Bitmap[править | править код]
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;
Source: http://delphiworld.narod.ru/
ID: 03846
Вращение многогранников[править | править код]
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 находится в определенном интервале. Также можно поизвращаться: повернуть куб в другой плоскости - поворот осей(для тех, кто знает формулу).
Author: Айткулов Павел
Source: http://delphiworld.narod.ru/
ID: 03847
ID: 04107
Вращение Bitmap с учетом фонового цвета[править | править код]
// (c) Copyright original C Code: Code Guru
function RotateBitmap(var hDIB: HGlobal; radang: Double; clrBack: TColor): Boolean;
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;
Source: http://www.swissdelphicenter.ch
ID: 03848