Delphi World - Наклон изображения по вертикали и горизонтали
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Наклон изображения по вертикали и горизонтали

Автор: Fenik
WEB-сайт: http://delphibase.endimus.com

{ **** 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); 
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования