[Pythianproject-cvsmail] CVS: PythianProject/Source/Units FastDIB.pas,NONE,1.1 FastFX.pas,NONE,1.1 FastFiles.pas,NONE,1.1 FastQuant.pas,NONE,1.1 FastSize.pas,NONE,1.1

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory slayer.i.sourceforge.net:/tmp/cvs-serv13076

Added Files:
	FastDIB.pas FastFX.pas FastFiles.pas FastQuant.pas 
	FastSize.pas 
Log Message:
added fastLIB -mike

--- NEW FILE ---
unit FastDIB;       //  TFastDIB v2.5 updated: 9/6/99
                    //      by: Gordon Alex Cowie III
interface           //      www.jps.net/gfody
                    //
uses Windows;       //  TFastDIB wraps an upside down DIBSection and
                    //  gives you direct memory access to the pixels
{$IFDEF VER90}      //  via specially typed pointers, NOT procedures.
const hSection=nil; //  Pixels8, Pixels16, Pixels24, and Pixels32. You
type  Cint=Integer; //  must always pass the y-coordinate first! High
{$ELSE}             //  level functions Pixels[y,x] & PixelsB[y,x] are
{$IFDEF VER100}     //  provided as well. Please look over the interface
const hSection=0;   //  comments below.
type  Cint=Integer;
{$ELSE}
const hSection=0;
type  Cint=Cardinal;
{$ENDIF}
{$ENDIF}

type
  TFColor  = record b,g,r:Byte; end;
  TFColorA = record b,g,r,a:Byte; end;
  PFColor  =^TFColor;
  PFColorA =^TFColorA;
  TFColorTable = array[Byte]of TFColorA;
  PFColorTable =^TFColorTable;

  TLines    = array[Word]of Pointer;  PLines    =^TLines;
  TLine8    = array[Word]of Byte;     PLine8    =^TLine8;
  TLine16   = array[Word]of Word;     PLine16   =^TLine16;
  TLine24   = array[Word]of TFColor;  PLine24   =^TLine24;
  TLine32   = array[Word]of TFColorA; PLine32   =^TLine32;
  TPixels8  = array[Word]of PLine8;   PPixels8  =^TPixels8;
  TPixels16 = array[Word]of PLine16;  PPixels16 =^TPixels16;
  TPixels24 = array[Word]of PLine24;  PPixels24 =^TPixels24;
  TPixels32 = array[Word]of PLine32;  PPixels32 =^TPixels32;

  PBMInfo =^TBMInfo;
  TBMInfo = record
  bmiHeader: TBitmapInfoHeader;
  case Boolean of
    True:  (bmiColors:TFColorTable);
    False: (r,g,b:Longint);
  end;

TFastDIB = class
  hDC,                       // GDI surface of DIB
  BWidth,                    // width in bytes (word aligned)
  Height,                    // number of scanlines in DIB
  Gap,                       // distance between scanlines
  Mask,                      // specifies a mask for 16 & 32bit dibs ex: '565'
  Handle:     Integer;       // GDI handle of DIB
  Bits:       PLine8;        // address of DIB bits as an array of bytes
  Colors:     PFColorTable;  // address of DIB color table
  bmInfo:     TBMInfo;       // BitmapInfo structure
  Scanlines:  PLines;        // scanline offsets
  bshr,                      // these are the right and left shifts for
  gshr,gshl,                 // adjusting byte values to fit within your
  rshr,rshl:  Byte;          // mask for 16 & 32bit DIBs only
  Pixels8:    PPixels8;      // typed pointers to scanlines so that you can
  Pixels16:   PPixels16;     // access pixels[y,x] without function overhead
  Pixels24:   PPixels24;     // you must use 'Pixels8[y,x]' for 8bpp dibs
  Pixels32:   PPixels32;     // 'Pixels16[y,x]' for 16bpp dibs etc.
  constructor Create;
  destructor  Destroy; override;
  // bmInfo properties
  property    Compression:Cint read bmInfo.bmiHeader.biCompression write bmInfo.bmiHeader.biCompression;
  property    ClrUsed:CInt read bmInfo.bmiHeader.biClrUsed write bmInfo.bmiHeader.biClrUsed;
  property    BHeight:Longint read bmInfo.bmiHeader.biHeight write bmInfo.bmiHeader.biHeight;
  property    Width:Longint read bmInfo.bmiHeader.biWidth write bmInfo.bmiHeader.biWidth;
  property    Size:CInt read bmInfo.bmiHeader.biSizeImage write bmInfo.bmiHeader.biSizeImage;
  property    Bpp:Word read bmInfo.bmiHeader.biBitCount write bmInfo.bmiHeader.biBitCount;
  property    rMask:Longint read bmInfo.r write bmInfo.r;
  property    gMask:Longint read bmInfo.g write bmInfo.g;
  property    bMask:Longint read bmInfo.b write bmInfo.b;
  // procedural access to pixels for the lazies
  function    GetPixel(y,x:Integer):TFColor;
  function    GetPixelB(y,x:Integer):Byte;
  procedure   SetPixel(y,x:Integer;p:TFColor);
  procedure   SetPixelB(y,x:Integer;p:Byte);
  property    Pixels[y,x:Integer]:TFColor read GetPixel write SetPixel;
  property    PixelsB[y,x:Integer]:Byte read GetPixelB write SetPixelB;
  // initializers
  procedure   SetSize(fWidth,fHeight,fBpp,fMask:Integer);
  procedure   SetInterface(fBits:Pointer;fWidth,fHeight,fBpp,fMask:Integer);
  procedure   InitPixels(fBits:Pointer);
  procedure   LoadFromHandle(hBmp:Integer;fBpp:Byte;fMask:Integer);
  procedure   LoadFromFile(FileName:string;fBpp:Byte;fMask:Integer);
  procedure   LoadFromRes(Instance:Integer;ResID:string;fBpp:Byte;fMask:Integer);
  // GDI drawing methods
  procedure   Draw(fdc,x,y:Integer);
  procedure   Stretch(fdc,x,y,w,h:Integer);
  procedure   DrawRect(fdc,x,y,w,h,sx,sy:Integer);
  procedure   StretchRect(fdc,x,y,w,h,sx,sy,sw,sh:Integer);
  procedure   TileDraw(fdc,x,y,w,h:Integer);
  // other useful methods
  procedure   FillColors(i1,i2:Byte;c1,c2:TFColor);
  procedure   ShiftColors(Amount:Integer);
  function    MakePalette(Count:Byte):HPalette;
  function    CountColors:Longint;
  procedure   Flop;
end;

// some useful functions that should be macros but delphi doesn't
// support macros, so dont use these in really long loops without
// copying the code over or you'll really slow yourself down.

