function CopyPalette(Palette: HPalette): HPalette;
var
  nEntries: integer;
  LogPalSize: integer;
  LogPalette: PLogPalette;
begin
  Result := 0;
  if Palette = 0 then
    exit;
  GetObject(Palette, sizeof(nEntries), @nEntries);
  if nEntries < 1 then
    exit;
  LogPalSize := sizeof(TLogPalette) + sizeof(TPaletteEntry) * (nEntries - 1);
  GetMem(LogPalette, LogPalSize);
  with LogPalette^ do
  try
    palVersion := $300;
    palNumEntries := nEntries;
    GetPaletteEntries(Palette, 0, nEntries, palPalEntry[0]);
    Result := CreatePalette(LogPalette^);
  finally
    FreeMem(LogPalette, LogPalSize);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := 50;
    Bitmap.Height := 40;
    Bitmap.Palette := CopyPalette(Image1.Picture.Bitmap.Palette);
    Bitmap.Canvas.CopyRect(Rect(0, 0, 50, 40),
      Image1.Picture.Bitmap.Canvas,
      Bounds(20, 10, 50, 40));
    Bitmap.SaveToFile('c:\windows\temp\junk.bmp');
  finally
    Bitmap.Free;
  end;
end;