Bitmap Resampling

 type
  PBitmap = ^TBitmap;
  TLine = array[0..MaxInt div SizeOf(TRGBQUAD) - 1] of TRGBQUAD;
  PLine = ^TLine;
  
  
//

function ResampleSubBitmap(Bitmap: TBitmap; XPos, YPos, Width, Height: Integer): TRGBQuad;
var
  r, g, b: Cardinal;
  Line: PLine;
  x, y, z: Integer;
begin
  z := (Width * Height);
  r := 0;
  g := 0;
  b := 0;
  if (YPos + Height) >= Bitmap.Height then Height := (Bitmap.Height - YPos) - 1;
  if (XPos + Width) >= Bitmap.Width then Width := (Bitmap.Width - XPos) - 1;
  for y := YPos to YPos + Height do
  begin
    Line := Bitmap.ScanLine[y];
    for x := XPos to XPos + Width do
    begin
      r := r + Line[x].rgbRed;
      g := g + Line[x].rgbGreen;
      b := b + Line[x].rgbBlue;
      Inc(z);
    end;
  end;

  if (z = 0) then z := 1;
  r := Round((r / z) * 1.4);
  if (r > 255) then r := 255;
  g := Round((g / z) * 1.4);
  if (g > 255) then g := 255;
  b := Round((b / z) * 1.4);
  if (b > 255) then b := 255;

  Result.rgbRed   := r;
  Result.rgbGreen := g;
  Result.rgbBlue  := b;
end;

function ResampleBitmap(Bitmap: TBitmap; NewWidth, NewHeight: Integer): Boolean;
var
  Temp: TBitmap;
  Line: PLine;
  x, y: Integer;
  Blockheight, Blockwidth: Cardinal;
  BlockPosX, BlockPosY: Single;
  BlockDiffX, BlockDiffY: Single;
  XPos, YPos: Single;
  DiffX, Diffy: Single;
begin
  Result := True;
  Temp := TBitmap.Create;
  Bitmap.PixelFormat := pf32Bit;
  Temp.PixelFormat   := pf32Bit;
  Temp.Height := NewHeight;
  Temp.Width  := NewWidth;
  BlockDiffY := (Bitmap.Height / NewHeight);
  BlockDiffX := (Bitmap.Width / NewWidth);
  BlockHeight := Trunc(BlockDiffY);
  BlockWidth  := Trunc(BlockDiffY);
  DiffX := 1;
  DiffY := 1;
  BlockPosY := 0;
  YPos      := 0;
  for y := 0 to NewHeight - 1 do
  begin
    BlockPosX := 0;
    XPos      := 0;
    Line := Temp.ScanLine[Trunc(YPos)];
    for x := 0 to NewWidth - 1 do
    begin
      Line[Trunc(XPos)] := ResampleSubBitmap(Bitmap,
        Round(BlockPosX), Round(BlockPosY), Blockwidth, BlockHeight);
      BlockPosX := BlockPosX + BlockDiffX;
      XPos      := XPos + DiffX;
    end;
    BlockPosY := BlockPosY + BlockDiffY;
    YPos      := YPos + DiffY;
  end;
  Bitmap.Assign(Temp);

  Temp.Free;
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
   ResampleBitmap(Image1.Picture.Bitmap, 
   Image1.Picture.Bitmap.Width,   // HIER KÖNNEN INTEGER WERTE EINGETRAGEN WERDEN
   Image1.Picture.Bitmap.Height); // HIER KÖNNEN INTEGER WERTE EINGETRAGEN WERDEN
end;