{
TBitmapを使用してのカスタムフィルタ(5x5)のサンプルです。飛ぶ出す部分など
は補完しているのでかなり汚いコードですが、お役に立てれば幸いです。
}

type
  TOpValue = -999..999;  //オペレーターの許容範囲
  TOffSet  = -9999..9999;//オフセットの許容範囲
  TScale   = 1..9999;    //スケールの許容範囲

  //オペレーター
  TOperator    = array[-2..2, -2..2]of TOpValue;
  //マトリクス
  TMatrix      = array[-2..2, -2..2]of TRGBQuad;
  TQuadArray   = array[0..MaxInt div SizeOf(TRGBQuad) -1]of TRGBQuad;
  PQuadArray   = ^TQuadArray;
  TMatrixArray = array[-2..2]of PQuadArray;

//{$DEFINE ROUNDBYTE}

procedure CustomFilter(Source: TBitmap; Operator: TOperator;
  OffSet: TOffSet; Scale: TScale);
var
  Dest: TBitmap;
  x, y, W, H, yh, xw, mx, my, R, G, B: Integer;
  pSrcLine: TMatrixArray;
  pDstLine: PQuadArray;
  Matrix: TMatrix;
begin
  Source.PixelFormat := pf32bit;
  Dest := TBitmap.Create;
  try
    W  := Source.Width -1;
    xw := W -1;
    H  := Source.Height -1;
    yh := H -1;
    Dest.PixelFormat := pf32bit;
    Dest.Width       := Source.Width;
    Dest.Height      := Source.Height;
    for y := 0 to H do
    begin
      pDstLine := Dest.ScanLine[y];
      pSrcLine[0] := Source.ScanLine[y];
      //飛び出すラインは補完
      if y < 2 then
      begin
        if y = 0 then
        begin
          pSrcLine[-2] := Source.ScanLine[y];
          pSrcLine[-1] := Source.ScanLine[y];
        end else begin
          pSrcLine[-2] := Source.ScanLine[y];
          pSrcLine[-1] := Source.ScanLine[y-1];
        end;
      end else begin
        pSrcLine[-2] := Source.ScanLine[y-2];
        pSrcLine[-1] := Source.ScanLine[y-1];
      end;
      if y >= yh then
      begin
        if y = H then
        begin
          pSrcLine[1] := Source.ScanLine[y];
          pSrcLine[2] := Source.ScanLine[y];
        end else begin
          pSrcLine[1] := Source.ScanLine[y+1];
          pSrcLine[2] := Source.ScanLine[y];
        end;
      end else begin
        pSrcLine[1] := Source.ScanLine[y+1];
        pSrcLine[2] := Source.ScanLine[y+2];
      end;
      for x := 0 to W do
      begin
        {マトリクスにピクセルをマップする}
        for my := -2 to 2 do
          Matrix[0, my] := pSrcLine[my]^[x];
        //飛び出すピクセルは補完
        if x < 2 then
        begin
          if x = 0 then
          begin
            for my := -2 to 2 do
            begin
              Matrix[-1, my] := pSrcLine[my]^[x];
              Matrix[-2, my] := pSrcLine[my]^[x];
            end;
          end else begin
            for my := -2 to 2 do
            begin
              Matrix[-1, my] := pSrcLine[my]^[x-1];
              Matrix[-2, my] := pSrcLine[my]^[x-1];
            end;
          end;
        end else begin
          for my := -2 to 2 do
          begin
            Matrix[-1, my] := pSrcLine[my]^[x-1];
            Matrix[-2, my] := pSrcLine[my]^[x-2];
          end;
        end;
        if x >= xw then
        begin
          if x = W then
          begin
            for my := -2 to 2 do
            begin
              Matrix[1, my] := pSrcLine[my]^[x];
              Matrix[2, my] := pSrcLine[my]^[x];
            end;
          end else begin
            for my := -2 to 2 do
            begin
              Matrix[1, my] := pSrcLine[my]^[x+1];
              Matrix[2, my] := pSrcLine[my]^[x+1];
            end;
          end;
        end else begin
          for my := -2 to 2 do
          begin
            Matrix[1, my] := pSrcLine[my]^[x+1];
            Matrix[2, my] := pSrcLine[my]^[x+2];
          end;
        end;
        //演算(オペレーターに従って乗算)
        R := 0; G := 0; B := 0;
        for mx := -2 to 2 do
          for my := -2 to 2 do
          begin
            R := R + Matrix[mx, my].rgbRed   * Operator[mx, my];
            G := G + Matrix[mx, my].rgbGreen * Operator[mx, my];
            B := B + Matrix[mx, my].rgbBlue  * Operator[mx, my];
          end;
        //スケールで割ってオフセットを加算してできあがり
        R := Round(R / Scale) + OffSet;
        G := Round(G / Scale) + OffSet;
        B := Round(B / Scale) + OffSet;
{$IFDEF ROUNDBYTE}
        if R > 255 then R := 255 else if R < 0 then R := 0;
        if G > 255 then G := 255 else if G < 0 then G := 0;
        if B > 255 then B := 255 else if B < 0 then B := 0;
{$ENDIF}
        DWORD(pDstLine^[x]) := (R shl 16) or (G shl 8) or B;
      end;
    end;
    Source.Assign(Dest);
  finally
    Dest.Free;
  end;
end;

{使用例 (フォームにTImageとTButtonを貼り付けてイメージを読み込ませておい
てください)}
procedure TForm1.Button1Click(Sender: TObject);
var
  Operator: TOperator;
begin
  //エンボス(光源左上の場合)
  FillChar(Operator, SizeOf(TOperator), 0);
  Operator[-2, -2] := 1;
  Operator[2, 2]   := -1;
  CustomFilter(Image1.Picture.Bitmap, Operator, 128, 1);
end;

//                                               紅月　燐火(BZF05041)

Original document by 紅月　燐火      氏 ID:(BZF05041)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。