CopyRect (scaling) with the correct colors in Delphi

Question

In this question I asked about the correct use of the CopyRect method. I got an answer which fixed my problem, but now the colors of the copied rectangle are wrong (limited to 256 values?). This is the code:

var
  Bmp: TBitmap;
begin
  Image1.Picture.LoadFromFile(SomeJPGimage);

  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Image1.Picture.Graphic);
    with Bmp do
      Image2.Canvas.CopyRect(Image2.Canvas.ClipRect, Canvas, Canvas.ClipRect);
  finally
    Bmp.Free;
  end;
end;

The inset with the false colors is Image2. The colors are right if I don't resize.
How do I get the 24 bit color of the source image (a JPG) when resizing?

edit
Draw is not an alternative; I want to copy a scaled version of part of the source image.

Answer 1

This is not caused because of color reduction, or a wrong pixelformat etc.. You're probably shrinking the image while copying and 'StretchBlt' compresses the image to fit in, and depending on the mode, produces some artifacts. For instance the below 128x128 image

   

is displayed exactly the same if no resizing is applied. However if it is applied on a 90x100 image for instance, the output is

  .

You can change the stretching mode for a slightly better result:

var
  Bmp: TBitmap;
begin
  Image1.Picture.LoadFromFile(SomeJPGimage);

  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Image1.Picture.Graphic);

    SetStretchBltMode(Image2.Canvas.Handle, HALFTONE);  // <- here

    with Bmp do
      Image2.Canvas.CopyRect(Image2.Canvas.ClipRect, Canvas, Canvas.ClipRect);
  finally
    Bmp.Free;
  end;
end;

For the above source picture the output now becomes:

(Having browsed a little 'graphics.pas', the VCL seems to be using halftone only for 8-bit images. I may be wrong or right in this assessment, but in any case halftone stretching mode has no such constraint.)

For anything better, I believe, you have to use a proper graphics library.

Answer 2

Edited again:

Turns out the issue is going against the WRONG canvas (too easy with TImage if you're not used to it). Tried to save files on my last sample and got a huge file on the one I assigned. So I Started looking into some of the other values and found that you need to work against the Bitmap Canvas...

var
  BMP: TBitmap;
  MyClipRect: TRect;
begin
  if OpenDialog1.Execute then
     begin
       Image1.Picture.LoadFromFile(OpenDialog1.FileName);
       Bmp := TBitmap.Create;
       try
         Bmp.Assign(Image1.Picture.Graphic);
         myClipRect.Left := (Bmp.Width div 2);
         myClipRect.Top := (Bmp.Height div 2);
         myClipRect.Right := (Bmp.Width);
         myClipRect.Bottom := (Bmp.Height);

         with Image2.Picture.Bitmap do
           begin
             Width := Bmp.Width div 2;
             Height := Bmp.Height div 2;
             Canvas.CopyRect(Canvas.ClipRect, Bmp.Canvas, MyClipRect);
           end;
         Image2.Picture.SaveToFile('image2.bmp');
      finally
        Bmp.Free;
      end;
   end;
end;

Hope that finally got it. Yeesh.