unit Stretch32BitBitmap;

interface

uses Math, Graphics, ImageProcessing;

procedure Stretch32(NewWidth, NewHeight: Cardinal; Source, Target: TBitmap);

implementation

const
	MaxPixelCount = 32768;

type
  pRGBQarray = ^TRGBQuadarray;
  TRGBQuadArray = array[0..MaxPixelCount-1] of TRGBQuad;


procedure Stretch32(NewWidth, NewHeight: Cardinal; Source, Target: TBitmap);
var
  xs, xd,yd, OldWidth, OldHeight: Integer;
  ssl, dsl: pRGBQarray;
begin

  if not(Source.Pixelformat = pf32Bit) then
  	Source.Pixelformat := pf32Bit;
  if not(Target.Pixelformat = pf32Bit) then
  	Target.Pixelformat := pf32Bit;

  OldWidth := Source.Width;
  OldHeight := Source.Height;
  Target.Width := NewWidth;
  Target.Height := NewHeight;

  for yd := 0 to NewHeight-1 do
    begin
      dsl:= Target.ScanLine[yd];
      ssl:= Source.ScanLine[Min(OldHeight-1,Trunc(yd * OldHeight / NewHeight))];
      for xd := 0 to NewWidth-1 do
        begin
          xs := Min(OldWidth-1,Trunc(xd * OldWidth / NewWidth));
          dsl[xd].rgbRed      := ssl[xs].rgbRed;
          dsl[xd].rgbGreen    := ssl[xs].rgbGreen;
          dsl[xd].rgbBlue     := ssl[xs].rgbBlue;
          dsl[xd].rgbReserved := ssl[xs].rgbReserved
        end;
    end;
end;


end.