Why my bitmap is corrupted when I use Canvas.CopyRect?

Question

I'm trying to make a component which displays a gradient bar. I have a function FillGradient that make a perfect gradient on a Canvas. When I use this function in Paint method to draw the gradient directly on component Canvas everything looks fine. But when I try to draw the gradient on a buffer bitmap (like in the code below) and then I copy a portion on the component Canvas when it's needed (in Paint method), the gradient is displayed corrupted. What is wrong ?

This is the minimal code to reproduce the problem:

unit OwnGauge;

interface

uses
   Windows, Messages, Sysutils, Classes, Graphics, Controls, forms, Dialogs;

const
   Arc1 = 10;

type
   TGradDir = (grHorizontal, grVertical);

   TOwnGauge = class(TGraphicControl)
   private
     Fbmp: TBitmap;
     FBgColor, FSColor, FEColor: TColor;
     FProgress, Fmax, Fmin: Integer;
     procedure FillGradient(ACanvas:TCanvas; ARect:TRect; StartColor,EndColor:Tcolor; Direction:TGradDir);
     function  GetColorBetween(StartColor,EndColor:TColor; Index,StartRange,EndRange:Extended):TColor;
   protected
     procedure Setcolor1(Value: Tcolor);
     procedure Setcolor2(Value: Tcolor);
     procedure Setbgcolor(Value: Tcolor);
     procedure Setmin(Value: Integer);
     procedure Setmax(Value: Integer);
     procedure Setprogress(Value: Integer);
     procedure GradFill(Clr1, Clr2: Tcolor);
     procedure Paint; override;
   public
     constructor Create(Aowner: Tcomponent); override;
     destructor Destroy; override;
   published
     property Backcolor:    Tcolor Read Fbgcolor Write Setbgcolor;
     property Color1:       Tcolor Read Fscolor Write Setcolor1;
     property Color2:       Tcolor Read Fecolor Write Setcolor2;
     property Min:          Integer Read Fmin Write Setmin;
     property Max:          Integer Read Fmax Write Setmax;
     property Progress:     Integer Read Fprogress Write Setprogress;
     property Visible;
     property Font;
   end;

implementation

var
  Percent, Rp: Integer;

constructor TOwnGauge.Create(Aowner: Tcomponent);
begin
  inherited Create(Aowner);

  Width := 200;
  Height := 40;
  Fmin := 1;
  Fmax := 100;
  Fprogress := Fmin;

  Fscolor := Clwhite;
  Fecolor := Clyellow;
  Fbgcolor := ClBtnFace;

  Fbmp:= TBitmap.Create;
  Fbmp.PixelFormat:= pf24bit;
  Fbmp.Transparent:=false;
  Fbmp.Canvas.CopyMode:=cmSrcCopy;
  Fbmp.Width:= Width-2;
  Fbmp.Height:= Height-2;
  Gradfill(Fscolor, Fecolor);
end;

destructor TOwnGauge.Destroy;
begin
  inherited Destroy;
  Fbmp.Free;
end;

procedure TOwnGauge.FillGradient(ACanvas:TCanvas; ARect:TRect; StartColor,EndColor:Tcolor; Direction:TGradDir);
var I: Integer;
begin
 if ((ARect.Right-ARect.Left)<=0) or ((ARect.Bottom-ARect.Top)<=0) then Exit;
 case Direction of
   grHorizontal:
     for I:=ARect.Left to ARect.Right do begin
      ACanvas.Pen.Color:=GetColorBetween(StartColor, EndColor, I, ARect.Left, ARect.Right);
      ACanvas.MoveTo(I, ARect.Top);
      ACanvas.LineTo(I, ARect.Bottom+1);
     end;
   grVertical:
     for I:=ARect.Top to ARect.Bottom do begin
      ACanvas.Pen.Color:=GetColorBetween(StartColor, EndColor, I, ARect.Top, ARect.Bottom);
      ACanvas.MoveTo(ARect.Left, I);
      ACanvas.LineTo(ARect.Right+1, I);
     end;
 end;
end;

function TOwnGauge.GetColorBetween(StartColor,EndColor:TColor; Index,StartRange,EndRange:Extended):TColor;
var F: Extended;
    R1,R2,R3,G1,G2,G3,B1,B2,B3: Byte;

 function CalcColorBytes(FB1,FB2:Byte):Byte;
 begin
  Result:=FB1;
  if FB1 < FB2 then Result:= FB1 + Trunc(F * (FB2 - FB1));
  if FB1 > FB2 then Result:= FB1 - Trunc(F * (FB1 - FB2));
 end;

begin
 if Index <= StartRange then Exit(StartColor);
 if Index >= EndRange then Exit(EndColor);
 F:=(Index - StartRange) / (EndRange - StartRange);
 asm
   mov  EAX,StartColor
   cmp  EAX,EndColor
   je   @@Exit
   mov  R1,AL
   shr  EAX,8
   mov  G1,AL
   shr  EAX,8
   mov  B1,AL
   mov  EAX,EndColor
   mov  R2,AL
   shr  EAX,8
   mov  G2,AL
   shr  EAX,8
   mov  B2,AL
   push EBP
   mov  AL,R1
   mov  DL,R2
   call CalcColorBytes
   pop  ECX
   push EBP
   mov  R3,AL
   mov  DL,G2
   mov  AL,G1
   call CalcColorBytes
   pop  ECX
   push EBP
   mov  G3,AL
   mov  DL,B2
   mov  AL,B1
   call CalcColorBytes
   pop  ECX
   mov  B3,AL
   XOR  EAX,EAX
   mov  AL,B3
   SHL  EAX,8
   mov  AL,G3
   SHL  EAX,8
   mov  AL,R3
 @@Exit:
   mov  @Result,EAX
 end;
end;

Procedure TOwnGauge.Gradfill(Clr1, Clr2: Tcolor);
begin
 FillGradient(FBmp.Canvas, Rect(0,0, FBmp.Width-1, FBmp.Height-1), clRed, clBlue, grHorizontal);
end;

procedure TOwnGauge.Paint;
begin
  if not Visible then Exit;

  Percent:= Round(((FProgress-Fmin)/(Fmax-Fmin))*100);
  Rp:= Percent*(Width-3) div 100;

  Canvas.CopyMode:=cmSrcCopy;
  if Rp<>0 then
   Canvas.CopyRect(Rect(1,1,1+Rp,Height-2), Fbmp.Canvas, Rect(0,0,Fbmp.Width-1,Fbmp.Height-1));

  if Percent<100 then begin
   Canvas.Brush.Color:= FBgColor;
   Canvas.Brush.Style:= bsSolid;
   Canvas.Pen.Style:= psClear;
   Canvas.Pen.Width:= 1;
   Canvas.Rectangle(2+Rp, 2, Width-0, Height-0);
  end;
end;

//-----------------------------------------------

Procedure TOwnGauge.Setbgcolor(Value:  Tcolor);
begin
  if Value <> Fbgcolor then
  begin
    Fbgcolor := Value;
    Invalidate;
  end;
end;

Procedure TOwnGauge.Setcolor1(Value:  Tcolor);
begin
  if Value <> Fscolor then
  begin
    Fscolor := Value;
    Gradfill (Fscolor, Fecolor);
    Invalidate;
  end;
end;

Procedure TOwnGauge.Setcolor2(Value:  Tcolor);
begin
  if Value <> Fecolor then
  begin
    Fecolor := Value;
    Gradfill (Fscolor, Fecolor);
    Invalidate;
  end;
end;

Procedure TOwnGauge.Setmin(Value:  Integer);
begin
  if (Value <> Fmin) And (Value< Fmax) then
  begin
    Fmin := Value;
    if (Fprogress< Fmin) then  Fprogress:= Fmin;
    Invalidate;
  end;
end;

Procedure TOwnGauge.Setmax(Value:  Integer);
begin
  if (Value <> Fmax) And (Fmin< Value)  then
  begin
    Fmax := Value;
    if (Fprogress> Fmax) then  begin
     Fprogress:= Fmax;
    end;
    Invalidate;
  end;
end;

Procedure TOwnGauge.Setprogress(Value:  Integer);
begin
  if (value > fMax) then value := Fmax;
  if (value < fMin) then value := fMin;
  if (Value <> Fprogress) then begin
    Fprogress := Value;
    Paint;
  end;
end;

end.

Answer 1

TCanvas.Copyrect method internally uses StretchBlt function. It performs stretching when rectangles have different size, as perhaps in this code line:

 Canvas.CopyRect(Rect(1,1,1+Rp,Height-2), Fbmp.Canvas, Rect(0,0,Fbmp.Width-1,Fbmp.Height-1));

To provide high-quality stretching, apply SetStretchBltMode to Canvas.Handle with HALFTONE flag

P.S. Are you aware about GradientFill function?