function Get16Mask:Integer;
function FRGB(r,g,b:Byte):TFColor;
function IntToColor(i:Integer):TFColor;
function IntToColorA(i:Integer):TFColorA;
function IntToByte(i:Integer):Byte;
function TrimInt(i,Min,Max:Integer):Integer;
function MaskToInt(r,g,b:DWord):Integer;

const // some colors
  tfBlack   : TFColor=(b:0;g:0;r:0);
  tfMaroon  : TFColor=(b:0;g:0;r:128);
  tfGreen   : TFColor=(b:0;g:128;r:0);
  tfOlive   : TFColor=(b:0;g:128;r:128);
  tfNavy    : TFColor=(b:128;g:0;r:0);
  tfPurple  : TFColor=(b:128;g:0;r:128);
  tfTeal    : TFColor=(b:128;g:128;r:0);
  tfGray    : TFColor=(b:128;g:128;r:128);
  tfSilver  : TFColor=(b:192;g:192;r:192);
  tfRed     : TFColor=(b:0;g:0;r:255);
  tfLime    : TFColor=(b:0;g:255;r:0);
  tfYellow  : TFColor=(b:0;g:255;r:255);
  tfBlue    : TFColor=(b:255;g:0;r:0);
  tfFuchsia : TFColor=(b:255;g:0;r:255);
  tfAqua    : TFColor=(b:255;g:255;r:0);
  tfLtGray  : TFColor=(b:192;g:192;r:192);
  tfDkGray  : TFColor=(b:128;g:128;r:128);
  tfWhite   : TFColor=(b:255;g:255;r:255);

implementation

constructor TFastDIB.Create;
begin
  inherited Create;
  FillChar(bmInfo,SizeOf(bmInfo),0);
  Colors:=@bmInfo.bmiColors;
  bmInfo.bmiHeader.biSize:=SizeOf(TBitmapInfoHeader);
  bmInfo.bmiHeader.biPlanes:=1;
  hDC:=0;   bshr:=0;   rshr:=0;    Handle:=0;
  Gap:=0;   gshr:=0;   rshl:=0;
  Mask:=0;  gshl:=0;   Height:=0;
end;

destructor TFastDIB.Destroy;
begin
  DeleteDC(hDC);
  DeleteObject(Handle);
  FreeMem(Scanlines);
  inherited Destroy;
end;

procedure TFastDIB.SetSize(fWidth,fHeight,fBpp,fMask:Integer);
begin
  if(fBpp<>Bpp)or(Width<>fWidth)or(Height<>fHeight)or(fMask<>Mask)then
  begin
    SetInterface(nil,fWidth,fHeight,fBpp,fMask);
    DeleteDC(hDC);
    DeleteObject(Handle);
    Handle:=CreateDIBSection(0,PBitmapInfo(@bmInfo)^,0,Pointer(Bits),hSection,0);
    hDC:=CreateCompatibleDC(0);
    SelectObject(hDC,Handle);
    InitPixels(Bits);
  end;
end;

procedure TFastDIB.SetInterface(fBits:Pointer;fWidth,fHeight,fBpp,fMask:Integer);
var
  sDC,
  i,x:  Integer;
  Base: Longint;
  n,b:  Byte;
begin
  if fBpp=0 then
  begin //default Bpp is current screen
    sDC:=GetDC(0);
    fBpp:=GetDeviceCaps(sDC,BITSPIXEL);
    ReleaseDC(0,sDC);
  end;
  if fMask=0 then
  begin //default Masks
    if fBpp=16 then fMask:=Get16Mask else
    if fBpp=32 then fMask:=888;
  end;
  Width:=fWidth; Height:=Abs(fHeight); BHeight:=-Height;
  Bpp:=fBpp; BWidth:=((Width*Bpp+31)and-32)shr 3;
  Size:=BWidth*Height; Mask:=fMask;
  if Bpp<8 then Gap:=BWidth-(Width div(8 div Bpp))else
  if Bpp>8 then Gap:=BWidth-(Width*(Bpp div 8))else Gap:=BWidth-Width;
  if(Bpp=16)or(Bpp=32)then
  begin
    Compression:=BI_BITFIELDS;
    if Bpp=16 then Base:=$FFFF else Base:=$FFFFFFFF;
    n:=0; b:=fMask mod 10; Inc(n,b); fMask:=fMask div 10;
    bMask:=Base shr(Bpp-n); bshr:=8-b; gshl:=b;
    b:=fMask mod 10; Inc(n,b); fMask:=fMask div 10;
    gMask:=Base shr(Bpp-n)and not bMask; rshl:=n; gshr:=8-b;
    b:=fMask mod 10; Inc(n,b); fMask:=fMask div 10;
    rMask:=Base shr(Bpp-n)and not(bMask or gMask); rshr:=8-b;
  end else Compression:=BI_RGB;
  if fBits<>nil then InitPixels(fBits);
end;

procedure TFastDIB.InitPixels(fBits:Pointer);
var
  x,i: Integer;
begin
  Bits:=fBits;
  ReallocMem(Scanlines,Height shl 2);
  x:=Integer(Bits);
  for i:=0 to Height-1 do
  begin
    Scanlines[i]:=Ptr(x);
    Inc(x,BWidth);
  end;
  Pixels8:=Pointer(Scanlines);
  Pixels16:=Pointer(Scanlines);
  Pixels24:=Pointer(Scanlines);
  Pixels32:=Pointer(Scanlines);
end;

procedure TFastDIB.SetPixel(y,x:Integer;p:TFColor); //inline
begin
  case Bpp of
    16: Pixels16[y,x]:=
          p.r shr rshr shl rshl or
          p.g shr gshr shl gshl or
          p.b shr bshr;
    24: Pixels24[y,x]:=p;
    32: PFColor(@Pixels32[y,x])^:=p;
  end;
end;

function TFastDIB.GetPixel(y,x:Integer):TFColor; //inline
var
  p:  Word;
  pd: DWord;
begin
  case Bpp of
    16: begin
          p:=Pixels16[y,x];
          Result.b:=p shl bshr;
          Result.g:=p shr gshl shl gshr;
          Result.r:=p shr rshl shl rshr;
        end;
    24: Result:=Pixels24[y,x];
    32: Result:=PFColor(@Pixels32[y,x])^;
  end;
end;

procedure TFastDIB.SetPixelB(y,x:Integer;p:Byte); //inline
var
  pb: PByte;
begin
  case Bpp of
    1: begin
         pb:=@Pixels8[y,x shr 3];
         pb^:=pb^ or p shl(7-(x mod 8));
       end;
    4: begin
         pb:=@Pixels8[y,x shr 1];
         if(x and 1)=0 then pb^:=pb^ or p shl 4
         else pb^:=pb^ or p;
       end;
    8: Pixels8[y,x]:=p;
  end;
