Конференция "Media" » Градиент с углом [D6, WinXP]
 
  • Jimmy (12.09.07 22:48) [0]
    Не подскажет ли кто алгоритм градиентной линейной заливки, но не горизонтальной или вертикальной, он есть, а с произвольным углом Alfa?
  • homm © (13.09.07 13:20) [1]
    школьные знания по геометрии должны пригодиться.
  • Jimmy (13.09.07 16:46) [2]
    Аналогичным образом я мог бы отвечать абсолютно на все вопросы форума.
  • MBo © (13.09.07 18:13) [3]
    >Аналогичным образом я мог бы отвечать абсолютно на все вопросы форума.
    Попробуй

    homm © прав
    градиентная заливка по горизонтали или по вертикали по сути есть зависимость цвета от одной  координаты. В случае диагонали зависимость будет от двух координат.
    С Пифагором вместе не служили?
  • sdubaruhnul (13.09.07 20:10) [4]
    >Не подскажет ли кто алгоритм градиентной линейной заливки, но не горизонтальной или вертикальной, он есть, а с произвольным углом Alfa?

    А где должен быть чисто первый цвет и чисто второй?
  • ha (14.09.07 13:59) [5]
    Есть алгоритм рисования линии по клеткам(как в школьной тетрадке)
    реализуй его, а цвет меняй сам что бы плавно изменялся от начала к концу
  • homm © (14.09.07 14:01) [6]
    > [5] ha   (14.09.07 13:59)

    Что-бы потом тот, кто такой код увидит, руки оторвал тому, кто его напишет :)
  • antonn © (14.09.07 14:11) [7]
    Бабах! %))
    procedure Draw_GradientAngle(canvas:Tcanvas; _Rect:Trect; const Color_start,Color_end:Tcolor;angle:double);
    const
     Pixels = MaxInt div SizeOf(TRGBTriple);
    type
     PRGBArray = ^TRGBArray;
     TRGBArray = array[0..Pixels-1] of TRGBTriple;
    var _F_shadow_Bitmap:Tbitmap; x, y: Integer; Row1: PRGBArray;
        rc1, rc2, gc1, gc2, bc1, bc2:integer;
       long:double;
       _r,_b,_g:integer;
    begin
    _F_shadow_Bitmap:=Tbitmap.Create;
    try
    _F_shadow_Bitmap.PixelFormat:=pf24bit;

    _F_shadow_Bitmap.Width:=_Rect.Right-_Rect.Left;
    _F_shadow_Bitmap.Height:=_Rect.Bottom-_Rect.Top;

     rc1 := GetRValue(Color_start); gc1 := GetGValue(Color_start); bc1 := GetBValue(Color_start);
     rc2 := GetRValue(Color_end); gc2 := GetGValue(Color_end); bc2 := GetBValue(Color_end);
     rc2:=rc2-rc1;
     gc2:=gc2-gc1;
     bc2:=bc2-bc1;
    // angle:=Getpos2Angle(0,0,_F_shadow_Bitmap.Width,_F_shadow_Bitmap.Height);
     long:= (abs(GetTrace(0,0,(_Rect.Right-_Rect.Left)div 2,(_Rect.Bottom-_Rect.Top) div 2)*sin(angle)))/2;

     messagedlg(floattostr(long),mterror,[mbOK],0);

     for Y := 0 to _F_shadow_Bitmap.Height - 1 do begin
        Row1:= _F_shadow_Bitmap.ScanLine[y];
       for x := 0 to _F_shadow_Bitmap.Width -1 do begin
             _r:=trunc(rc1+rc2*(((GetTrace(_F_shadow_Bitmap.Width div 2,_F_shadow_Bitmap.Height div 2,x,y)*cos(angle-(Getpos2Angle(_F_shadow_Bitmap.Width div 2,_F_shadow_Bitmap.Height div 2,x,y))))+1)/long));
            if _r>255 then _r:=255 else if _r<0 then _r:=0;
             _g:=trunc(gc1+gc2*(((GetTrace(_F_shadow_Bitmap.Width div 2,_F_shadow_Bitmap.Height div 2,x,y)*cos(angle-(Getpos2Angle(_F_shadow_Bitmap.Width div 2,_F_shadow_Bitmap.Height div 2,x,y))))+1)/long));
            if _g>255 then _g:=255 else if _g<0 then _g:=0;
             _b:=trunc(bc1+bc2*(((GetTrace(_F_shadow_Bitmap.Width div 2,_F_shadow_Bitmap.Height div 2,x,y)*cos(angle-(Getpos2Angle(_F_shadow_Bitmap.Width div 2,_F_shadow_Bitmap.Height div 2,x,y))))+1)/long));
            if _b>255 then _b:=255 else if _b<0 then _b:=0;

             Row1[x].rgbtRed:=_r;
             Row1[x].rgbtGreen:=_g;
             Row1[x].rgbtBlue:=_b;
       end;
     end;
    canvas.CopyRect(_Rect,_F_shadow_Bitmap.Canvas,_F_shadow_Bitmap.Canvas.ClipRect);
    finally
    _F_shadow_Bitmap.Free;
    end;
    end;



    юзать:
    Draw_GradientAngle(paintbox1.Canvas,rect(0,0,paintbox1.Width,paintbox1.Height),c lwhite,clblack,-pi/2);
  • antonn © (14.09.07 14:12) [8]
    ой, я там забыл почистить %)))
  • antonn © (14.09.07 14:13) [9]
    +[7]
    function Getpos2Angle(x1,y1,x2,y2:real):real;
    begin
    if x1=x2 then begin
    if y1>y2 then
     result:=pi/2 else result:=3*pi/2;
    exit;
    end;
    result:=ArcTan((y1-Y2)/(X1-x2));
    if (X1-x2)<0 then result:=result-pi;
    end;

    function GetTrace(x1,y1,x2,y2:real):real;
    begin
     result:=(sqrt(sqr(x1-x2)+sqr(y1-y2)));
    end;

  • DVM © (14.09.07 17:04) [10]

    > antonn ©  

    ужос какой то
  • antonn © (14.09.07 17:33) [11]

    > ужос какой то

    согласен, но все же лучше, чем размышления, что школьный курс геометрии может пригодиться :)
  • homm © (14.09.07 21:43) [12]
    > [11] antonn ©   (14.09.07 17:33)
    > согласен, но все же лучше, чем размышления, что школьный
    > курс геометрии может пригодиться :)

    Вот по этому я промолчал, когда увидел твой код :)
  • homm © (14.09.07 21:50) [13]
    > [11] antonn ©   (14.09.07 17:33)

    Хрень полную рисует, если честно :(
  • antonn © (14.09.07 22:02) [14]
    в натуре... ехе не перекомпилил и запостил, щас исправлю:)
  • Инс © (14.09.07 23:10) [15]
    Можно еще сюда глянуть:
    http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1090
  • Lacmus © (14.09.07 23:58) [16]
    >Jimmy   (12.09.07 22:48)  



    procedure DrawAngleGradient(aCanvas: TCanvas; aRect: TRect; aColor1, aColor2: TColor; aAngle: Integer; aSteps: Integer = 256);
    var
     i, x1, y1, x2, y2, W, H: Integer;
     Angle, Delta, SinA, CosA, TanA, C: Extended;
     R, G, B, FromR, ToR, FromG, ToG, FromB, ToB: Byte;
    begin
     if (aAngle > 0) and (aAngle < 90) then begin
       W := aRect.Right - aRect.Left;
       H := aRect.Bottom - aRect.Top;
       FromR := GetRValue(AColor1);
       FromG := GetGValue(AColor1);
       FromB := GetBValue(AColor1);
       ToR := GetRValue(AColor2);
       ToG := GetGValue(AColor2);
       ToB := GetBValue(AColor2);
       SinA := 0; CosA := 0; Delta := 1;
       Angle := (aAngle * PI) / 180;
       SinCos(Angle, SinA, CosA);
       TanA := SinA / CosA;
       C := (W + (H / TanA)) / CosA;
       if C < aSteps then
         aSteps := Round(C)
       else
         Delta := C / aSteps;
       aCanvas.Pen.Style := psClear;
       X1 := 0; Y1 := 0;
       for i := 0 to aSteps - 1 do begin
         X2 := aRect.Left + Round(Delta * CosA * (i + 1));
         Y2 := aRect.Top + Round(X2 * TanA);
         R := FromR + MulDiv(i, ToR - FromR, aSteps - 1);
         G := FromG + MulDiv(i, ToG - FromG, aSteps - 1);
         B := FromB + MulDiv(i, ToB - FromB, aSteps - 1);
         aCanvas.Brush.Color := RGB(R, G, B);
         aCanvas.Polygon([Point(X1, 0), Point(X2, 0), Point(0, Y2), Point(0, Y1)]);
         X1 := X2; Y1 := Y2;
       end
     end
    end;

  • homm © (15.09.07 00:43) [17]
    procedure MyGradient(Can:TCanvas; ApplyRect:TRect; ColorFrom, ColorTo: TColor; Angle: Single);
    type
     ARGBQuad = array[0..0] of TRGBQuad;

    var
     Bmp: TBitmap;
     Line: ^ARGBQuad;
     i, j, i2: Integer;
     Wi, He: DWORD;
     s, c, t, t90, t_t90: Single;
     L, R: Single;
     dr, dg, db: Single;
     Col: TColor;
     inv: Boolean;

    begin
     Wi := ApplyRect.Right - ApplyRect.Left;
     He := ApplyRect.Bottom - ApplyRect.Top;
     Bmp := TBitmap.Create;
     Bmp.HandleType := bmDIB;
     Bmp.PixelFormat := pf32bit;
     Bmp.Width := Wi;
     Bmp.Height := He;

     Angle := Angle*pi/180.0;

     Angle := Angle - trunc(Angle/(pi*2))*(pi*2);
     if Angle < 0 then
       Angle := Angle + 2*pi;

     inv := true;
     if ((Angle > pi) and (Angle < pi*3/2)) or ((Angle > 0) and (Angle < pi/2)) then begin
       inv := false;
       Angle := pi - Angle;
     end;
     if (Angle > pi/2) and (Angle < pi) then begin
       Col := ColorFrom;
       ColorFrom := ColorTo;
       ColorTo := Col;
     end;

     t := Tan(Angle);
     t90 := Tan(Angle+pi/2.0);
     t_t90 := t - t90;

     L := (t*Wi-He);
     L := L/(t_t90);
     L := sqrt( sqr(L) + sqr(L*t90) );

     dr := (TRGBQuad(ColorTo).rgbRed - TRGBQuad(ColorFrom).rgbRed)/L;
     dg := (TRGBQuad(ColorTo).rgbGreen - TRGBQuad(ColorFrom).rgbGreen)/L;
     db := (TRGBQuad(ColorTo).rgbBlue - TRGBQuad(ColorFrom).rgbBlue)/L;

     for i := 0 to He-1 do begin
       Line := Bmp.ScanLine[i];
       if inv then i2 := i else i2 := He - i;
       for j := 0 to Wi-1 do begin
         R := (i2 - t90*j)/(t_t90);
         R := sqrt( sqr(R-j) + sqr(R*t-i2) );
         Line[j].rgbRed := TRGBQuad(ColorFrom).rgbRed + round(r*dr);
         Line[j].rgbGreen := TRGBQuad(ColorFrom).rgbGreen + round(r*dg);
         Line[j].rgbBlue := TRGBQuad(ColorFrom).rgbBlue + round(r*db);
       end;
     end;

     BitBlt(Can.Handle, ApplyRect.Left, ApplyRect.Top, Wi, He, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
     Bmp.Free;
    end;

  • Jimmy (15.09.07 00:45) [18]
    Огромное спасибо to Lacmus! А также всем, кто пытается оказать реальную помощь!
  • homm © (15.09.07 00:53) [19]
    Красный и синий канал были спутаны местами.

    procedure MyGradient(Can:TCanvas; ApplyRect:TRect; ColorFrom, ColorTo: TColor; Angle: Single);
    type
     ARGBQuad = array[0..0] of TRGBQuad;
    var
     Bmp: TBitmap;
     Line: ^ARGBQuad;
     i, j, i2: Integer;
     Wi, He: DWORD;
     s, c, t, t90, t_t90: Single;
     L: Single;
     dr, dg, db: Single;
     r, g, b: byte;
     Col: TColor;
     inv: Boolean;
    begin
     Wi := ApplyRect.Right - ApplyRect.Left;
     He := ApplyRect.Bottom - ApplyRect.Top;
     Bmp := TBitmap.Create;
     Bmp.HandleType := bmDIB;
     Bmp.PixelFormat := pf32bit;
     Bmp.Width := Wi;
     Bmp.Height := He;
     Angle := Angle*pi/180.0;
     Angle := Angle - trunc(Angle/(pi*2))*(pi*2);
     if Angle < 0 then
       Angle := Angle + 2*pi;
     inv := true;
     if ((Angle > pi) and (Angle < pi*3/2)) or ((Angle > 0) and (Angle < pi/2)) then begin
       inv := false;
       Angle := pi - Angle;
     end;
     if (Angle > pi/2) and (Angle < pi) then begin
       Col := ColorFrom;
       ColorFrom := ColorTo;
       ColorTo := Col;
     end;

     t := Tan(Angle);
     t90 := Tan(Angle+pi/2.0);
     t_t90 := t - t90;

     L := (t*Wi-He);
     L := L/(t_t90);
     L := sqrt( sqr(L) + sqr(L*t90) );

     ColorFrom := ColorToRGB(ColorFrom);
     ColorTo := ColorToRGB(ColorTo);
     r := GetRValue(ColorFrom);
     g := GetGValue(ColorFrom);
     b := GetbValue(ColorFrom);
     dr := (GetRValue(ColorTo) - r)/L;
     dg := (GetGValue(ColorTo) - g)/L;
     db := (GetBValue(ColorTo) - b)/L;

     for i := 0 to He-1 do begin
       Line := Bmp.ScanLine[i];
       if inv then i2 := i else i2 := He - i;
       for j := 0 to Wi-1 do begin
         L := (i2 - t90*j)/(t_t90);
         L := sqrt( sqr(L-j) + sqr(L*t-i2) );
         Line[j].rgbRed := r + round(L*dr);
         Line[j].rgbGreen := g + round(L*dg);
         Line[j].rgbBlue := b + round(L*db);
       end;
     end;

     BitBlt(Can.Handle, ApplyRect.Left, ApplyRect.Top, Wi, He, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
     Bmp.Free;
    end;

  • homm © (15.09.07 00:54) [20]
    > [16] Lacmus ©   (14.09.07 23:58)

    Работает только для углов до 90°?
  • Lacmus © (15.09.07 09:44) [21]
    >homm ©   (15.09.07 00:53) [19]

    Классно, хотя почему вычисляется тангенс 90 градусов без ошибки остается загадкой

    >homm ©   (15.09.07 00:54) [20]

    Там и с ClipRect тоже есть проблемы - он не выставлен
  • Lacmus © (15.09.07 17:05) [22]
    На основе homm ©   (15.09.07 00:53) [19]



    procedure DrawAngleGradient(aCanvas: TCanvas; aRect: TRect; aColor1, aColor2: TColor; aAngle: Integer);
    type
     RGBQuadArray = array[0..0] of TRGBQuad;
    var
     FromR, FromG, FromB: Byte;
     bBottomToTop: Boolean;
     Bitmap: TBitmap;
     i, j, k, W, H: Integer;
     CoeffR, CoeffG, CoeffB, SinA, CosA, C: Extended;
     Line: ^RGBQuadArray;
    begin
     W := aRect.Right - aRect.Left;
     H := aRect.Bottom - aRect.Top;
     Bitmap := TBitmap.Create;
     try
       Bitmap.HandleType  := bmDIB;
       Bitmap.PixelFormat := pf32bit;
       Bitmap.SetSize(W, H);

       aAngle := aAngle mod 360;

       if aAngle < 0 then
         aAngle := aAngle + 360;

       if (aAngle >= 180) then begin
         i := aColor1;
         aColor1 := aColor2;
         aColor2 := i;
         aAngle := aAngle - 180;
       end;

       bBottomToTop := (aAngle > 90) and (aAngle < 180);
       if bBottomToTop then
         aAngle := 180 - aAngle;

       SinCos(aAngle * PI / 180, SinA, CosA);

       C := W * SinA + H * CosA;

       FromR := GetRValue(AColor1);
       FromG := GetGValue(AColor1);
       FromB := GetBValue(AColor1);

       CoeffR := (GetRValue(aColor2) - FromR) / C;
       CoeffG := (GetGValue(aColor2) - FromG) / C;
       CoeffB := (GetBValue(aColor2) - FromB) / C;

       for i := 0 to H - 1 do begin
         Line := Bitmap.ScanLine[i];
         if bBottomToTop then
           k := H - i
         else
           k := i;
         for j := 0 to W - 1 do begin
           C := j * SinA + k * CosA;
           Line[j].rgbRed   := FromR + Round(C * CoeffR);
           Line[j].rgbGreen := FromG + Round(C * CoeffG);
           Line[j].rgbBlue  := FromB + Round(C * CoeffB);
         end
       end;
       BitBlt(aCanvas.Handle, aRect.Left, aRect.Top, W, H, Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
     finally
       Bitmap.Free
     end
    end;


  • homm © (15.09.07 22:28) [23]
    Спасибо :) все-же я сам видимо не так силен в геметрии (или в логике, раз не смог додуматься до более простого варианта).
    Но я пошел еще дальше ;)

    procedure DrawAngleGradient(aCanvas: TCanvas; aRect: TRect; aColor1, aColor2: TColor; aAngle: Integer);
    type
     RGBQuadArray = array[0..0] of TRGBQuad;
    var
     FromR, FromG, FromB: Byte;
     bBottomToTop: Boolean;
     Bitmap: TBitmap;
     i, j, k, W, H: Integer;
     CoeffR, CoeffG, CoeffB, SinA, CosA, C: Integer;
     Line: ^RGBQuadArray;
    begin
     W := aRect.Right - aRect.Left;
     H := aRect.Bottom - aRect.Top;
     Bitmap := TBitmap.Create;
     try
       Bitmap.HandleType  := bmDIB;
       Bitmap.PixelFormat := pf32bit;
       Bitmap.Width := W;
       Bitmap.Height := H;

       aAngle := aAngle mod 360;

       if aAngle < 0 then
         aAngle := aAngle + 360;

       if (aAngle >= 180) then begin
         i := aColor1;
         aColor1 := aColor2;
         aColor2 := i;
         aAngle := aAngle - 180;
       end;

       bBottomToTop := (aAngle > 90) and (aAngle < 180);
       if bBottomToTop then
         aAngle := 180 - aAngle;
         
       SinA := round(sin(aAngle * PI / 180)*256);
       CosA := round(cos(aAngle * PI / 180)*256);

       C := W * SinA + H * CosA;

       FromR := GetRValue(AColor1);
       FromG := GetGValue(AColor1);
       FromB := GetBValue(AColor1);

       CoeffR := (GetRValue(aColor2) - FromR)*256 div (C shr 8);
       CoeffG := (GetGValue(aColor2) - FromG)*256 div (C shr 8);
       CoeffB := (GetBValue(aColor2) - FromB)*256 div (C shr 8);

       for i := 0 to H - 1 do begin
         Line := Bitmap.ScanLine[i];
         if bBottomToTop then
           k := H - i
         else
           k := i;
         for j := 0 to W - 1 do begin
           C := j * SinA + k * CosA;
           Line[j].rgbRed   := FromR + ((C * CoeffR) shr 16);
           Line[j].rgbGreen := FromG + ((C * CoeffG) shr 16);
           Line[j].rgbBlue  := FromB + ((C * CoeffB) shr 16);
         end;
       end;

       BitBlt(aCanvas.Handle, aRect.Left, aRect.Top, W, H, Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
     finally
       Bitmap.Free
     end;
    end;



    мой старый вариант на тестовой сцене — 2050мс,
    вариант из [22] — 1150мс,
    этот ваиант — 310мс.
  • antonn © (15.09.07 22:43) [24]
    homm ©  
    k * CosA;

    можно вынести в первый цикл, будет еще чуть быстрее:)
  • homm © (15.09.07 22:55) [25]
    > [24] antonn ©   (15.09.07 22:43)

    Даже нескольких процентов не получилось :) Тем не менее точность повысил точность.

    procedure DrawAngleGradient(aCanvas: TCanvas; aRect: TRect; aColor1, aColor2: TColor; aAngle: Integer);
    type
     RGBQuadArray = array[0..0] of TRGBQuad;
    var
     FromR, FromG, FromB: Byte;
     bBottomToTop: Boolean;
     Bitmap: TBitmap;
     i, j, k, W, H: Integer;
     CoeffR, CoeffG, CoeffB, SinA, CosA, C, C1: Integer;
     Line: ^RGBQuadArray;
    begin
     W := aRect.Right - aRect.Left;
     H := aRect.Bottom - aRect.Top;
     Bitmap := TBitmap.Create;
     try
       Bitmap.HandleType  := bmDIB;
       Bitmap.PixelFormat := pf32bit;
       Bitmap.Width := W;
       Bitmap.Height := H;

       aAngle := aAngle mod 360;

       if aAngle < 0 then
         aAngle := aAngle + 360;

       if (aAngle >= 180) then begin
         i := aColor1;
         aColor1 := aColor2;
         aColor2 := i;
         aAngle := aAngle - 180;
       end;

       bBottomToTop := (aAngle > 90) and (aAngle < 180);
       if bBottomToTop then
         aAngle := 180 - aAngle;
         
       SinA := round(sin(aAngle * PI / 180)*4096);
       CosA := round(cos(aAngle * PI / 180)*4096);

       C := (W * SinA + H * CosA) shr 12;

       FromR := GetRValue(AColor1);
       FromG := GetGValue(AColor1);
       FromB := GetBValue(AColor1);

       CoeffR := (GetRValue(aColor2) - FromR)*4096 div C;
       CoeffG := (GetGValue(aColor2) - FromG)*4096 div C;
       CoeffB := (GetBValue(aColor2) - FromB)*4096 div C;

       for i := 0 to H - 1 do begin
         Line := Bitmap.ScanLine[i];
         if bBottomToTop then
           k := (H - i) * CosA
         else
           k := i * CosA;
         for j := 0 to W - 1 do begin
           C := j * SinA + k;
           Line[j].rgbRed   := FromR + ((C * CoeffR) shr 24);
           Line[j].rgbGreen := FromG + ((C * CoeffG) shr 24);
           Line[j].rgbBlue  := FromB + ((C * CoeffB) shr 24);
         end;
       end;

       BitBlt(aCanvas.Handle, aRect.Left, aRect.Top, W, H, Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
     finally
       Bitmap.Free
     end;
    end;

  • DVM © (15.01.08 14:21) [26]

    > homm ©   (15.09.07 22:55) [25]

    Вот так побыстрее процентов на 20:


    procedure DrawAngleGradient2(DC: HDC; ARect: TRect; AColor1, AColor2: TColor; AAngle: Integer);
    type
    RGBQuadArray = array[0..0] of TRGBQuad;
    var
    FromR, FromG, FromB: Byte;
    bBottomToTop: Boolean;
    i, j, k, W, H: Integer;
    CoeffR, CoeffG, CoeffB, SinA, CosA, C: Integer;
    Line: ^RGBQuadArray;

    bmi: BITMAPINFO;
    PBits: pointer;
    MemDC: HDC;
    MemBmp: HBITMAP;

    LineBytes: integer;
    nRow: integer;

    function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
    begin
     Dec(Alignment);
     Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
     Result := Result div 8;
    end;

    function GetScanLine(bmi: BITMAPINFO; Bits: pointer; Row: Integer): Pointer;
    var
      nRow: integer;
    begin
      if bmi.bmiHeader.biHeight > 0 then
        nRow := bmi.bmiHeader.biHeight - Row - 1
      else
        nRow := Row;
      Integer(Result) := Integer(Bits) + nRow * BytesPerScanline(bmi.bmiHeader.biWidth, bmi.bmiHeader.biBitCount, 32);
    end;

    begin
      W := aRect.Right - aRect.Left;
      H := aRect.Bottom - aRect.Top;

      ZeroMemory(@bmi, sizeof(bmi));

      bmi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
      bmi.bmiHeader.biCompression := BI_RGB;
      bmi.bmiHeader.biBitCount := 32;
      bmi.bmiHeader.biPlanes := 1;
      bmi.bmiHeader.biWidth := w;
      bmi.bmiHeader.biHeight := h;
      bmi.bmiHeader.biSizeImage := 0;
      bmi.bmiHeader.biClrUsed :=0;
      bmi.bmiHeader.biClrImportant:=0;

      MemDC := CreateCompatibleDC(DC);
      MemBmp := CreateDIBSection(MemDC, bmi, DIB_RGB_COLORS, pBits, 0, 0);
      SelectObject(MemDC, MemBmp);

      aAngle := aAngle mod 360;

      if aAngle < 0 then
        aAngle := aAngle + 360;

      if (aAngle >= 180) then begin
        i := aColor1;
        aColor1 := aColor2;
        aColor2 := i;
        aAngle := aAngle - 180;
      end;

      bBottomToTop := (aAngle > 90) and (aAngle < 180);
      if bBottomToTop then
        aAngle := 180 - aAngle;

      SinA := round(sin(AAngle * PI / 180) * 4096);
      CosA := round(cos(AAngle * PI / 180) * 4096);

      C := (W * SinA + H * CosA) shr 12;

      FromR := GetRValue(AColor1);
      FromG := GetGValue(AColor1);
      FromB := GetBValue(AColor1);

      CoeffR := (GetRValue(aColor2) - FromR) * 4096 div C;
      CoeffG := (GetGValue(aColor2) - FromG) * 4096 div C;
      CoeffB := (GetBValue(aColor2) - FromB) * 4096 div C;

      for i := 0 to H - 1 do begin

        Line := GetScanLine(bmi, pBits, i);

        if bBottomToTop then
          k := (H - i) * CosA
        else
          k := i * CosA;

        for j := 0 to W - 1 do begin
          C := j * SinA + k;
          Line[j].rgbRed   := FromR + ((C * CoeffR) shr 24);
          Line[j].rgbGreen := FromG + ((C * CoeffG) shr 24);
          Line[j].rgbBlue  := FromB + ((C * CoeffB) shr 24);
        end;
      end;

      BitBlt(DC, ARect.Left, ARect.Top, W, H, MemDC, 0, 0, SRCCOPY);
      DeleteObject(MemBmp);
      DeleteObject(MemDC);
    end;

    А для углов кратных 90 надо вообще по другому действовать - можно в 10-20 раз быстрее залить.

 
Конференция "Media" » Градиент с углом [D6, WinXP]
Есть новые Нет новых   [133928   +471][b:0][p:0.011]