[roamer]

Вот какой-то старый (в библах нашелся).
Но не помню, насколько он эффективен.

Код:

function ResizeBMP_to_small(BMP0 : TBitmap; Kx :  real) : boolean;
//Масштабирование (уменьшение) BitMap
Type
  TRGBTripleArray = array[word] of TRGBTriple;
  pRGBTripleArray = ^TRGBTripleArray;
Var
  BMP_x:  TBitMap;
  Yes : byte;
  kkk : integer;
  i            :  integer;
  j            :  integer;
  lookup       :  integer;
  RowIn        :  pRGBTripleArray;
  RowOut       :  pRGBTripleArray;
begin
  Result:=FALSE;
  Yes:=0;
  if Kx>=0.9999999999 then begin
     if BMP0<>NIL then begin
        if BMP0.Width>0 then begin
           if BMP0.Height>0 then begin
              if round(Kx)<BMP0.Width then begin
                 if round(Kx)<BMP0.Height then begin
                    Yes:=1;
                 end;
              end;
           end;
        end;
     end;
     if Yes>0 then begin
        //ShowMessage('1');
        BMP_x := TBitmap.Create;
        TRY
          BMP_x.Width  := round(BMP0.Width  / Kx);
          BMP_x.Height := round(BMP0.Height / Kx);
          BMP_x.PixelFormat := pf24bit;

          for j := 0 to (BMP_x.Height-1) do
           begin
            kkk:=round(Kx*j);
            RowIn  := BMP0.Scanline[kkk];
            RowOut := BMP_x.Scanline[j];
            for i := 0 to (BMP_x.Width-1) do
             begin
              lookup := round(Kx*i);
              RowOut[i] := RowIn[lookup];
            end;
          end;
          BMP0.Assign(BMP_x);
          Result:=TRUE;

        FINALLY
          BMP_x.Free;
        END;
     end;
  end;
end;