end;

function TFastDIB.GetPixelB(y,x:Integer):Byte; //inline
var
  b: Byte;
begin
  case Bpp of
    1: begin
         b:=7-(x mod 8);
         Result:=Pixels8[y,x shr 3]and(1 shl b)shr b;
       end;
    4: if(x and 1)=0 then Result:=Pixels8[y,x shr 1]shr 4
       else Result:=Pixels8[y,x shr 1]and 15;
    8: Result:=Pixels8[y,x];
  end;
end;

procedure TFastDIB.LoadFromHandle(hBmp:Integer;fBpp:Byte;fMask:Integer);
var               // GetDIBits truncates 16bpp bitmaps to 15bpp (555)
  Bmp:   TBitmap; // when converting. To avoid this, specify a Bpp of
  memDC: Integer; // 24 or 32bpp and then use the 'Convert' function
begin             // in FastQuant.pas to convert it.
  GetObject(hBmp,SizeOf(Bmp),@Bmp);
  if fBpp=0 then SetSize(Bmp.bmWidth,Bmp.bmHeight,Bmp.bmBitsPixel,fMask)else
    SetSize(Bmp.bmWidth,Bmp.bmHeight,fBpp,fMask);
  memDC:=CreateCompatibleDC(0);
  SelectObject(memDC,hBmp);
  GetDIBits(memDC,hBmp,0,Height,Bits,PBitmapInfo(@bmInfo)^,0);
  DeleteDC(memDC);
end;

procedure TFastDIB.LoadFromFile(FileName:string;fBpp:Byte;fMask:Integer);
begin
  // I strongly recommend not using this function. Use the function
  // 'LoadBMPFile' in FastFiles.pas, its 50% faster and it supports
  // 16 & 32bpp bitmap files as this function doesn't.. also,
  // WindowsNT doesn't support LR_LOADFROMFILE
  LoadFromHandle(LoadImage(0,PChar(FileName),IMAGE_BITMAP,0,0,
      LR_LOADFROMFILE or LR_CREATEDIBSECTION),fBpp,fMask);
end;

procedure TFastDIB.LoadFromRes(Instance:Integer;ResID:string;fBpp:Byte;fMask:Integer);
begin
  LoadFromHandle(LoadImage(Instance,PChar(ResID),IMAGE_BITMAP,0,0,
      LR_LOADFROMFILE or LR_CREATEDIBSECTION),fBpp,fMask);
end;

procedure TFastDIB.Draw(fdc,x,y:Integer);
begin
  if(Bpp>8)and(hDC<>0)then
    BitBlt(fdc,x,y,Width,Height,hDC,0,0,SRCCOPY)else
    StretchDIBits(fdc,x,y,Width,Height,0,0,Width,Height,
      Bits,PBitmapInfo(@bmInfo)^,0,SRCCOPY);
end;

procedure TFastDIB.Stretch(fdc,x,y,w,h:Integer);
begin
  SetStretchBltMode(fdc,STRETCH_DELETESCANS);
  if(Bpp>8)and(hDC<>0)then
    StretchBlt(fdc,x,y,w,h,hDC,0,0,Width,Height,SRCCOPY)else
    StretchDIBits(fdc,x,y,w,h,0,0,Width,Height,Bits,
      PBitmapInfo(@bmInfo)^,0,SRCCOPY);
end;

procedure TFastDIB.DrawRect(fdc,x,y,w,h,sx,sy:Integer);
begin
  if(Bpp>8)and(hDC<>0)then
    BitBlt(fdc,x,y,w,h,hDC,sx,sy,SRCCOPY)else
  StretchDIBits(fdc,x,y,w,h,sx,sy,w,h,Bits,
    PBitmapInfo(@bmInfo)^,0,SRCCOPY);
end;

procedure TFastDIB.StretchRect(fdc,x,y,w,h,sx,sy,sw,sh:Integer);
begin
  SetStretchBltMode(fdc,STRETCH_DELETESCANS);
  if(Bpp>8)and(hDC<>0)then
    StretchBlt(fdc,x,y,w,h,hDC,sx,sy,sw,sh,SRCCOPY)else
    StretchDIBits(fdc,x,y,w,h,sx,sy,sw,sh,Bits,
      PBitmapInfo(@bmInfo)^,0,SRCCOPY);
end;

procedure TFastDIB.TileDraw(fdc,x,y,w,h:Integer);
var
  wd,hd,
  hBmp,
  memDC: Integer;
begin
  if(Width=0)or(Height=0)then Exit;
  memDC:=CreateCompatibleDC(fdc);
  hBmp:=CreateCompatibleBitmap(fdc,w,h);
  SelectObject(memDC,hBmp);
  Draw(memDC,0,0); wd:=Width; hd:=Height;
  while wd<w do
  begin
    BitBlt(memDC,wd,0,wd*2,h,memDC,0,0,SRCCOPY);
    Inc(wd,wd);
  end;
  while hd<h do
  begin
    BitBlt(memDC,0,hd,w,hd*2,memDC,0,0,SRCCOPY);
    Inc(hd,hd);
  end;
  BitBlt(fdc,x,y,w,h,memDC,0,0,SRCCOPY);
  DeleteDC(memDC); DeleteObject(hBmp);
end;

function TFastDIB.CountColors:Longint;
type
  TLut1  = array[Byte,Byte,0..31]of Byte; PLut1  =^TLut1;
  TLut8  = array[Byte]of Word;            PLut8  =^TLut8;
  TLut16 = array[Word]of Word;            PLut16 =^TLut16;
var
  c:     Byte;
  i:     Longint;
  w,x,y: Integer;
  pc:    PFColor;
  pca:   PFColorA;
  pw,lk: PWord;
  pb:    PByte;
  Lut1:  PLut1;
  Lut8:  PLut8;
  Lut16: PLut16;
