セピアカラーのサンプルコード(画像フィルター)

//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.

//------------------------------------------------------------------------------
// ■関数名    EffectSepia
// ■用途      セピアカラー
// ■引数
//             hBMP             ...処理対象ビットマップのハンドル
//■戻り値　
//             ビットマップのハンドル
// -----------------------------------------------------------------------------
function EffectSepia(hBMP :HBitmap):HBitmap;
var
  Row,Col        : Integer;
  SrcRow,DestRow : pRGBArray;
  RGBColor       : BYTE;
  SrcBitmap,DestBitmap : TBitmap;
begin
  SrcBitmap   :=TBitmap.Create;
  DestBitmap  :=TBitmap.Create;
  SrcBitmap.handle :=hBMP;
  Set24bit(SrcBitmap,DestBitmap);
try
  for Row:=0 to SrcBitmap.Height-1 do
  begin
    SrcRow:=SrcBitmap.ScanLine[Row];
    DestRow:=DestBitmap.ScanLine[Row];
    for Col:=0 to SrcBitmap.Width-1 do
    begin
      //NTSC系加重平均法を用いてグレースケール化
      RGBColor:=Set255(
                  (Round(SrcRow[Col].rgbtRed   *0.289+
                         SrcRow[Col].rgbtGreen *0.586+
                         SrcRow[Col].rgbtBlue  *0.114 )));

      // 色のバランスを調整する
      DestRow[Col].rgbtBlue :=Set255(RGBColor - 20);
      DestRow[Col].rgbtGreen:=RGBColor;
      DestRow[Col].rgbtRed  :=Set255(RGBColor + 30);
    end;
  end;
  Result :=DestBitmap.ReleaseHandle;
except
  Result :=SrcBitmap.ReleaseHandle;
end;
  SrcBitmap.Free ;
  DestBitmap.Free;
end;

  procedure TForm1.Button1Click(Sender: TObject);
  begin
    Image1.Picture.bitmap.Handle:= 関数名(Image1.Picture.Bitmap.ReleaseHandle);
  end;