Текущий архив: 2009.11.22;
Скачать: CL | DM;

Вниз

Градиент с углом   Найти похожие ветки 

← →
Jimmy   (2007-09-12 22:48) [0]

Не подскажет ли кто алгоритм градиентной линейной заливки, но не горизонтальной или вертикальной, он есть, а с произвольным углом Alfa?

---

← →
homm ©   (2007-09-13 13:20) [1]

школьные знания по геометрии должны пригодиться.

---

← →
Jimmy   (2007-09-13 16:46) [2]

Аналогичным образом я мог бы отвечать абсолютно на все вопросы форума.

---

← →
MBo ©   (2007-09-13 18:13) [3]

>Аналогичным образом я мог бы отвечать абсолютно на все вопросы форума.
Попробуй

homm © прав
градиентная заливка по горизонтали или по вертикали по сути есть зависимость цвета от одной  координаты. В случае диагонали зависимость будет от двух координат.
С Пифагором вместе не служили?

---

← →
sdubaruhnul   (2007-09-13 20:10) [4]

>Не подскажет ли кто алгоритм градиентной линейной заливки, но не горизонтальной или вертикальной, он есть, а с произвольным углом Alfa?

А где должен быть чисто первый цвет и чисто второй?

---

← →
ha   (2007-09-14 13:59) [5]

Есть алгоритм рисования линии по клеткам(как в школьной тетрадке)
реализуй его, а цвет меняй сам что бы плавно изменялся от начала к концу

---

← →
homm ©   (2007-09-14 14:01) [6]

> [5] ha   (14.09.07 13:59)

Что-бы потом тот, кто такой код увидит, руки оторвал тому, кто его напишет :)

---

← →
antonn ©   (2007-09-14 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 ©   (2007-09-14 14:12) [8]

ой, я там забыл почистить %)))

---

← →
antonn ©   (2007-09-14 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 ©   (2007-09-14 17:04) [10]

> antonn ©  

ужос какой то

---

← →
antonn ©   (2007-09-14 17:33) [11]

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

согласен, но все же лучше, чем размышления, что школьный курс геометрии может пригодиться :)

---

← →
homm ©   (2007-09-14 21:43) [12]

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

Вот по этому я промолчал, когда увидел твой код :)

---

← →
homm ©   (2007-09-14 21:50) [13]

> [11] antonn ©   (14.09.07 17:33)

Хрень полную рисует, если честно :(

---

← →
antonn ©   (2007-09-14 22:02) [14]

в натуре... ехе не перекомпилил и запостил, щас исправлю:)

---

← →
Инс ©   (2007-09-14 23:10) [15]

Можно еще сюда глянуть:
http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1090

---

← →
Lacmus ©   (2007-09-14 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 ©   (2007-09-15 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   (2007-09-15 00:45) [18]

Огромное спасибо to Lacmus! А также всем, кто пытается оказать реальную помощь!

---

← →
homm ©   (2007-09-15 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 ©   (2007-09-15 00:54) [20]

> [16] Lacmus ©   (14.09.07 23:58)

Работает только для углов до 90°?

---

← →
Lacmus ©   (2007-09-15 09:44) [21]

>homm ©   (15.09.07 00:53) [19]

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

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

Там и с ClipRect тоже есть проблемы - он не выставлен

---

← →
Lacmus ©   (2007-09-15 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 ©   (2007-09-15 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 ©   (2007-09-15 22:43) [24]

homm ©  
k * CosA; можно вынести в первый цикл, будет еще чуть быстрее:)

---

← →
homm ©   (2007-09-15 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 ©   (2008-01-15 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 раз быстрее залить.


---

Страницы: 1 вся ветка

Текущий архив: 2009.11.22;
Скачать: CL | DM;

Наверх

Память: 0.56 MB
Время: 0.019 c