begin
  i:=0;
  case Bpp of
    1: i:=Integer(PDWord(@Colors[0])^<>PDWord(@Colors[1])^)*2;
    4: // counting up to 16
    begin
      New(Lut8); FillChar(Lut8^,512,255);
      pb:=Pointer(Bits); w:=(Width div 2)-1;
      for y:=0 to Height-1 do
      begin
        for x:=0 to w do
        begin
          lk:=@Lut8[pb^ shr 4];
          if lk^=$FFFF then begin Inc(i); lk^:=0; end;
          lk:=@Lut8[pb^ and 15]; if lk^=$FFFF then begin Inc(i); lk^:=0; end;
          Inc(pb);
        end;
        Inc(pb,Gap);
      end;
      Dispose(Lut8);
    end;
    8: // counting up to 256
    begin
      New(Lut8); FillChar(Lut8^,512,255);
      pb:=Pointer(Bits);
      for y:=0 to Height-1 do
      begin
        for x:=0 to Width-1 do
        begin
          lk:=@Lut8[pb^];
          if lk^=$FFFF then begin Inc(i); lk^:=0; end;
          Inc(pb);
        end;
        Inc(pb,Gap);
      end;
      Dispose(Lut8);
    end;
    16: // counting up to 65536
    begin
      New(Lut16); FillChar(Lut16^,131072,255);
      pw:=Pointer(Bits);
      for y:=0 to Height-1 do
      begin
        for x:=0 to Width-1 do
        begin
          lk:=@Lut16[pw^];
          if lk^=$FFFF then begin Inc(i); lk^:=0; end;
          Inc(pw);
        end;
        pw:=Ptr(Integer(pw)+Gap);
      end;
      Dispose(Lut16);
    end;
    24: // counting up to 16777216
    begin
      New(Lut1); FillChar(Lut1^,$200000,0);
      pc:=Pointer(Bits);
      for y:=0 to Height-1 do
      begin
        for x:=0 to Width-1 do
        begin
          pb:=@Lut1[pc.r,pc.g,pc.b shr 3];
          c:=1 shl(pc.b and 7);
          if(c and pb^)=0 then begin Inc(i); pb^:=pb^ or c; end;
          Inc(pc);
        end;
        pc:=Ptr(Integer(pc)+Gap);
      end;
      Dispose(Lut1);
    end;
    32: // counting up to 16777216
    begin
      New(Lut1); FillChar(Lut1^,$200000,0);
      pca:=Pointer(Bits);
      for y:=0 to Height-1 do
      for x:=0 to Width-1 do
      begin
        pb:=@Lut1[pca.r,pca.g,pca.b shr 3];
        c:=1 shl(pca.b and 7);
        if(c and pb^)=0 then begin Inc(i); pb^:=pb^ or c; end;
        Inc(pca);
      end;
      Dispose(Lut1);
    end;
  end;
  Result:=i;
end;

procedure TFastDIB.ShiftColors(Amount:Integer);
var
  Buf: Pointer;
begin
  if Amount<0 then Amount:=256-(Abs(Amount) mod 256);
  if Amount>256 then Amount:=Amount mod 256; if Amount=0 then Exit;
  GetMem(Buf,Amount*4);
  Move(Ptr(Integer(Colors)+((256-Amount)*4))^,Buf^,Amount*4);
  Move(Colors^,Ptr(Integer(Colors)+(Amount*4))^,(256-Amount)*4);
  Move(Buf^,Colors^,Amount*4);
  FreeMem(Buf);
end;

procedure TFastDIB.FillColors(i1,i2:Byte;c1,c2:TFColor);
var
  ir,ig,ib,
  r,g,b:    Integer;
  pca:      PFColorA;
  i,x:      Byte;
begin
  x:=i2-i1;
  r:=c1.r shl 16; ir:=((c2.r-c1.r)shl 16)div x;
  g:=c1.g shl 16; ig:=((c2.g-c1.g)shl 16)div x;
  b:=c1.b shl 16; ib:=((c2.b-c1.b)shl 16)div x;
  pca:=@Colors[i1];
  for i:=0 to x do
  begin
    pca.r:=r shr 16; Inc(r,ir);
    pca.g:=g shr 16; Inc(g,ig);
    pca.b:=b shr 16; Inc(b,ib);
    Inc(pca);
  end;
end;

function TFastDIB.MakePalette(Count:Byte):HPalette;
type
  TLogPalette256 = record
    Ver,Count: Word;
    Entries:   array[Byte]of TPaletteEntry;
  end;
var
  Palette: TLogPalette256;
  Index:   Byte;
  PEntry:  PPaletteEntry;
  PColor:  PFColorA;
begin
  if Bpp>8 then
  begin
    if Count>(1 shl Bpp)-1 then Count:=(1 shl Bpp)-1 else
    if Count>235 then Count:=235; // max size of windows palette
    FillChar(Palette,SizeOf(Palette),0);
    Palette.Ver:=$300;
    Palette.Count:=Count+11;
    PEntry:=@Palette.Entries[10];
    PColor:=Pointer(Colors);
    for Index:=0 to Count do
    begin
      PEntry.peRed:=PColor.r;
      PEntry.peGreen:=PColor.g;
      PEntry.peBlue:=PColor.b;
      Inc(PEntry); Inc(PColor);
    end;
    Result:=CreatePalette(PLogPalette(@Palette)^);
  end;
end;

procedure TFastDIB.Flop;
var
  h,i:   Integer;
  p1,p2: Pointer;
  Buff:  PLine8;
begin
  GetMem(Buff,BWidth);
  h:=(Height-1)div 2;
  p1:=Bits; p2:=Scanlines[Height-1];
  for i:=0 to h do
  begin
    Move(p1^,Buff^,BWidth);
    Move(p2^,p1^,BWidth);
    Move(Buff^,p2^,BWidth);
    p1:=Ptr(Integer(p1)+BWidth);
    p2:=Ptr(Integer(p2)-BWidth);
  end;
  FreeMem(Buff);
end;

function Get16Mask:Integer; // returns 555 or 565 depending on the
var                         // current 16bit video mode via cheap
  sDC,bDC,hBM,c: Integer;   // trick, anyone got a better way?
begin
  sDC:=GetDC(0);
  bDC:=CreateCompatibleDC(sDC);
  hBM:=CreateCompatibleBitmap(sDC,1,1);
  SelectObject(bDC,hBM);
  SetPixel(bDC,0,0,RGB(0,100,0)); c:=GetPixel(bDC,0,0);
  DeleteDC(bDC); DeleteObject(hBM); ReleaseDC(0,sDC);
  if GetGValue(c)=100 then Result:=565 else Result:=555;
end;

function FRGBA(r,g,b,a:Byte):TFColorA;
begin
  Result.b:=b;
  Result.g:=g;
  Result.r:=r;
  Result.a:=a;
end;

function FRGB(r,g,b:Byte):TFColor;
begin
  Result.b:=b;
  Result.g:=g;
  Result.r:=r;
end;

function IntToColor(i:Integer):TFColor;
begin
  Result.b:=i shr 16;
  Result.g:=i shr 8;
  Result.r:=i;
end;

function IntToColorA(i:Integer):TFColorA;
begin
  Result.b:=i shr 16;
  Result.g:=i shr 8;
  Result.r:=i;
end;

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

