求更精细的两种颜色渐变！

liugaohui 2009-10-30 12:01:21

procedure TForm1.Button1Click(Sender: TObject);
const
COLORDEL = 300;//控制渐变的细致程度
var
ColorS, ColorE: TColor;
I, X, Y, nX, nY: Integer;
rDel: Real;
nRed, nGreen, nBlue: Integer;
begin
ColorS := clBlack;//起始颜色，默认为黑
ColorE := clWhite;//终止颜色，默认为白
with ColorDialog1 do begin
if Execute then ColorS := Color;
if Execute then ColorE := Color;
end;
X := 0;
Y := 0;
nX := Width div COLORDEL;
nY := Height;
nRed := GetRValue(ColorS);
nGreen := GetGValue(ColorS);
nBlue := GetBValue(ColorS);
for I := 0 to COLORDEL - 1 do begin
Canvas.Brush.Color := RGB(nRed, nGreen, nBlue);
Canvas.FillRect(Rect(X, Y, X + nX, Y + nY));
rDel := nX * I / Width;//关键！根据距离渐变
Inc(X, nX);
nRed := Round(GetRValue(ColorS) + (GetRValue(ColorE) - GetRValue(ColorS)) * rDel);
nGreen := Round(GetGValue(ColorS) + (GetGValue(ColorE) - GetGValue(ColorS)) * rDel);
nBlue := Round(GetBValue(ColorS) + (GetBValue(ColorE) - GetBValue(ColorS)) * rDel);
end;
Canvas.FillRect(Rect(X, Y, Left + Width, Top + Height));//保证最右侧充分填充
end;

以上是大富翁论坛的帖子，但精细度不够，COLORDEL设置上1000就不会变化了，请问有没有更好的算法？谢谢！

...全文

390 6 打赏收藏转发到动态举报

写回复

用AI写文章

6 条回复

切换为时间正序

请发表友善的回复…

发表回复

liugaohui 2009-10-30

打赏
举报

谢谢，学习一下，源码也是帖别人的

阿发伯 2009-10-30

打赏
举报

恕我愚昧，我还没看明白你那个COLORDEL怎么控制精细程度的，如果Width < COLORDEL，nX 且不为0？

阿发伯 2009-10-30

打赏
举报

理论最大宽度65536，过程采用一个TBitmap，利用其扫描线操作，共楼主参考：



procedure FillGradient(Canvas: TCanvas; Color1, Color2: TColor; rect: TRect);

var

  Bitmap: TBitmap;

  Width, Height: Integer;

  Delta: Integer;

  x, y, Alpha: Integer;

  P, P0: PRGBQuad;

  c1, c2, c: TRGBQuad;

begin

  if Color1 < 0 then

    Color1 := GetSysColor(Color1 and $ff);

  if Color2 < 0 then

    Color2 := GetSysColor(Color2 and $ff);

  c1 := TRGBQuad(RGB(Color1 shr 16, (Color1 shr 8) and $ff, Color1 and $ff));

  c2 := TRGBQuad(RGB(Color2 shr 16,(Color2 shr 8) and $ff,  Color2 and $ff));

  Width := rect.Right - rect.Left;

  Height := rect.Bottom - rect.Top;

  Delta := Round($1000000 / Width);

  Bitmap := TBitmap.Create;

  Bitmap.PixelFormat := pf32Bit;

  Bitmap.Width := Width;

  Bitmap.Height := Height;

  P0 := Bitmap.ScanLine[Height - 1];

  for x := 0 to Width - 1 do

  begin

    Alpha := x * Delta;

    c.rgbRed := ((Alpha * (c2.rgbRed - c1.rgbRed)) shr 24) + c1.rgbRed;

    c.rgbGreen := ((Alpha * (c2.rgbGreen - c1.rgbGreen)) shr 24) + c1.rgbGreen;

    c.rgbBlue := ((Alpha * (c2.rgbBlue - c1.rgbBlue)) shr 24) + c1.rgbBlue;

    P := P0;

    for y := 1 to Height do

    begin

      P^ := c;

      Inc(P, Width);

    end;

    Inc(P0);

  end;

  Canvas.Draw(rect.Left, rect.Top, Bitmap);

  Bitmap.Free;

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

  FillGradient(Canvas, clYellow, clRed, Rect(0, 0, 1200, 500));

end;