function Texturize(bmpDest, bmpSource: TBitmap; rcDest, rcSource: TRect; 
  PixelFormatBeachten, AbstandZulassen: boolean): boolean; 
var x, y, diffx, diffy, dazux, dazuy: integer; 
  function RectTest(b: TBitmap; r: TRect): boolean; 
  begin 
    if r.top < 0 then r.top := 0; 
    if r.left < 0 then r.left := 0; 
    if r.right > b.width then r.right := b.width; 
    if r.bottom > b.height then r.bottom := b.height; 
    result := (r.right - r.left > 0) and (r.bottom - r.top > 0); 
  end; 
  function RectSourceTest: boolean; 
  begin 
    result := (bmpSource.width >= diffx) and (bmpSource.height >= diffy); 
  end; 
begin 
  result := RectTest(bmpDest, rcDest) and RectTest(bmpSource, rcSource) 
    and ((bmpDest.pixelformat >= bmpSource.pixelformat) or not 
    PixelFormatBeachten); 
  if not result then exit; 
  diffx := rcSource.right - rcSource.left; 
  diffy := rcSource.bottom - rcSource.top; 
  result := RectSourceTest or AbstandZulassen; 
  if not result then exit; 
  y := rcDest.top; 
  while y < rcDest.Bottom do begin 
    x := rcDest.left; 
    if y + diffy > rcDest.bottom then dazuy := rcDest.bottom - y 
    else dazuy := diffy; 
    while x < rcDest.right do begin 
      if x + diffx > rcDest.right then dazux := rcDest.right - x 
      else dazux := diffx; 
      bmpDest.canvas.copyrect(rect(x, y, x + dazux, y + dazuy), 
        bmpSource.canvas, 
        rect(rcSource.left, rcSource.top, rcSource.left + dazux, rcSource.top 
        + dazuy)); 
      inc(x, diffx); 
    end; 
    inc(y, diffy); 
  end; 
end; 
 
// Beispielaufruf 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  if not 
    Texturize(image3.picture.bitmap, image2.picture.bitmap, 
    rect(10, 15, 170, 230), rect(20, 50, 70, 80), true, false) then 
    showmessage('Aktion nicht ausführbar'); 
end;