function TrimInt(i,Min,Max:Integer):Integer;
begin
  if      i>Max then Result:=Max
  else if i<Min then Result:=Min
  else               Result:=i;
end;

function MaskToInt(r,g,b:DWord):Integer;
var
  ri,gi,bi: Integer;
begin
  ri:=0; gi:=0; bi:=0;
  if(r=0)or(g=0)or(b=0)then Exit;
  while (r and 1)=0 do r:=r shr 1;
  repeat
    Inc(ri);
    r:=r shr 1;
  until r=0;
  while (g and 1)=0 do g:=g shr 1;
  repeat
    Inc(gi);
    g:=g shr 1;
  until g=0;
  while (b and 1)=0 do b:=b shr 1;
  repeat
    Inc(bi);
    b:=b shr 1;
  until b=0;
  Result:=(ri*100)+(gi*10)+bi;
end;

end.

--- NEW FILE ---
unit FastFX;           // FastFX updated: 9/9/99
                       // by: gordy <gf...@jp...> www.jps.net/gfody
interface              //   Effects for TFastDIB. Please feel free to
                       //   contribute your filters/effects or optimizations!
uses Windows, FastDIB; //   huge thanks to Vit <vko...@in...> for his
                       //   kickass code & optimizations!
type
  TLut  = array[Byte]of Byte;    PLut  =^TLut;
  TWLut = array[Word]of Word;    PWLut =^TWLut;
  TSLut = array[Word]of Integer; PSLut =^TSLut;
  PSaturationLut =^TSaturationLut;
  TSaturationLut = record
    Grays: array[0..767]of Integer;
    Alpha: array[Byte]of Word;
  end;

function  ContrastLut(Amount:Integer):TLut;  //use luts(look up tables)with
function  LightnessLut(Amount:Integer):TLut; //applylut, you can apply many luts
function  AdditionLut(Amount:Integer):TLut;  //in one pass with MergeLuts
[...2348 lines suppressed...]
  end;
begin
  GetMem(sx,4*Dst.Width);
  GetMem(sy,4*Dst.Height);
  for lx:=0 to Dst.Width -1 do
    sx[lx]:=Round(Sin(lx/xDiv)*Ratio);
  for ly:=0 to Dst.Height-1 do
    sy[ly]:=Round(Sin(ly/yDiv)*Ratio);
  Max:=Integer(Src.Scanlines[Src.Height-1])+Src.BWidth;
  case Src.Bpp of
    8:  WaveWrap8;
    16: WaveWrap16;
    24: WaveWrap24;
    32: WaveWrap32;
  end;
  FreeMem(sx);
  FreeMem(sy);
end;

end.

--- NEW FILE ---
unit FastFiles;    // FastFiles updated: 9/6/99
                   // by: gordy <gf...@jp...> www.jps.net/gfody
interface          //   Functions for reading and writing different
                   //   graphic file formats to and from TFastDIB.
                   //   contributions are GREATLY appreciated!

uses Windows, Classes, FastDIB;

//low level
procedure DecodeRLE8(Bmp:TFastDIB;Data:Pointer);
procedure DecodeRLE4(Bmp:TFastDIB;Data:Pointer);
function  LoadBMPInfo(var Info:TBMInfo;Data:PLine8):Integer;
procedure LoadBMPData(Bmp:TFastDIB;Data:PLine8);
procedure LoadBMPStream(Bmp:TFastDIB;Stream:TStream);
procedure SaveBMPStream(Bmp:TFastDIB;Stream:TStream);
//high level
procedure LoadFromData(Bmp:TFastDIB;Data:Pointer);
procedure LoadFromStream(Bmp:TFastDIB;Stream:TStream);
procedure LoadFromFile(Bmp:TFastDIB;FileName:string);
procedure LoadFromRes(Bmp:TFastDIB;Instance:Integer;ResID:string);
procedure SaveToFile(Bmp:TFastDIB;FileName:string);

implementation

procedure DecodeRLE8(Bmp:TFastDIB;Data:Pointer);
var
  x,y,i: Integer;
  pb:    PByte;
begin
  pb:=Data; y:=0; x:=0;
  while y<Bmp.Height do
  begin
    if pb^=0 then
    begin
      Inc(pb);
      case pb^ of
        0:begin
            Inc(y);
            x:=0;
          end;
        1:Break;
        2:begin
            Inc(pb); Inc(x,pb^);
            Inc(pb); Inc(y,pb^);
          end;
        else
        begin
          i:=pb^; Inc(pb);
          Move(pb^,Bmp.Pixels8[y,x],i);
          Inc(pb,((i+1)and not 1)-1);
          Inc(x,i);
        end;
      end;
    end else
    begin
      i:=pb^; Inc(pb);
      FillChar(Bmp.Pixels8[y,x],i,pb^);
      Inc(x,i);
    end;
    Inc(pb);
  end;
end;

procedure DecodeRLE4(Bmp:TFastDIB;Data:Pointer);
var
  b1,b2,cb: Byte;
  x,y,i:    Integer;
  pb,pc:    PByte;
begin
  pb:=Data;
  cb:=pb^; x:=0; y:=0;
  while y<Bmp.Height do
  begin
    if cb=0 then
    begin
      Inc(pb); cb:=pb^;
      case cb of
        0:begin
            Inc(y);
            x:=0;
          end;
        1:Break;
        2:begin
            Inc(pb); Inc(x,pb^);
            Inc(pb); Inc(y,pb^);
          end;
        else
        begin
          for i:=1 to cb do
          begin
            pc:=@Bmp.Pixels8[y,x shr 1];
            if i and 1=1 then
            begin
              Inc(pb);
              b1:=pb^ shr 4;
              b2:=pb^ and $0F;
              if(x and 1)=0 then pc^:=pc^ or b1 shl 4
                else pc^:=pc^ or b1;
            end else
              if(x and 1)=0 then pc^:=pc^ or b2 shl 4
                else pc^:=pc^ or b2;
            Inc(x);
          end;
        end;
        if(cb shr 1)and 1=1 then Inc(pb);
      end;
    end else
    begin
      Inc(pb);
      b1:=pb^ shr 4;
      b2:=pb^ and $0F;
      for i:=1 to cb do
      begin
        pc:=@Bmp.Pixels8[y,x shr 1];
        if i and 1=1 then
          if(x and 1)=0 then pc^:=pc^ or b1 shl 4
            else pc^:=pc^ or b1
        else
          if(x and 1)=0 then pc^:=pc^ or b1 shl 4
            else pc^:=pc^ or b2;
        Inc(x);
      end;
    end;
    Inc(pb); cb:=pb^;
  end;
end;

function LoadBMPInfo(var Info:TBMInfo;Data:PLine8):Integer;
var
  i: Integer;
