Библиотека графических эффектов в dll.

[DomiNick]

Точно не помню, но Гаусса скорее всего обычной формулой Пифагора считается (максимальное значение минус округлённое расстояние до центра окружности)...
А на что делить - так это просто сумма всех коэффициентов матрицы...

[Alex Cones]

(максимальное значение минус округлённое расстояние до центра окружности)...

Эм... Что-т не въехал...

Разобрался:

Function BMin(A : Integer):Byte;
Begin
 If A < 000 Then Result := 000
            Else Result := A;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var
 A : Array of Array of Integer;
 X, Y : Integer;
 R : Integer;
 S : string;
begin
 Memo1.Clear;
 R := StrToInt(Edit1.Text);
 SetLength(A, R*2 + 1, R*2 + 1);
 For Y := 0 to R*2 Do
  Begin
   For X := 0 to R*2 Do
    Begin
     A[X, Y] := BMin(Round((100 - (Sqrt(Sqr(X - R)+Sqr(Y - R)) * 100) / (R + 1) ) ));
     S := IntToStr(A[X,Y]);
     While Length(S) < 3 Do S:=' '+S;
     Memo1.Text := Memo1.text + S + ' ';
    End;
   Memo1.Lines.Add('');
  End;
end;

[DomiNick]

А... Уже... А я сижу, пример клепаю...

В принципе да, но у меня немного другой вариант:

Procedure TForm1.Button2Click(Sender: TObject);
Var x, y, N, K, L: Integer;
Begin
K:=SpinEdit1.Value; // размер квадратной матрицы (нечётный)
StringGrid1.RowCount:=K;
StringGrid1.ColCount:=K;
L:=K Div 2;
For y:=-L To L Do
      For x:=-L To L Do
            Begin
            N:=Trunc(K/2-Sqrt(x*x+y*y)+0.5);
            If N<0 Then
                  N:=0;
            StringGrid1.Cells[x+L, y+L]:=IntToStr(N);
            End;
End;

[Alex Cones]

Я понял, как решить проблему

Кстати никак не могу найти, как размывать Гауссом края изображения

:

For Y := 0 To BMP.bmHeight - 1 Do
    For X := 0 To BMP.bmWidth - 1 Do
     Begin
      Sum := 0;
      For Y1 := 0 To Level*2 Do
       For X1 := 0 To Level*2 Do
        Begin
         If ((Y + Y1 - Level) >= 0) And ((X + X1 - Level) >= 0) And ((Y + Y1 - Level) <= BMP.bmHeight) And ((X + X1 - Level) <= BMP.bmWidth)Then
          Begin
           RGBA[X, Y].Red := RGBA[X, Y].Red + Round(Ar[X + X1 - Level, Y + Y1 - Level].rgbtRed * GA[X1, Y1]);
           RGBA[X, Y].Blue := RGBA[X, Y].Blue + Round(Ar[X + X1 - Level, Y + Y1 - Level].rgbtBlue * GA[X1, Y1]);
           RGBA[X, Y].Green := RGBA[X, Y].Green + Round(Ar[X + X1 - Level, Y + Y1 - Level].rgbtGreen * GA[X1, Y1]);
           Sum := Sum + GA[X1, Y1];
          End;
        End;
      RGBA[X, Y].Red := Round(RGBA[X, Y].Red / Sum);
      RGBA[X, Y].Green := Round(RGBA[X, Y].Green / Sum);
      RGBA[X, Y].Blue := Round(RGBA[X, Y].Blue / Sum);
     End;

Правда Access Viola на выходе...

GA - матрица гаусса

RGBA - Type
 TRGB = Record
  Red   : Integer;
  Green : Integer;
  Blue  : Integer;
 End;

Снял копию с Ar, т.к. иначе придется брать размытие от размытых клеток.

[Alex Cones]

Все! Готово! Исправил ошибки и немного пооптимизировал.

Procedure FVFL_Blur(Handle: HBITMAP; Level : Byte); StdCall;
Var
 X, Y: Integer;
 BMP: BITMAP;
 P1, P2: PRGBTriple;
 Ar: Array Of Array Of PRGBTriple;
 GA : Array Of Array Of Byte;
 RGBA : Array Of Array Of TRGB;
 X1, Y1 : Byte;
 Sum : Integer;
Begin
 Windows.GetObject(Handle, SizeOf(Bmp), @BMP);
 SetLength(Ar, BMP.bmWidth, BMP.bmHeight);
 P1 := BMP.bmBits;
 If BMP.bmBitsPixel = 24 Then
  Begin
      For Y := 0 To BMP.bmHeight - 1 Do
            Begin
             P2 := P1;
             For X := 0 To BMP.bmWidth - 1 Do
                  Begin
                   Ar[X, Y] := P2;
                   Inc(P2);
                  End;
             Pointer(P1) := Pointer(Integer(P1) + BMP.bmWidthBytes);
            End;
   SetLength(GA, Level*2 + 1, Level*2 + 1);
   For Y := 0 to Level*2 Do
    For X := 0 to Level*2 Do
     GA[X, Y] := BMin(Round((100 - (Sqrt(Sqr(X - Level)+Sqr(Y - Level)) * 100) / (Level + 1) ) ));
   SetLength(RGBA, BMP.bmWidth, BMP.bmHeight);
   For Y := 0 To BMP.bmHeight - 1 Do
    For X := 0 To BMP.bmWidth - 1 Do
     Begin
      Sum := 0;
      For Y1 := 0 To Level*2 Do
       For X1 := 0 To Level*2 Do
        Begin
         If ((Y + Y1 - Level) >= 0) And
            ((X + X1 - Level) >= 0) And
            ((Y + Y1 - Level) < BMP.bmHeight) And
            ((X + X1 - Level) < BMP.bmWidth)Then
          Begin
           RGBA[X, Y].Red := RGBA[X, Y].Red + Round(Ar[X + X1 - Level, Y + Y1 - Level].rgbtRed * GA[X1, Y1]);
           RGBA[X, Y].Blue := RGBA[X, Y].Blue + Round(Ar[X + X1 - Level, Y + Y1 - Level].rgbtBlue * GA[X1, Y1]);
           RGBA[X, Y].Green := RGBA[X, Y].Green + Round(Ar[X + X1 - Level, Y + Y1 - Level].rgbtGreen * GA[X1, Y1]);
           Sum := Sum + GA[X1, Y1];
          End;
        End;
      Ar[X, Y].rgbtRed := Round(RGBA[X, Y].Red / Sum);
      Ar[X, Y].rgbtGreen := Round(RGBA[X, Y].Green / Sum);
      Ar[X, Y].rgbtBlue := Round(RGBA[X, Y].Blue / Sum);
     End;
  End
 Else
  MessageBox(0, 'Library error - 0x00', 'Error', MB_OK);
End;

еще что-то поддается оптимизации?