hallo,

ich habe hier eine methode um einen elliptischen farb-gradienten zu erzeugen (von einer elliptischen quelle zu einer elliptischen begrenzung). die idee dahinter ist folgende:

- betrachte zwei ellipsen, eine kleine in einer großen eingebettet
- lege dabei zentrum der kleinen ellipse in den Koordinatenursprung
- berechne für alle punkte (X,Y) zwischen diesen beiden ellipsen:
- die gerade, die durch den Punkt P := (X,Y), und den Koord-Ursprung geht (also den ortsvektor)
- berechne die schnittpunkte S1, S2 dieses ortsvektors mit den beiden ellipsen (S1, schnittpunkt mit äusserer Ellipse, S2 schnittpunkt mit innerer Ellipse)
- berechne den betrag von dist_S1 := OS1 (O = KoordUrsprung)
- berechne den betrag von dist_S2 := OS2 (O = KoordUrsprung)
- berechne den betrag von dist := S1S2
- berechne den betrag von dist_PS2 := PS2

damit lässt sich nun das verhältnis zwischen den strecken (Punkt - innere Ellipse) zu (äussere Ellipse - innere Ellipse) bilden wobei ein wert von 1 einem punkt auf der äusseren ellipse entspricht, und 0 einem auf der inneren.
ordnet man jetzt dieses verhältnis einem linearen farbverlauf zwischen einer beliebiger anzahl von farben (Colors = Array of TColor) zu, wobei Colors[0] einem wert von 0 und entsprechend Colors[high(Colors)] einem wert von 1 zugeordnet wird, dann hat man seinen gradienten...

soweit die theorie, bei der umsetzung hapert es allerdings...im anhang ist ein foto eines schwarzweiß gradienten, und eines Blau-schwarz ich bekomme immer diese mysteriösen zwei kreise rein...

ich werd hier bald blöde, ich starre jetzt schon seit mehreren stunden auf diesen QT, sehe den wald vor lauter bäumen nicht mehr

vielleicht nimmt sich einer von euhc die zeit und kann sich das mal anschauen
ich wäre euch echt dankbar, ichr könnt dann auch die procedir behalten

zusammenfalten · markieren

Delphi-Quellcode:

procedure CircularGradientPattern(Center: TPoint; OuterRadius, InnerRadius: TRealPoint;
  Colors: array of TColor; var Bitmap: TBitmap; Region: HRGN = 0);
var PixelsTop,
    PixelsBottom : PRGBArray;
    X, Y : integer;
    YSquare,
    XSquare,
    sin_x, cos_x,
    lInnerRad,
    lOuterRad,
    lOuterEllipseRad: extended;
    LInnerRadius,
    LOuterEllipse: TRealPoint;
    StepCl : TColor;
begin
  if (OuterRadius.X = 0) or (OuterRadius.Y = 0) then
    raise Exception.Create(SysErrorMessage(DISP_E_OVERFLOW));
  if not Assigned(bitmap) then
  begin
    Bitmap := TBitmap.Create;
    Bitmap.Height := trunc(2 * OuterRadius.X) + 1;
    Bitmap.Width := trunc(2 * OuterRadius.Y) + 1;
  end;
  Bitmap.PixelFormat := pf24Bit;
  LInnerRadius.X := max(InnerRadius.X, 0);
  LInnerRadius.Y := max(InnerRadius.Y, 0);

  LOuterEllipse := RealPoint(max(0, OuterRadius.X), max(0, OuterRadius.Y));

  for y := 0 to Center.Y do
  begin
    PixelsTop := Bitmap.ScanLine[y];
    if (2 * Center.Y - Y < Bitmap.Height) and (y <> Center.Y) then
      PixelsBottom := Bitmap.ScanLine[(2 * Center.Y) - Y - 1]
    else
      PixelsBottom := nil;

    YSquare := sqr(Center.Y - Y);
    for x := 0 to Bitmap.Width - 1 do
      if (Region = 0) or PtInRegion(Region, X, Y) or (Assigned(PixelsBottom) and (
         (Region = 0) or PtInRegion(Region, X, (2 * Center.Y) - Y - 1))) then
      begin
        XSquare := sqr(X - Center.X);
        lOuterRad := sqrt(XSquare + YSquare);
        if lOuterRad <> 0 then
        begin
          sin_x := (Center.Y - Y) / lOuterRad; //
          cos_x := (X - Center.X) / lOuterRad;
          lInnerRad := sqrt(sqr(LInnerRadius.X * cos_x) + sqr(LInnerRadius.Y * sin_x));
          lOuterEllipseRad := sqrt(sqr(LOuterEllipse.X * cos_x) + sqr(LOuterEllipse.Y * sin_x));
        end;