begin
  if Data[14]=12 then with PBitmapCoreHeader(@Data[14])^ do
  begin
    Info.bmiHeader.biWidth:=bcWidth;
    Info.bmiHeader.biHeight:=bcHeight;
    Info.bmiHeader.biBitCount:=bcBitCount;
    Info.bmiHeader.biCompression:=0;
    if bcBitCount<=8 then for i:=0 to(1 shl bcBitCount)-1 do
      Info.bmiColors[i]:=PFColorA(@Data[26+(i*3)])^;
  end else Info:=PBMInfo(@Data[14])^;
  Result:=PDWord(@Data[10])^;
end;

procedure LoadBMPData(Bmp:TFastDIB;Data:PLine8);
var
  Compress,Bits: Integer;
begin
  Bits:=LoadBMPInfo(Bmp.bmInfo,Data);
  Compress:=Bmp.Compression;
  with Bmp.bmInfo.bmiHeader do
  begin
    Bmp.SetSize(biWidth,biHeight,biBitCount,
      MaskToInt(Bmp.rMask,Bmp.gMask,Bmp.bMask));
    case Compress of
      0: Move(Data[Bits],Bmp.Bits^,Bmp.Size);
      1: DecodeRLE8(Bmp,@Data[Bits]);
      2: DecodeRLE4(Bmp,@Data[Bits]);
      3: Move(Data[Bits],Bmp.Bits^,Bmp.Size);
    end;
  end;
  Bmp.Flop;
end;

procedure LoadBMPStream(Bmp:TFastDIB;Stream:TStream);
var
  Bits,
  Compress: Integer;
  Buffer:   PLine8;
begin
  GetMem(Buffer,1078);
  if Stream.Size>=1078 then Stream.ReadBuffer(Buffer^,1078)else
    Stream.ReadBuffer(Buffer^,Stream.Size);
  Bits:=LoadBMPInfo(Bmp.bmInfo,Buffer);
  Compress:=Bmp.Compression;
  with Bmp.bmInfo.bmiHeader do
    Bmp.SetSize(biWidth,biHeight,biBitCount,
      MaskToInt(Bmp.rMask,Bmp.gMask,Bmp.bMask));
  Stream.Seek(Bits,soFromBeginning);
  if(Compress=1)or(Compress=2)then
  begin
    ReallocMem(Buffer,PDWord(@Buffer[2])^);
    Stream.ReadBuffer(Buffer^,Stream.Size-Stream.Position);
    if Compress=1 then DecodeRLE8(Bmp,Buffer) else DecodeRLE4(Bmp,Buffer);
  end else Stream.ReadBuffer(Bmp.Bits^,Bmp.Size);
  FreeMem(Buffer);
  Bmp.Flop;
end;

procedure SaveBMPStream(Bmp:TFastDIB;Stream:TStream);
var
  cSize,i: Integer;
  fHead:   TBitmapFileHeader;
  fCore:   TBitmapCoreHeader;
  Table:   array[Byte]of TFColor;
begin
  Bmp.Flop;
  if Bmp.ClrUsed<>0 then cSize:=(Bmp.ClrUsed*4) else
  if Bmp.Compression=BI_BITFIELDS then cSize:=12 else
  if Bmp.Bpp<=8 then cSize:=(1 shl Bmp.Bpp)*4 else cSize:=0;
  fHead.bfType:=$4D42;//"BM"
  if(Bmp.Compression=0)and(Bmp.ClrUsed=0)then
  begin
    cSize:=cSize div 4;
    for i:=0 to cSize-1 do
      Table[i]:=PFColor(@Bmp.Colors[i])^;
    cSize:=cSize*3;
    fHead.bfSize:=26+Bmp.Size+cSize;
    fHead.bfOffBits:=26+cSize;
    fCore.bcSize:=12;
    fCore.bcWidth:=Bmp.Width;
    fCore.bcHeight:=Bmp.Height;
    fCore.bcPlanes:=1;
    fCore.bcBitCount:=Bmp.Bpp;
    Stream.WriteBuffer(fHead,14);
    Stream.WriteBuffer(fCore,12);
    Stream.WriteBuffer(Table,cSize);
  end else
  begin
    fHead.bfSize:=54+Bmp.Size+cSize;
    fHead.bfOffBits:=54+cSize;
    Bmp.BHeight:=Abs(Bmp.BHeight);
    Stream.WriteBuffer(fHead,14);
    Stream.WriteBuffer(Bmp.bmInfo,40+cSize);
    Bmp.BHeight:=-Bmp.BHeight;
  end;
  Stream.Seek(fHead.bfOffBits,soFromBeginning);
  Stream.WriteBuffer(Bmp.Bits^,Bmp.Size);
  Bmp.Flop;
end;

{ ************************************************************************** }

procedure LoadFromData(Bmp:TFastDIB;Data:Pointer);
begin
  case PWord(Data)^ of
    $4D42: LoadBMPData(Bmp,Data);
    $8947:{LoadGIFData(Bmp,Data)};
    $D8FF:{LoadJPGData(Bmp,Data)};
  end;
end;

procedure LoadFromStream(Bmp:TFastDIB;Stream:TStream);
var
  Format: Word;
begin
  if Stream is TCustomMemoryStream then
    LoadFromData(Bmp,TCustomMemoryStream(Stream).Memory) else
  begin
    Stream.ReadBuffer(Format,2);
    Stream.Seek(-2,soFromCurrent);
    case Format of
      $4D42: LoadBMPStream(Bmp,Stream);
      $8947:{LoadGIFStream(Bmp,Stream)};
      $D8FF:{LoadJPGStream(Bmp,Stream)};
    end;
  end;
end;

procedure LoadFromFile(Bmp:TFastDIB;FileName:string);
var
  Stream: TFileStream;
begin
  Stream:=TFileStream.Create(FileName,0);//fmOpenRead
  LoadFromStream(Bmp,Stream);
  Stream.Free;
end;

procedure LoadFromRes(Bmp:TFastDIB;Instance:Integer;ResID:string);
begin
  LoadFromData(Bmp,
    LockResource(
    LoadResource(hInstance,
    FindResource(hInstance,PChar(ResID),RT_RCDATA))));
end;

procedure SaveToFile(Bmp:TFastDIB;FileName:string);
var
  Stream: TFileStream;
begin
//  Format:=Copy(FileName,Length(FileName)-2,4);
//  if Format='bmp' then
  Stream:=TFileStream.Create(FileName,$FFFF);//fmCreate
  SaveBMPStream(Bmp,Stream);
  Stream.Free;
end;

end.

