濃度抽出(メディアン - 中間濃度抽出)のサンプルコード

//Bass Unit
unit EffectBass;

interface
uses
 Windows,SysUtils, Classes, Graphics;

type
 //24bitアクセス用ポインタ
 pRGBarray  = ^TRGBarray;
 TRGBarray  = array[0..0] of TRGBTriple; //None リテラル

type
 //24bitアクセス用ダブルポインタ
 PPBits = ^TPBits;
 TPBits = array[0..0] of pRGBarray; //None リテラル

//汎用プロシージャ
procedure Set24bit(Src,Dest :TBitmap);
function  Set255(Value : integer) : BYTE;

implementation


/////////
procedure Set24bit(Src,Dest :Tbitmap);
begin
  Src.PixelFormat :=pf24bit;
  Dest.PixelFormat:=pf24bit;
  Dest.Width:=Src.Width;
  Dest.Height:=Src.Height;
end;

/////////
function Set255(Value:Integer):Byte;
begin
 if Value>=255 then
  Result:=255
 else if Value<=0 then
 Result:=0
 else Result:=Value;
end;
end.

//-----------------------------------------------------------------------------
//■関数     EffectMedian_Middle
//■用途     メディアン(中間濃度抽出)
//■引数     hBMP   ...転送元のビットマップのハンドル
//■戻り値
//           新しいビットマップのハンドル
//-----------------------------------------------------------------------------
function EffectMedian_Middle(hBMP: HBitmap):HBitmap;
var
  Row,Col,yRow,xCol,x,y: integer;
  DestRow       : pRGBArray;
  SrcBitmap,DestBitmap : TBitmap;
  SourceRows           : PPBits;
  R,G,B : array [0..8] of Byte;
  i,j : Dword;
  wrk : Byte;
begin
  SrcBitmap   := TBitmap.Create;
  DestBitmap  := TBitmap.Create;
  SrcBitmap.Handle  := hBMP;
  Set24bit(SrcBitmap,DestBitmap);

  ZeroMemory(@R,9);
  ZeroMemory(@G,9);
  ZeroMemory(@B,9);

  GetMem(SourceRows, SrcBitmap.Height * SizeOf(pRGBArray));
  try

    for Row:= 0 to SrcBitmap.Height - 1 do  SourceRows[Row]:=SrcBitmap.Scanline[Row];

    for Row := 0 To SrcBitmap.Height-1   do
    begin

         DestRow := DestBitmap.ScanLine[Row];
         For Col := 0 To SrcBitmap.Width-1 do
         begin

             //-------------
             // 0 - 1 - 2
             //-------------
             // 3 - 4 - 5
             //-------------
             // 6 - 7 - 8

             i:=0;  
             for y:= -1 to 1 do
             begin
               for x:= -1 to 1 do
               begin
                  // y軸
                  if  (Row+ y ) > SrcBitmap.Height-1 then yRow:=SrcBitmap.Height-1
                  else if Row+(y)< 0                 then yRow:=0
                  else                                    yRow:=Row+(y);
                  // x軸
                  if      Col+(x)> SrcBitmap.Width-1 then xCol:=SrcBitmap.Width-1
                  else if Col+(x)< 0                 then xCol:=0
                  else                                    xCol:=Col+(x);
 
                  B[i]:=SourceRows[yRow][xCol].rgbtBlue;
                  G[i]:=SourceRows[yRow][xCol].rgbtGreen;
                  R[i]:=SourceRows[yRow][xCol].rgbtRed;
                  inc(i);
               end;
             end;

             // バブルソート
             for i := 9 -1 downto 0 do
             begin
                for j := 1 to i do
                begin
                  // 現在の位置の値が一つ前の値より小さい場合は
                  if R[j-1] > R[j] then
                  begin
                    // 現在位置の値を変数に格納
                    wrk       := R[j];
                    // 前の値を現在の位置に格納
                    R[j]   := R[j-1];
                    // 現在位置の値を前の位置に格納
                    R[j-1] := wrk;
                  end;

                  if G[j-1] >G[j] then
                  begin
                    // 現在位置の値を変数に格納
                    wrk       := G[j];
                    // 前の値を現在の位置に格納
                    G[j]   := G[j-1];
                    // 現在位置の値を前の位置に格納
                    G[j-1] := wrk;
                  end;

                  if B[j-1] >B[j] then
                  begin
                    // 現在位置の値を変数に格納
                    wrk       := B[j];
                    // 前の値を現在の位置に格納
                    B[j]   := B[j-1];
                    // 現在位置の値を前の位置に格納
                    B[j-1] := wrk;
                  end;
                end;
              end;

             //  着目するピクセルの中間濃度値を取得
             DestRow[Col].rgbtRed   :=R[4];
             DestRow[Col].rgbtGreen :=G[4];
             DestRow[Col].rgbtBlue  :=B[4];
        end;
    end;
                       
    FreeMem(SourceRows); SourceRows:=nil;
    Result :=DestBitmap.ReleaseHandle;

  except
     if Assigned(SourceRows) then FreeMem(SourceRows);
     Result :=SrcBitmap.ReleaseHandle;
  end;
  SrcBitmap.Free ;
  DestBitmap.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Image1.Picture.Bitmap.Handle :=
      EffectMedian_Middle(Image1.Picture.Bitmap.ReleaseHandle);
end;