1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:

procedure CopyBmpRect(Canvas: TCanvas; const DestRect: TRect; ABitmap: TBitmap;
  const SourceRect: TRect);
var
  Header, Bits: Pointer;
  HeaderSize, BitsSize: Cardinal;
begin
   GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
   GetMem(Header, HeaderSize);
   GetMem(Bits, BitsSize);
   try
     GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
     StretchDIBits(Canvas.Handle,
        DestRect.Left, DestRect.Top,
        DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top,
        SourceRect.Left, SourceRect.Top,
        SourceRect.Right - SourceRect.Left, SourceRect.Bottom  - SourceRect.Top,
        Bits, TBitmapInfo(Header^),
        DIB_RGB_COLORS, Canvas.CopyMode);
   finally
     FreeMem(Header);
     FreeMem(Bits);
   end;
end;