// LInnerRad = Betrag(KoordUrsprung - Schnittpunkt(X,Y) mit innerer ellipse
// lOuterEllipseRad = Betrag(KoordUrsprung - Schnittpunkt(X,Y) mit äusserer ellipse
// LOuterrad = Betrag ortsvektor (X,Y)

        if ((lOuterEllipseRad - lInnerRad) <> 0) and (lOuterRad <> 0) then
        begin
          StepCl := ColorsBetween(Colors,
                                     min(1,
                                         abs(lOuterRad - lInnerRad) /
                                         abs(lOuterEllipseRad - lInnerRad)));
        end
        else
          if lOuterRad = 0 then
            StepCl := Colors[0]
          else
            StepCl := ColorsBetween(Colors,1);

        if (Region = 0) or PtInRegion(Region, X, Y) then
        begin
          PixelsTop^[x].rgbtBlue := GetBValue(StepCl);
          PixelsTop^[x].rgbtGreen := GetGValue(StepCl);
          PixelsTop^[x].rgbtRed := GetRValue(StepCl);
        end;

        if Assigned(PixelsBottom) and (
          (Region = 0) or PtInRegion(Region, X, (2 * Center.Y) - Y - 1)) then
        begin
          PixelsBottom^[x].rgbtBlue := GetBValue(StepCl);
          PixelsBottom^[x].rgbtGreen := GetGValue(StepCl);
          PixelsBottom^[x].rgbtRed := GetRValue(StepCl);
        end;
      end;
  end;

  for y := max(0, 2 * Center.Y) to Bitmap.Height - 1 do
  begin
    PixelsTop := Bitmap.ScanLine[y];
    YSquare := sqr(Center.Y - Y);
    for x := 0 to Bitmap.Width - 1 do
      if (Region = 0) or PtInRegion(Region, X, Y) then
      begin
        XSquare := sqr(X - Center.X);
        lOuterRad := sqrt(XSquare + YSquare);
        if lOuterRad <> 0 then
        begin
          sin_x := (Center.Y - Y) / lOuterRad;
          cos_x := (X - Center.X) / lOuterRad;
          lInnerRad := sqrt(sqr(LInnerRadius.X * cos_x) + sqr(LInnerRadius.Y * sin_x));
          lOuterEllipseRad := sqrt(sqr(LOuterEllipse.X * cos_x) + sqr(LOuterEllipse.Y * sin_x));
        end;

        if ((lOuterEllipseRad - lInnerRad) <> 0) and (lOuterRad <> 0) then
        begin
          StepCl := ColorsBetween(Colors,
                                     min(1,
                                         abs(lOuterRad - lInnerRad) /
                                         abs(lOuterEllipseRad - lInnerRad)));
        end
        else
          if lOuterRad = 0 then
            StepCl := Colors[0]
          else
            StepCl := ColorsBetween(Colors,1);

        if (Region = 0) or PtInRegion(Region, X, Y) then
        begin
          PixelsTop^[x].rgbtBlue := GetBValue(StepCl);
          PixelsTop^[x].rgbtGreen := GetGValue(StepCl);
          PixelsTop^[x].rgbtRed := GetRValue(StepCl);
        end;
      end;
  end;
