Ver Mensaje Individual
  #10  
Antiguo 06-01-2009
Avatar de aeff
aeff aeff is offline
Miembro
 
Registrado: oct 2006
Ubicación: Cuba, Guantánamo
Posts: 348
Reputación: 18
aeff Va camino a la fama
miren, la solución que encontré, ¿que opinan?, para no calentarme mucho la cabeza:

Código Delphi [-]
  type TColorPercent = record
    Color: TColor;
    Percent: 0..100;
  end;

  procedure Circle(ACanvas: TCanvas; X, Y, Radio: Integer);
  var
    pLeft, pTop, pDimX, pDimY: Integer;
  begin
    with aCanvas do
      begin
        Brush.Color := Pen.Color;
        pLeft := X - Radio;
        pTop  := Y - Radio;
        pDimX := X + Radio;
        pDimY := Y + Radio;
        Ellipse(pLeft, pTop, pDimX, pDimY);
      end;
  end;

  function GetChannelIn(X1, X2: Byte; Index, Max: LongInt): Byte;
  var
    vPercentIndex, vDifference, vPercentDiff: Real;
  begin
    vPercentIndex := 0.0;
    try
    // p/t = x/100
    // Index/max = x/100
    // index/max * 100 = x
      if Max = 0 then Max := 1; 
      vPercentIndex := Index / Max * 100;
    except

    end;
      vDifference := X2 - X1;
    // p/t  = x/100
    // p/vDifference = vPercentIndex/100
    // vPercentDiff = vPercentIndex / 100 *  vDifference;
      vPercentDiff := vPercentIndex / 100 *  vDifference;
      Result := X1 + Round(vPercentDiff);
  end;

  {-«------------------------------------------------------------------------»-}

  function GetGradientValue(aColor1, aColor2: TColor; Index, Max: Longint): TColor;
  var
    Color1, Color2: Integer;
    R1, G1, B1, R2, G2, B2, nR, nG, nB: Byte;
  begin
    Color1 := ColorToRGB(aColor1);
    Color2 := ColorToRGB(aColor2);
    R1 := GetRValue(Color1);  G1 := GetGValue(Color1);  B1 := GetBValue(Color1);
    R2 := GetRValue(Color2);  G2 := GetGValue(Color2);  B2 := GetBValue(Color2);

    nR := GetChannelIn(R1, R2, Index, Max);
    nG := GetChannelIn(G1, G2, Index, Max);
    nB := GetChannelIn(B1, B2, Index, Max);

    Result := TColor(RGB(nR, nG, nB));
  end;

 procedure GetRadialFigure(aWidth, aHeight: Integer; aColorList: array of TColorPercent;
                                             var vResult: TBitmap);
  var
    aBitmap: TBitmap;
    aRadio, aSubRadio, CX{Centro X}, CY{Centro Y},
    Index, xFrom, xTo, xRect: Integer;
    aColor1, aColor2, I: TColor;
  begin

    if High(aColorList) <= 0 then Exit;
    aBitmap := TBitmap.Create;
    aBitmap.Assign(vResult);
    aBitmap.PixelFormat := pf24bit;
    aBitmap.Width := aWidth;
    aBitmap.Height := aHeight;
    aRadio := Round(Sqrt( Sqr(aWidth) + Sqr(aHeight) ) / 2);
    CX := aWidth div 2;
    CY := aHeight div 2;

    Index := High(aColorList);


    while Index > 0 do
      begin
        xFrom := (aColorList[Index -1].Percent);
        xTo := (aColorList[Index].Percent);
        xFrom := Round(xFrom / 100 * aRadio);
        xTo := Round(xTo / 100 * aRadio);
        aSubRadio := xTo;  {Índice, o nuevo radio, o radio drecementativo}
        xRect := xTo - xFrom;  {Valor máximo}

        aColor1 := aColorList[Index -1].Color; {Menor}
        aColor2 := aColorList[Index].Color;  {Mayor}
        I := xRect;

        while aSubRadio > xFrom do
          begin
            aBitmap.Canvas.Pen.Color := GetGradientValue(aColor1, aColor2, I, xRect);
            Circle(aBitmap.Canvas, CX, CY, aSubRadio);
            aSubRadio := aSubRadio - 1;
            Dec(I);
          end;
        Dec(Index);
      end;

    vResult.Assign(aBitmap);
    aBitmap.Free;
  end;

ahora, añado un TImage y un Button y en el evento OnCLick del button coloco esto:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
var
  aBmp: TBitmap;
  lstColors: array of TColorPercent;
begin
       //
  SetLength(lstColors, 2);
  lstColors[0].Percent := 0; lstColors[0].Color := clRed;
  lstColors[1].Percent := 100; lstColors[1].Color := clYellow;
  aBmp := TBitmap.Create;
  aBmp.Width := 200;
  aBmp.Height := 200;
  aBmp.PixelFormat := pf24bit;
  GetRadialFigure(200,200, lstColors, aBmp);
  Image1.Picture.Assign(aBmp);
end;

¿bueno, que opinan?

saludos!
aeff!
Responder Con Cita