You could think bitmaps stretching is easy with VCL in Delphi? Well... it is... almost... when it does not involve 32 bit bitmaps (those bitmaps with per-pixel alpha channel). I've spent a few hours looking for a routine for speedy resizing of such bitmaps (but a routine that woudl not loos the alpha channel.
Maybe it can be done somehow with WinAPI, but I have not managed to find a way.
Besides - it would most probably not woth on DOS derived Windows (Win 9x).
So after wasting those hours, i've wasted... a quarter more and written my own routine.
It may not be fastest, it may not be the most efficient way,
but it's clean and does its work.
source available
here
Feel free to use it in your apps.
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, ,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 := 0 to NewWidth-1 do
begin
xs := Min(OldWidth-1,Trunc( * OldWidth / NewWidth));
dsl[].rgbRed := ssl[xs].rgbRed;
dsl[].rgbGreen := ssl[xs].rgbGreen;
dsl[].rgbBlue := ssl[xs].rgbBlue;
dsl[].rgbReserved := ssl[xs].rgbReserved
end;
end;
end;