dibeffect.pas

很好玩的一个DELPHI游戏

{*******************************************************}
{                Magic Girl                             }
{         版权所有 (C) 2002, 2003 Rainstorey Studio     }
{         ---------------------------------             }
{       DIBEffect unit file modify DXDIBEffect.pas      }
{       by:2006-1-16 14:07:20                           }
{                                                       }
{         E-Mail:[e-mail]                     }
{         WebSite:http://www.Rainstorey.com             }
{*******************************************************}


unit DIBEffect;

interface

uses
  Windows,SysUtils,
  Math,DIB;

type
  TFilterTypeResample = (ftrBox,ftrTriangle,ftrHermite,ftrBell,ftrBSpline,
    ftrLanczos3,ftrMitchell);
const
  DefaultFilterRadius:array[TFilterTypeResample] of Single = (0.5,1,1,1.5,2,3,2);

type
  TDIBEffect = class(TDIB)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    procedure Effect_Lightness(Amount:Integer);
    procedure Effect_Darkness(Amount:Integer);
    procedure Effect_Mosaic(Size:Integer);
    procedure Effect_Emboss;

    { Published declarations }
  end;

implementation

function IntToByte(i:Integer):Byte;
begin
  if i > 255 then
    Result:=255
  else
    if i < 0 then
      Result:=0
    else
      Result:=i;
end;

procedure _Lightness(var clip:TDIB;Amount:Integer);
var
  p0:pbytearray;
  r,g,b,x,y:Integer;
begin
  for y:=0 to clip.height - 1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.width - 1 do
    begin
      r:=p0[x * 3];
      g:=p0[x * 3 + 1];
      b:=p0[x * 3 + 2];
      p0[x * 3]:=IntToByte(r + ((255 - r) * Amount) div 255);
      p0[x * 3 + 1]:=IntToByte(g + ((255 - g) * Amount) div 255);
      p0[x * 3 + 2]:=IntToByte(b + ((255 - b) * Amount) div 255);
    end;
  end;
end;

procedure Darkness(var src:TDIB;Amount:Integer);
var
  p0:pbytearray;
  r,g,b,x,y:Integer;
begin
  src.BitCount:=24;
  for y:=0 to src.height - 1 do
  begin
    p0:=src.scanline[y];
    for x:=0 to src.width - 1 do
    begin
      r:=p0[x * 3];
      g:=p0[x * 3 + 1];
      b:=p0[x * 3 + 2];
      p0[x * 3]:=IntToByte(r - ((r) * Amount) div 255);
      p0[x * 3 + 1]:=IntToByte(g - ((g) * Amount) div 255);
      p0[x * 3 + 2]:=IntToByte(b - ((b) * Amount) div 255);
    end;
  end;
end;

procedure Mosaic(var Bm:TDIB;Size:Integer);
var
  x,y,i,j:Integer;
  p1,p2:pbytearray;
  r,g,b:Byte;
begin
  y:=0;
  repeat
    p1:=Bm.scanline[y];
    repeat
      j:=1;
      repeat
        p2:=Bm.scanline[y];
        x:=0;
        repeat
          r:=p1[x * 3];
          g:=p1[x * 3 + 1];
          b:=p1[x * 3 + 2];
          i:=1;
          repeat
            p2[x * 3]:=r;
            p2[x * 3 + 1]:=g;
            p2[x * 3 + 2]:=b;
            Inc(x);
            Inc(i);
          until (x >= Bm.width) or (i > Size);
        until x >= Bm.width;
        Inc(j);
        Inc(y);
      until (y >= Bm.height) or (j > Size);
    until (y >= Bm.height) or (x >= Bm.width);
  until y >= Bm.height;
end;

procedure _Emboss(var Bmp:TDIB);
var
  x,y:Integer;
  p1,p2:pbytearray;
begin
  for y:=0 to Bmp.height - 2 do
  begin
    p1:=Bmp.scanline[y];
    p2:=Bmp.scanline[y + 1];
    for x:=0 to Bmp.width - 4 do
    begin
      p1[x * 3]:=(p1[x * 3] + (p2[(x + 3) * 3] xor $FF)) shr 1;
      p1[x * 3 + 1]:=(p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1;
      p1[x * 3 + 2]:=(p1[x * 3 + 2] + (p2[(x + 3) * 3 + 2] xor $FF)) shr 1;
    end;
  end;
end;

procedure Brightness(src,Dst:TDIB;level:Integer);
const
  MaxPixelCount = 32768;
type
  pRGBArray = ^TRGBArray;
  TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
var
  i,j,value:Integer;
  OrigRow,DestRow:pRGBArray;
begin
  // get brightness increment value
  value:=level;
  src.BitCount:=24;
  Dst.BitCount:=24;
  // for each row of pixels
  for i:=0 to src.height - 1 do
  begin
    OrigRow:=src.scanline[i];
    DestRow:=Dst.scanline[i];
    // for each pixel in row
    for j:=0 to src.width - 1 do
    begin
      // add brightness value to pixel's RGB values
      if value > 0 then
      begin
        // RGB values must be less than 256
        DestRow[j].rgbtRed:=Min(255,OrigRow[j].rgbtRed + value);
        DestRow[j].rgbtGreen:=Min(255,OrigRow[j].rgbtGreen + value);
        DestRow[j].rgbtBlue:=Min(255,OrigRow[j].rgbtBlue + value);
      end
      else
      begin
        // RGB values must be greater or equal than 0
        DestRow[j].rgbtRed:=Max(0,OrigRow[j].rgbtRed + value);
        DestRow[j].rgbtGreen:=Max(0,OrigRow[j].rgbtGreen + value);
        DestRow[j].rgbtBlue:=Max(0,OrigRow[j].rgbtBlue + value);
      end;
    end;
  end;
end;

//----------------------
//-------------------------
//----------------------

procedure TDIBEffect.Effect_Lightness(Amount:Integer);
var
  BB:TDIB;
begin
  BB:=TDIB.create;
  BB.BitCount:=24;
  BB.Assign(Self);
  _Lightness(BB,Amount);
  Self.Assign(BB);
  BB.free;
end;

procedure TDIBEffect.Effect_Darkness(Amount:Integer);
var
  BB:TDIB;
begin
  BB:=TDIB.create;
  BB.BitCount:=24;
  BB.Assign(Self);
  Darkness(BB,Amount);
  Self.Assign(BB);
  BB.free;
end;

procedure TDIBEffect.Effect_Mosaic(Size:Integer);
var
  BB:TDIB;
begin
  BB:=TDIB.create;
  BB.BitCount:=24;
  BB.Assign(Self);
  Mosaic(BB,Size);
  Self.Assign(BB);
  BB.free;
end;

procedure TDIBEffect.Effect_Emboss;
var
  BB1,BB2:TDIB;
begin
  BB1:=TDIB.create;
  BB1.BitCount:=24;
  BB1.Assign(Self);
  BB2:=TDIB.create;
  BB2.BitCount:=24;
  BB2.Assign(BB1);
  _Emboss(BB2);
  Self.Assign(BB2);
  BB1.free;
  BB2.free;
end;
end.