"выдавливание" области рисунка

[Smogg]

О, а это уже интересно))
Можете на словах пояснить, как получился такой перелив?

И как приделать вращающийся свет?

[BDA]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, GDIPAPI, GDIPOBJ, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  GPSource: TGPBitmap;
  GPEffect: TGPBitmap;

const
  Xoffset = 150;
  Yoffset = 100;

implementation

{$R *.dfm}

procedure cut(a: real; var b: byte);
begin
  a := a + b;
  if a > 255 then
    b := 255
  else if a < 0 then
    b := 0
  else
    b := round(a);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  GPSource := TGPBitmap.Create('borders2.png');
  GPEffect := TGPBitmap.Create('borders2.png');
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
type
  pix = array [0 .. 1] of byte;
const
  dist = 15;
  k = 127;
  shadow = 0.2;
var
  bmData: TBitmapData;
  bmEf: TBitmapData;
  p: TGPPoint;
  s: TGPSize;
  i, j: Integer;
  b1, b2: ^pix;
  g, h: Integer;
  sumF: real;
  mindist, tmpdist: real;
  ip, jp: Integer;
begin
  p := MakePoint(0, 0);
  s := MakeSize(Integer(GPSource.GetWidth), Integer(GPSource.GetHeight));
  GPSource.LockBits(MakeRect(p, s), ImageLockModeRead,
    PixelFormat32bppARGB, bmData);
  GPEffect.LockBits(MakeRect(p, s), ImageLockModeRead and ImageLockModeWrite,
    PixelFormat32bppARGB, bmEf);
  b1 := bmData.Scan0;
  b2 := bmEf.Scan0;
  X := X - Xoffset - bmData.Width div 2;
  Y := Y - Yoffset - bmData.Height div 2;
  if (X = 0) and (Y = 0) then
  begin
    GPSource.UnlockBits(bmData);
    GPEffect.UnlockBits(bmEf);
    exit;
  end;
  MoveMemory(b2, b1, bmData.Width * bmData.Height * 4);
  for i := 0 to bmData.Height - 1 - 2 * dist do
  begin
    for j := 0 to bmData.Width - 1 - 2 * dist do
    begin
      // BGRA
      if b1[(i + dist) * bmData.stride + 4 * (j + dist) + 3] = 0 then
        continue;
      mindist := sqr(2 * dist);
      for g := i to i + 2 * dist do
        for h := j to j + 2 * dist do
          if (b1[g * bmData.stride + 4 * h + 3] = 0) then
          begin
            tmpdist := sqr(abs(i + dist - g)) + sqr(abs(j + dist - h));
            if tmpdist < mindist then
            begin
              ip := g;
              jp := h;
              mindist := tmpdist;
            end;
          end;
      mindist := sqrt(mindist);
      if mindist > dist then
        continue;
      ip := i + dist - ip;
      jp := j + dist - jp;
//      sumF := k * (-(ip * Y + jp * X) / (sqrt(ip * ip + jp * jp) *
//        sqrt(Y * Y + X * X)) * mindist / dist - shadow);
      sumF := k * (-(ip * Y + jp * X) / (sqrt(Y * Y + X * X) * dist) - shadow);//вроде то же самое, не проверял
      cut(sumF, b2[(i + dist) * bmEf.stride + 4 * (j + dist)]);
      cut(sumF, b2[(i + dist) * bmEf.stride + 4 * (j + dist) + 1]);
      cut(sumF, b2[(i + dist) * bmEf.stride + 4 * (j + dist) + 2]);
    end;
  end;
  GPSource.UnlockBits(bmData);
  GPEffect.UnlockBits(bmEf);
  repaint;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  graphicsGDIPlus: TGPGraphics;
begin
  graphicsGDIPlus := TGPGraphics.Create(Canvas.Handle);
  graphicsGDIPlus.SetSmoothingMode(4);
  graphicsGDIPlus.DrawImage(GPEffect, Xoffset, Yoffset);
  graphicsGDIPlus.Free;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  GPSource.Free;
  GPEffect.Free;
end;

end.

Курсор - источник света. Не гарантирую, что где-нибудь не вылезет деление на ноль
Оптимальности реализации также не гарантирую, так как не знаю GDI+.
Если в 2 словах. Ищется в радиусе прозрачная точка, к которой проводится нормаль. Ищется косинус угла между 2 векторами: первый вектор - центр картинки и курсор мыши, 2 вектор - нормаль.