--- NEW FILE ---
unit FastQuant;   //  FastQuant v1.0 (FastLIB)
                  //      -by: Gordon Alex Cowie III
interface         //      -updated: 7/7/99
                  //
uses FastDIB,     //    this unit contains methods for converting
     Windows;     //    TFastDIB to TFastDIB of different bpp
                  //    implementing FS dither and median cut color
                  //    quantization. Many Thanks to Vit Kovalcik!!
type
TConversionMode = (cmGDI,cmCut,cmDither,cmGray);

procedure Convert(Dst,Src:TFastDIB;cm:TConversionMode);
procedure ConvertB(Dst,Src:TFastDIB;Gray,Dither:Boolean;Colors:Byte);
procedure To1(Dib1,Dib:TFastDIB);
procedure To4(Dib4,Dib:TFastDIB);
procedure To8(Dib8,Dib:TFastDIB);
procedure To16(Dib16,Dib:TFastDIB);
procedure To24(Dib24,Dib:TFastDIB);
procedure To32(Dib32,Dib:TFastDIB);
[...2483 lines suppressed...]
      dib8.Colors[x2].b:=(Cubes[x2].z1+Cubes[x2].z2)shl 2;
    end;
    pb:=Pointer(dib8.Bits);
    pc:=Pointer(dib32.Bits);
    for x1:=0 to dib32.Height-1 do
    begin
      for y1:=0 to dib32.Width-1 do
      begin
        pb^:=Space[pc^.r shr 3,pc^.g shr 2,pc^.b shr 3];
        Inc(pb);
        Inc(pc);
      end;
      Inc(pb,dib8.Gap);
      pc:=Ptr(Integer(pc)+dib32.Gap);
    end;
  end;
  Dispose(Space);
end;

end.

--- NEW FILE ---
unit FastSize;         // FastSize updated: 8/19/99
                       // by: gordy <gf...@jp...> www.jps.net/gfody
interface              //   Functions for resampling one TFastDIB to
                       //   another TFastDIB of different size. These
uses Windows, FastDIB; //   functions assume that Src.Bpp = Dst.Bpp!

procedure Quick2x(Src,Dst:TFastDIB);//bpp > 4
procedure FastResize(Src,Dst:TFastDIB);//bpp > 4
procedure Bilinear(Src,Dst:TFastDIB);//8,24,32 only

implementation

procedure Quick2x(Src,Dst:TFastDIB);
  procedure Quick2x8;
  var
    x,y:   Integer;
    ps,pd: PByte;
  begin
    ps:=Pointer(Src.Bits);
    pd:=Pointer(Dst.Bits);
    for y:=0 to Src.Height-1 do
    begin
      for x:=0 to Src.Width-1 do
      begin
        pd^:=ps^; Inc(pd);
        pd^:=ps^; Inc(pd);
        Inc(ps);
      end;
      Inc(pd,Dst.Gap);
      Move(Ptr(Integer(pd)-Dst.BWidth)^,pd^,Dst.BWidth);
      Inc(pd,Dst.BWidth+Dst.Gap);
      Inc(ps,Src.Gap);
    end;
  end;
  procedure Quick2x16;
  var
    x,y:   Integer;
    ps,pd: PWord;
  begin
    ps:=Pointer(Src.Bits);
    pd:=Pointer(Dst.Bits);
    for y:=0 to Src.Height-1 do
    begin
      for x:=0 to Src.Width-1 do
      begin
        pd^:=ps^; Inc(pd);
        pd^:=ps^; Inc(pd);
        Inc(ps);
      end;
      pd:=Ptr(Integer(pd)+Dst.Gap);
      Move(Ptr(Integer(pd)-Dst.BWidth)^,pd^,Dst.BWidth);
      pd:=Ptr(Integer(pd)+Dst.BWidth+Dst.Gap);
      ps:=Ptr(Integer(ps)+Src.Gap);
    end;
  end;
  procedure Quick2x24;
  var
    x,y:   Integer;
    ps,pd: PFColor;
  begin
    ps:=Pointer(Src.Bits);
    pd:=Pointer(Dst.Bits);
    for y:=0 to Src.Height-1 do
    begin
      for x:=0 to Src.Width-1 do
      begin
        pd^:=ps^; Inc(pd);
        pd^:=ps^; Inc(pd);
        Inc(ps);
      end;
      pd:=Ptr(Integer(pd)+Dst.Gap);
      Move(Ptr(Integer(pd)-Dst.BWidth)^,pd^,Dst.BWidth);
      pd:=Ptr(Integer(pd)+Dst.BWidth+Dst.Gap);
      ps:=Ptr(Integer(ps)+Src.Gap);
    end;
  end;
  procedure Quick2x32;
  var
    x,y:   Integer;
    ps,pd: PFColorA;
  begin
    ps:=Pointer(Src.Bits);
    pd:=Pointer(Dst.Bits);
    for y:=0 to Src.Height-1 do
    begin
      for x:=0 to Src.Width-1 do
      begin
        pd^:=ps^; Inc(pd);
        pd^:=ps^; Inc(pd);
        Inc(ps);
      end;
      pd:=Ptr(Integer(pd)+Dst.Gap);
      Move(Ptr(Integer(pd)-Dst.BWidth)^,pd^,Dst.BWidth);
      pd:=Ptr(Integer(pd)+Dst.BWidth+Dst.Gap);
      ps:=Ptr(Integer(ps)+Src.Gap);
    end;
  end;
begin
  Dst.SetSize(Src.Width*2,Src.Height*2,Src.Bpp,Src.Mask);
  case Src.Bpp of
    8:  Quick2x8;
    16: Quick2x16;
    24: Quick2x24;
    32: Quick2x32;
  end;
end;

