Einzelnen Beitrag anzeigen

snook

Registriert seit: 25. Jun 2010
94 Beiträge
 
Delphi 2005 Professional
 
#1

Ellipsenberechnung

  Alt 15. Sep 2011, 12:05
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

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;
Angehängte Grafiken
Dateityp: bmp shadow.bmp (14,7 KB, 29x aufgerufen)
Dateityp: bmp bmp.bmp (14,7 KB, 26x aufgerufen)

Geändert von snook (15. Sep 2011 um 12:07 Uhr) Grund: anhang vergessen...
  Mit Zitat antworten Zitat