{ **** UBPFD *********** by delphibase.endimus.com ****
>> Наклон изображения по вертикали и горизонтали

Зависимости: Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор Федоровских Николай
Дата: 2 июня 2002 г.
***************************************************** }

procedure InclinationBitmap(Bitmap: TBitmap; Hor,
 Ver: Double; BackColor: TColor);

 function Tan(X: Extended): Extended;
 // Tan := Sin(X) / Cos(X)
 asm
 FLD X
 FPTAN
 FSTP ST(0) // FPTAN pushes 1.0 after result
 FWAIT
 end;

type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 x, y, WW, HH, alpha: Integer;
 OldPx, NewPx: PRGB;
 T: Double;
 Bmp: TBitmap;
begin
 Bitmap.PixelFormat := pf24Bit;
 Bmp := TBitmap.Create;
 try
 Bmp.Assign(Bitmap);
 WW := Bitmap.Width;
 HH := Bitmap.Height;
 if Hor <> 0.0 then
 begin // По горизонтали
 T := Tan(Hor * (Pi / 180));
 Inc(WW, Abs(Round(HH * T)));
 Bitmap.Width := WW;
 Bitmap.Canvas.Brush.Color := BackColor;
 Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
 for y := 0 to HH - 1 do
 begin
 if T > 0 then
 alpha := Round((HH - y) * T)
 else
 alpha := -Round(y * T);
 OldPx := Bmp.ScanLine[y];
 NewPx := Bitmap.ScanLine[y];
 Inc(NewPx, Alpha);
 for x := 0 to Bmp.Width - 1 do
 begin
 NewPx^ := OldPx^;
 Inc(NewPx);
 Inc(OldPx);
 end;
 end;
 Bmp.Assign(Bitmap);
 end;
 if Ver <> 0.0 then
 begin // По вертикали
 T := Tan(Ver * (Pi / 180));
 Bitmap.Height := HH + Abs(Round(WW * T));
 Bitmap.Canvas.Brush.Color := BackColor;
 Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
 for x := 0 to WW - 1 do
 begin
 if T > 0 then
 alpha := Round((WW - x) * T)
 else
 alpha := -Round(x * T);
 for y := 0 to Bmp.Height - 1 do
 begin
 NewPx := Bitmap.ScanLine[y + alpha];
 OldPx := Bmp.ScanLine[y];
 Inc(OldPx, x);
 Inc(NewPx, x);
 NewPx^ := OldPx^;
 end;
 end;
 end;
 finally
 Bmp.Free;
 end;
end;

Пример использования:

InclinationBitmap(FBitmap, 7.151, -5.8, clWhite);