更改图片的大小

下面的代码可以支持较好效果的更改图片大小，类似StretchDraw的功能。

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;

 //Grenz überschreitungen abfangen

 if (YPos + Height) >= Bitmap.Height then Height := (Bitmap.Height - YPos) - 1;

 if (XPos + Width) >= Bitmap.Width then Width := (Bitmap.Width - XPos) - 1;

 //Für jedes Pixel die Werte lesen und aufaddieren

 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;

 //Mittelwert bestimmen und kleine Helligkeitskorrektur

 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;

 //Arbeitsbitmap erzeugen

 Temp := TBitmap.Create;

 //Alles mu? 32 Bit sein

 Bitmap.PixelFormat := pf32Bit;

 Temp.PixelFormat   := pf32Bit;

 //Neue H?he unseres Bitmap

 Temp.Height := NewHeight;

 Temp.Width  := NewWidth;

 //Altes Bild in Bl?cke zerlegen, deren jeweiliger Mittelwert die Farbe

 //eines neuen Pixels bildet

 //Blockschrittweite pro neues Pixel

 BlockDiffY := (Bitmap.Height / NewHeight);

 BlockDiffX := (Bitmap.Width / NewWidth);

 //Gr??e eines Blockes

 BlockHeight := Trunc(BlockDiffY);

 BlockWidth  := Trunc(BlockDiffY);

 //Schrittweite der Pixel im neuen Bild

 DiffX := 1;

 DiffY := 1;

 //Alle initialisieren

 BlockPosY := 0;

 YPos      := 0;

 //Jede Spalte

 for y := 0 to NewHeight - 1 do

 begin

   BlockPosX := 0;

   XPos      := 0;

   //Jede Zeile

   Line := Temp.ScanLine[Trunc(YPos)];

   for x := 0 to NewWidth - 1 do

   begin

     //Aus einem angegebenen Block des alten Bitmaps den Mittelwert der

     //Farbe bestimmen

     Line[Trunc(XPos)] := ResampleSubBitmap(Bitmap,

       Round(BlockPosX), Round(BlockPosY), Blockwidth, BlockHeight);

     //Einen Block/Pixel weiter

     BlockPosX := BlockPosX + BlockDiffX;

     XPos      := XPos + DiffX;

   end;

   //Einen Block/Pixel weiter

   BlockPosY := BlockPosY + BlockDiffY;

   YPos      := YPos + DiffY;

 end;

 //Alte Bitmap mit der neuen überschreiben

 Bitmap.Assign(Temp);

 //Hilfsbitmap freigeben

 Temp.Free;

end;

// Beispiel:

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

 ResampleBitmap(Image1.Picture.Bitmap, 100, 100);

end;