end;

Problem gelöst,

falls es jemand anderem mal hilft, hier ist die lösung:

die annahme war, dass ich den schnittpunkt zwischen radiusvektor und ellipsen bekomme, indem ich den winkel zwischen x-Achse und fraglichem Ortsvektor berechne, und diesen dann benutze um damit eine ellipse darzustellen durch:
x(alpha) := cos(alpha) * a (a = große halbachse der ellipse)
y(alpha) := sin(alpha) * b (b = kleine halbachse der ellipse)

das klappt aber nicht, da man damit auf einem kreis "entlangfährt", und nicht auf einer ellipse...bzw beide überlagert auf eine lissajous (oder so ) figur. die lösung ist, die ellipsengleichung in polarkoordinaten zu nehmen (r, alpha), denn die enthalten bereits wunderschön den radius, siehe http://www.rainerstumpe.de/HTML/ellipse_mpg.html

was lernt man daraus? denken ist gut, nachschauen besser

ich stell mal noch die prozedur rein, ist noch nicht ganz gegen fehler abgesichert, aber ich denke für den anfang gehts (wenn es jemand braucht)

edit:\\ die funktion ColorsBetween liefert für ein Array of TColor einen farbwert zurück, der durch den zweiten parameter bestimmt wird, in der from, das ColorsBetween(Colors, 0) = Colors[0] und ColorsBetween(Colors, 1) = Colors[high(Colors)]
man kann sich die funktionieren implementieren wie man will, muss also nicht unbedingt ein linearer farbverlauf sein

zusammenfalten · markieren

Delphi-Quellcode:

procedure CircularGradientPattern(Center: TPoint; OuterRadius, InnerRadius: TRealPoint;
  Colors: array of TColor; var Bitmap: TBitmap; Region: HRGN = 0);
var PixelsTop,
    PixelsBottom : PRGBArray;
    X, Y : integer;
    YSquare,
    XSquare,
    angle,
    exzIn, exzOut,
    lInnerRad,
    lABSVector,
    lOuterEllipseRad: extended;
    LInnerRadius,
    LOuterEllipse: TRealPoint;
    StepCl : TColor;