[Smogg]

Большое Спасибо))
Направление освещения, правда, сбоит, ну да это мелочи и тригонометрия.
Осталось лишь перевести на свой ЯП и радоваться))))

А то я убил неделю, написал жуткую портянку, которая все равно выдает дрянь и безбожно тормозит.

[BDA]

Пожалуйста. Скажите, как именно сбоит.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, GDIPAPI, GDIPOBJ, ExtCtrls, Vcl.Imaging.pngimage;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  GPSource: TGPBitmap;
  GPEffect: TGPBitmap;

const
  Xoffset = 150;
  Yoffset = 100;

implementation

{$R *.dfm}

procedure cut(a: real; var b: byte);
begin
  a := a + b;
  if a > 255 then
    b := 255
  else if a < 0 then
    b := 0
  else
    b := round(a);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  GPSource := TGPBitmap.Create('borders2.png');
  GPEffect := TGPBitmap.Create('borders2.png');
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
type
  pix = array [0 .. 1] of byte;
const
  dist = 15;
  k = 127;
var
  bmData: TBitmapData;
  bmEf: TBitmapData;
  p: TGPPoint;
  s: TGPSize;
  i, j: Integer;
  b1, b2: ^pix;
  g, h: Integer;
  sumF: real;
  mindist, tmpdist: real;
  ip, jp: Integer;
begin
  p := MakePoint(0, 0);
  s := MakeSize(Integer(GPSource.GetWidth), Integer(GPSource.GetHeight));
  GPSource.LockBits(MakeRect(p, s), ImageLockModeRead,
    PixelFormat32bppARGB, bmData);
  GPEffect.LockBits(MakeRect(p, s), ImageLockModeRead and ImageLockModeWrite,
    PixelFormat32bppARGB, bmEf);
  b1 := bmData.Scan0;
  b2 := bmEf.Scan0;
  X := X - Xoffset - dist;
  Y := Y - Yoffset - dist;
  MoveMemory(b2, b1, bmData.Width * bmData.Height * 4);
  for i := 0 to bmData.Height - 1 - 2 * dist do
  begin
    for j := 0 to bmData.Width - 1 - 2 * dist do
    begin
      // BGRA
      if b1[(i + dist) * bmData.stride + 4 * (j + dist) + 3] = 0 then
        continue;
      mindist := sqr(2 * dist);
      for g := i to i + 2 * dist do
        for h := j to j + 2 * dist do
          if (b1[g * bmData.stride + 4 * h + 3] = 0) then
          begin
            tmpdist := sqr(abs(i + dist - g)) + sqr(abs(j + dist - h));
            if tmpdist < mindist then
            begin
              ip := g;
              jp := h;
              mindist := tmpdist;
            end;
          end;
      mindist := sqrt(mindist);
      if mindist > dist then
        continue;
      if (Y - i = 0) and (X - j = 0) then
        continue;
      ip := i + dist - ip;
      jp := j + dist - jp;
      sumF := k * (-(ip * (Y - i) + jp * (X - j)) /
        (dist * sqrt(sqr(Y - i) + sqr(X - j))));
      cut(sumF, b2[(i + dist) * bmEf.stride + 4 * (j + dist)]);
      cut(sumF, b2[(i + dist) * bmEf.stride + 4 * (j + dist) + 1]);
      cut(sumF, b2[(i + dist) * bmEf.stride + 4 * (j + dist) + 2]);
    end;
  end;
  GPSource.UnlockBits(bmData);
  GPEffect.UnlockBits(bmEf);
  repaint;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  graphicsGDIPlus: TGPGraphics;
begin
  graphicsGDIPlus := TGPGraphics.Create(Canvas.Handle);
  graphicsGDIPlus.SetSmoothingMode(4);
  graphicsGDIPlus.DrawImage(GPEffect, Xoffset, Yoffset, GPEffect.GetWidth,
    GPEffect.GetHeight);
  graphicsGDIPlus.Free;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  GPSource.Free;
  GPEffect.Free;
end;

end.

Теперь более честная модель - косинус угла между вектором падения света и нормалью.
Приближаемся к модели Фонга (https://ru.wikipedia.org/wiki/Затенение_по_Фонгу)