|
Antwort |
Registriert seit: 25. Jun 2010 94 Beiträge Delphi 2005 Professional |
#1
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; Geändert von snook (15. Sep 2011 um 12:07 Uhr) Grund: anhang vergessen... |
Zitat |
Registriert seit: 25. Jun 2010 94 Beiträge Delphi 2005 Professional |
#2
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
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; Geändert von snook (15. Sep 2011 um 18:07 Uhr) |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |