为什么使用画布时位图损坏。CopyRect?

我试图制作一个显示渐变条的组件。我有一个功能 FillGradient 在 Canvas 。当我在中使用此函数时 Paint 方法直接在组件画布上绘制渐变,一切看起来都很好。但是,当我尝试在缓冲区位图上绘制渐变时(如下面的代码),然后在需要时复制组件画布上的一部分(在“绘制方法”中),渐变显示为损坏。怎么了?

这是再现问题的最少代码:

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.