begin
  if (OuterRadius.X = 0) or (OuterRadius.Y = 0) then
    raise Exception.Create(SysErrorMessage(DISP_E_OVERFLOW));
  if not Assigned(bitmap) then
  begin
    Bitmap := TBitmap.Create;
    Bitmap.Height := trunc(2 * OuterRadius.X) + 1;
    Bitmap.Width := trunc(2 * OuterRadius.Y) + 1;
  end;
  Bitmap.PixelFormat := pf24Bit;
  LInnerRadius.X := max(InnerRadius.X, 0);
  LInnerRadius.Y := max(InnerRadius.Y, 0);

  LOuterEllipse := RealPoint(max(0, OuterRadius.X), max(0, OuterRadius.Y));

  exzIn := 0;
  exzOut := 0;
  if LInnerRadius.X <> 0 then
    exzIn := sqrt(sqr(LInnerRadius.X) - sqr(LInnerRadius.Y)) / LInnerRadius.X;
  if LOuterEllipse.X <> 0 then
    exzOut := sqrt(sqr(LOuterEllipse.X) - sqr(LOuterEllipse.Y)) / LOuterEllipse.X;

  for y := 0 to Center.Y do
  begin
    PixelsTop := Bitmap.ScanLine[y];
    if (2 * Center.Y - Y < Bitmap.Height) and (y <> Center.Y) then
      PixelsBottom := Bitmap.ScanLine[(2 * Center.Y) - Y - 1]
    else
      PixelsBottom := nil;

    YSquare := sqr(Center.Y - Y);
    for x := 0 to Bitmap.Width - 1 do
      if (Region = 0) or PtInRegion(Region, X, Y) or (Assigned(PixelsBottom) and (
         (Region = 0) or PtInRegion(Region, X, (2 * Center.Y) - Y - 1))) then
      begin
        XSquare := sqr(X - Center.X);
        lABSVector := sqrt(XSquare + YSquare);
        if lABSVector <> 0 then
        begin
          if not (X = Center.X) then
            angle := arctan2(Center.Y - Y, X - Center.X)
          else
            angle := sign(Center.Y - Y) * pi / 2;

          if LOuterEllipse.X <> LOuterEllipse.Y then
            lOuterEllipseRad := LOuterEllipse.Y / (sqrt(1 - sqr(exzOut * cos(angle))))
          else
            lOuterEllipseRad := LOuterEllipse.X;

          if LInnerRadius.X <> LInnerRadius.Y then
            lInnerRad := LInnerRadius.Y / (sqrt(1 - sqr(exzOut * cos(angle))))
          else
            lInnerRad := LInnerRadius.X;
        end;

        if ((lOuterEllipseRad - lInnerRad) <> 0) and (lABSVector <> 0) then
        begin
          StepCl := ColorsBetween(Colors,
                                     min(1,
                                         abs(lABSVector - lInnerRad) /
                                         abs(lOuterEllipseRad - lInnerRad)));
        end
        else
          if lABSVector = 0 then
            StepCl := Colors[0]
          else
            StepCl := ColorsBetween(Colors,1);

        if (Region = 0) or PtInRegion(Region, X, Y) then
        begin
          PixelsTop^[x].rgbtBlue := GetBValue(StepCl);
          PixelsTop^[x].rgbtGreen := GetGValue(StepCl);
          PixelsTop^[x].rgbtRed := GetRValue(StepCl);
        end;

        if Assigned(PixelsBottom) and (
          (Region = 0) or PtInRegion(Region, X, (2 * Center.Y) - Y - 1)) then
        begin
          PixelsBottom^[x].rgbtBlue := GetBValue(StepCl);
          PixelsBottom^[x].rgbtGreen := GetGValue(StepCl);
          PixelsBottom^[x].rgbtRed := GetRValue(StepCl);
        end;
      end;
  end;

  for y := max(0, 2 * Center.Y) to Bitmap.Height - 1 do
  begin
    PixelsTop := Bitmap.ScanLine[y];
    YSquare := sqr(Center.Y - Y);
    for x := 0 to Bitmap.Width - 1 do
      if (Region = 0) or PtInRegion(Region, X, Y) then
      begin
        XSquare := sqr(X - Center.X);
        lABSVector := sqrt(XSquare + YSquare);
        if lABSVector <> 0 then
        begin
          if not (X = Center.X) then
            angle := arctan2(Center.Y - Y, X - Center.X)
          else
            angle := sign(Center.Y - Y) * pi / 2;

          if LOuterEllipse.X <> LOuterEllipse.Y then
            lOuterEllipseRad := LOuterEllipse.Y / (sqrt(1 - sqr(exzOut * cos(angle))))
          else
            lOuterEllipseRad := LOuterEllipse.X;

          if LInnerRadius.X <> LInnerRadius.Y then
            lInnerRad := LInnerRadius.Y / (sqrt(1 - sqr(exzOut * cos(angle))))
          else
            lInnerRad := LInnerRadius.X;
        end;

        if ((lOuterEllipseRad - lInnerRad) <> 0) and (lABSVector <> 0) then
        begin
          StepCl := ColorsBetween(Colors,
                                     min(1,
                                         abs(lABSVector - lInnerRad) /
                                         abs(lOuterEllipseRad - lInnerRad)));
        end
        else
          if lABSVector = 0 then
            StepCl := Colors[0]
          else
            StepCl := ColorsBetween(Colors,1);

        if (Region = 0) or PtInRegion(Region, X, Y) then
        begin
          PixelsTop^[x].rgbtBlue := GetBValue(StepCl);
          PixelsTop^[x].rgbtGreen := GetGValue(StepCl);
          PixelsTop^[x].rgbtRed := GetRValue(StepCl);
        end;
      end;
  end;
end;