procedure FastResize(Src,Dst:TFastDIB);
var xp,yp,sx,sy: Integer;
  procedure FastResize8;
  var
    pc:   PByte;
    x,y:  Integer;
    Line: PLine8;
  begin
    yp:=0; pc:=Pointer(Dst.Bits);
    for y:=0 to Dst.Height-1 do
    begin
      Line:=Src.Scanlines[yp shr 16]; xp:=0;
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Line[xp shr 16];
        Inc(pc); Inc(xp,sx);
      end;
      Inc(pc,Dst.Gap);
      Inc(yp,sy);
    end;
  end;
  procedure FastResize16;
  var
    pc:   PWord;
    x,y:  Integer;
    Line: PLine16;
  begin
    yp:=0; pc:=Pointer(Dst.Bits);
    for y:=0 to Dst.Height-1 do
    begin
      Line:=Src.Scanlines[yp shr 16]; xp:=0;
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Line[xp shr 16];
        Inc(pc); Inc(xp,sx);
      end;
      pc:=Ptr(Integer(pc)+Dst.Gap);
      Inc(yp,sy);
    end;
  end;
  procedure FastResize24;
  var
    pc:   PFColor;
    x,y:  Integer;
    Line: PLine24;
  begin
    yp:=0; pc:=Pointer(Dst.Bits);
    for y:=0 to Dst.Height-1 do
    begin
      Line:=Src.Scanlines[yp shr 16]; xp:=0;
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Line[xp shr 16];
        Inc(pc); Inc(xp,sx);
      end;
      pc:=Ptr(Integer(pc)+Dst.Gap);
      Inc(yp,sy);
    end;
  end;
  procedure FastResize32;
  var
    pc:   PFColorA;
    x,y:  Integer;
    Line: PLine32;
  begin
    yp:=0; pc:=Pointer(Dst.Bits);
    for y:=0 to Dst.Height-1 do
    begin
      Line:=Src.Scanlines[yp shr 16]; xp:=0;
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Line[xp shr 16];
        Inc(pc); Inc(xp,sx);
      end;
      Inc(yp,sy);
    end;
  end;
begin
  if(Dst.Width<>Src.Width)or(Dst.Height<>Src.Height)then
  begin
    sx:=(Src.Width shl 16)div Dst.Width;
    sy:=(Src.Height shl 16)div Dst.Height;
    case Src.Bpp of
      8:  FastResize8;
      16: FastResize16;
      24: FastResize24;
      32: FastResize32;
    end;
  end else if(Dst.Width=Src.Width)and(Dst.Height=Src.Height)then
    Move(Src.Bits^,Dst.Bits^,Src.Size);
end;

procedure Bilinear(Src,Dst:TFastDIB);
var
  xP,yP,yP2,xP2,t,z,
  z2,iz2,w1,w2,w3,w4: Integer;
  procedure Bilinear8;
  var
    x,y:         Integer;
    pc,pc1,pc2:  PByte;
    Line1,Line2: PLine8;
  begin
    for y:=0 to Dst.Height-1 do
    begin
      xP:=0; Line1:=Src.Scanlines[yP shr 15];
      if yP shr 16<Src.Height-1 then Line2:=Src.Scanlines[yP shr 15+1]else
        Line2:=Src.Scanlines[yP shr 15];
      pc:=Dst.Scanlines[y]; z2:=yP and $7FFF; iz2:=$8000-z2;
      for x:=0 to Dst.Width-1 do
      begin
        t:=xP shr 15; pc1:=@Line1[t]; pc2:=@Line2[t]; z:=xP and $7FFF;
        w2:=(z*iz2)shr 15; w1:=iz2-w2; w4:=(z*z2)shr 15; w3:=z2-w4;
        pc^:=(pc1^*w1+PByte(Integer(pc1)+1)^*w2+pc2^*w3+PByte(Integer(pc2)+1)^*w4)shr 15;
        Inc(pc); Inc(xP,xP2);
      end;
      Inc(yP,yP2);
    end;
  end;
  procedure Bilinear24;
  var
    x,y:         Integer;
    pc,pc1,pc2:  PFColor;
    Line1,Line2: PLine24;
  begin
    for y:=0 to Dst.Height-1 do
    begin
      xP:=0; Line1:=Src.Scanlines[yP shr 15];
      if yP shr 16<Src.Height-1 then Line2:=Src.Scanlines[yP shr 15+1]else
        Line2:=Src.Scanlines[yP shr 15];
      pc:=Dst.Scanlines[y]; z2:=yP and $7FFF; iz2:=$8000-z2;
      for x:=0 to Dst.Width-1 do
      begin
        t:=xP shr 15; pc1:=@Line1[t]; pc2:=@Line2[t]; z:=xP and $7FFF;
        w2:=(z*iz2)shr 15; w1:=iz2-w2; w4:=(z*z2)shr 15; w3:=z2-w4;
        pc.b:=(pc1.b*w1+PFColor(Integer(pc1)+3).b*w2+pc2.b*w3+PFColor(Integer(pc2)+3).b*w4)shr 15;
        pc.g:=(pc1.g*w1+PFColor(Integer(pc1)+3).g*w2+pc2.g*w3+PFColor(Integer(pc2)+3).g*w4)shr 15;
        pc.r:=(pc1.r*w1+PFColor(Integer(pc1)+3).r*w2+pc2.r*w3+PFColor(Integer(pc2)+3).r*w4)shr 15;
        Inc(pc); Inc(xP,xP2);
      end;
      Inc(yP,yP2);
    end;
  end;
  procedure Bilinear32;
  var
    x,y:         Integer;
    pc,pc1,pc2:  PFColorA;
    Line1,Line2: PLine32;
  begin
    for y:=0 to Dst.Height-1 do
    begin
      xP:=0; Line1:=Src.Scanlines[yP shr 15];
      if yP shr 16<Src.Height-1 then Line2:=Src.Scanlines[yP shr 15+1]else
        Line2:=Src.Scanlines[yP shr 15];
      pc:=Dst.Scanlines[y]; z2:=yP and $7FFF; iz2:=$8000-z2;
      for x:=0 to Dst.Width-1 do
      begin
        t:=xP shr 15; pc1:=@Line1[t]; pc2:=@Line2[t]; z:=xP and $7FFF;
        w2:=(z*iz2)shr 15; w1:=iz2-w2; w4:=(z*z2)shr 15; w3:=z2-w4;
        pc.b:=(pc1.b*w1+PFColorA(Integer(pc1)+4).b*w2+pc2.b*w3+PFColorA(Integer(pc2)+4).b*w4)shr 15;
        pc.g:=(pc1.g*w1+PFColorA(Integer(pc1)+4).g*w2+pc2.g*w3+PFColorA(Integer(pc2)+4).g*w4)shr 15;
        pc.r:=(pc1.r*w1+PFColorA(Integer(pc1)+4).r*w2+pc2.r*w3+PFColorA(Integer(pc2)+4).r*w4)shr 15;
        Inc(pc); Inc(xP,xP2);
      end;
      Inc(yP,yP2);
    end;
  end;
begin
  yP:=0;
  if Src.Width=1 then FastResize(Src,Dst)else
  if(Dst.Width<>Src.Width)or(Dst.Height<>Src.Height)then
  begin
    xP2:=((Src.Width-1)shl 15)div Dst.Width;
    yP2:=((Src.Height-1)shl 15)div Dst.Height;
    case Src.Bpp of
      8:  Bilinear8;
      24: Bilinear24;
      32: Bilinear32;
    end;
  end else if(Dst.Width=Src.Width)and(Dst.Height=Src.Height)then
    Move(Src.Bits^,Dst.Bits^,Src.Size);
end;

end.