Зеркальное отражение изображения с градиентом - Графика - Delphi программирование - Каталог статей

Наверное многие хотели бы реализовать при помощи функций Delphi подобный эффект,- зеркальное отражение изображения с градиентом.

Реализовывается всё то что показано на изображении вот так:
1.Создаём в памяти новый TBitmap в который копируем исходное изображение, после чего переворачиваем его вот такой вот функцией.

procedure FlipBitmap(bitmap: tbitmap; fliphor: boolean);
   var
x, y, w, h: integer;
pixel_1, pixel_2: prgbtriple;
mempixel: trgbtriple;
   begin
bitmap.pixelformat := pf24bit;
w := bitmap.width - 1;
h := bitmap.height - 1;
if fliphor then for y := 0 to h do
   begin
pixel_1 := bitmap.scanline[y];
pixel_2 := bitmap.scanline[y];
inc(pixel_2, w);
for x := 0 to w div 2 do
begin
mempixel := pixel_1^;
pixel_1^ := pixel_2^;
pixel_2^ := mempixel;
inc(pixel_1); dec(pixel_2);
end;
end
   else for y := 0 to h div 2 do
begin
pixel_1 := bitmap.scanline[y];
pixel_2 := bitmap.scanline[h - y];
for x := 0 to w do
   begin
mempixel := pixel_1^;
pixel_1^ := pixel_2^;
pixel_2^ := mempixel;
inc(pixel_1);
inc(pixel_2);
end;
end;
end;

Использование: flipbitmap(bmp2,false); false-переворот вниз (вертикально), true-переворот в сторону (горизонтально).
2.Налаживаем на перевёрнутое изображение градиент.

Code

procedure ImageGradient(bitmap: tbitmap; p:boolean);
type
TRGB = record
r: byte;
g: byte;
b: byte;
end;
ARGB = array[0..1]of TRGB;
PARGB = ^ARGB;
var
pb, ps: PARGB;
x,y,b:integer;

function Min(a, b: Longint): Longint;
begin
if a > b then Result := b else  Result := a;
end;

function convertByte(BaseColor: TColor): TColor;
begin
if p=true then b:=Y else b:=x;
Result := RGB(Min(GetRValue(ColorToRGB(BaseColor)) + round(255*b/bitmap.Height), 255),
Min(GetGValue(ColorToRGB(BaseColor))+ round(255*b/bitmap.Height), 255),
Min(GetBValue(ColorToRGB(BaseColor))+ round(255*b/bitmap.Height), 255));
end;
begin
bitmap.Assign(bitmap);
bitmap.PixelFormat:=pf24bit;
for y:=0 to bitmap.Height-1 do
begin
pb:=bitmap.scanline[y];
ps:=bitmap.scanline[y];
for x:=0 to bitmap.Width-1 do
begin
ps[x].r:=convertByte(pb[x].r);
ps[x].g:=convertByte(pb[x].g);
ps[x].b:=convertByte(pb[x].b)
end;
end;
end;

Использование: ImageGradient(bmp2,true); false-горизонтальный градиент, true-вертикальный градиент.

3.Приклеиваем изменённое изображение к иcходному:

Code

bmp := TBitmap.Create;
bmp1 := TBitmap.Create;
bmp2 := TBitmap.Create;
bmp1.Assign(Image1.Picture.Graphic);
bmp2.Assign(Image1.Picture.Graphic);
bmp.Width:= bmp1.Width;
bmp.Height := bmp1.Height+bmp2.Height;
try
flipbitmap(bmp2,false);
imagegradient(bmp2,true);
bmp.Canvas.StretchDraw(Rect(0, 0, bmp.Width, BMP1.Height), BMP1);
bmp.Canvas.StretchDraw(Rect(0,BMP1.Height, bmp.Width,BMP1.Height+bmp2.Height), BMP2);
finally
bmp.free;
bmp1.free;
bmp2.free;