Drawing oval path through four points - ios

I have a four points that I want to draw oval that path through these four points
I do not want to use [UIBezierPath bezierPathWithOvalInRect:frame];
Because it can not work with rotated rectangle.

I suppose that your 4 points are not arbitrary ones, but middles of edges of rectangle around the ellipse.
You can build path from four Bezier curves to approximate zero-centered unit circle. Example of code here
Then apply to control points affine transformation that transform circle to rotated ellipse with semi-axes A and B, center (CX, CY) and rotation angle Alpha.
For your case, if points are P0..P3, then
A = |P0P2| (distance)
B = |P1P3|
CX = (P0.X + P2.X)/2
CY = (P0.Y + P2.Y)/2
Alpha = ArcTan2(P0.Y - P2.Y, P0.X - P2.X)
I have Delphi code for this problem, hope it could help. Note that closed Bezier path contains 13 points (the last is the same as the first).
procedure CalcRotatedEllipse(CX, CY, A, B: Integer; Alpha: Double; var BezPts: array of TPoint);
const
MP = 0.55228475;
var
CA, SA, ACA, ASA, BCA, BSA: Double;
i, CX2, CY2: Integer;
function TransformPoint(X, Y: Double): TPoint;
begin
Result.X := Round(CX + X * ACA + Y * BSA);
Result.Y := Round(CY - X * ASA + Y * BCA);
end;
begin
Assert(Length(BezPts) = 13);
CA:= Cos(Alpha); SA := Sin(Alpha);
ACA := A * CA; ASA := A * SA;
BCA := B * CA; BSA := B * SA;
CX2 := 2 * CX; CY2 := 2 * CY;
BezPts[0] := TransformPoint(1, 0);
BezPts[1] := TransformPoint(1, MP);
BezPts[2] := TransformPoint(MP, 1);
BezPts[3] := TransformPoint(0, 1);
BezPts[4] := TransformPoint(- MP, 1);
BezPts[5] := TransformPoint(-1, MP);
for i := 0 to 5 do
BezPts[i + 6] := Point(CX2 - BezPts[i].X, CY2 - BezPts[i].Y);
BezPts[12] := BezPts[0];
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Pts: array[0..12] of TPoint;
begin
CalcRotatedEllipse(200, 200, 200, 70, Pi/6, Pts);
Canvas.PolyBezier(Pts);
end;

Related

How to draw a projectile following specific XY coordinates on a given bitmp under Delphi

In fact i want to draw an animated line from a given Tpoint coordinates to an other Tpoint on a Bitmap canvas for that i tried to read some open sources of OpenGl but task seems to be hard for my little competences in delphi i found this C++ source on github and its exactly what i want to do but under delphi 2009 if the line is animated it could be better for this personnal game prototype.
i tried some functions like -LineDDA- but its is very limited.
i look for somthing like this:
function Make_Projectile( canvas:tcanvas;Start,Target:Tpoint):boolean;
with canvas do
draw the animated_arc_line form start to trget;
if we toutch target then result= true else false...
end;
I tried this piece of code:
procedure ArcByStartEndAngle(Canvas:TCanvas;P0, P1: TPoint; Angle: Double; NSeg: Integer);
var
i: Integer;
len, dx, dy, mx, my, px, py, t, cx, cy, p0x, p0y, an: Double;
xx, yy: Integer;
begin
mx := (P0.x + P1.x) / 2;
my := (P0.y + P1.y) / 2;
dx := (P1.x - P0.x) / 2;
dy := (P1.y - P0.y) / 2;
len := Math.Hypot(dx, dy);
px := -dy / len;
py := dx / len;
if Angle = Pi then
t := 0
else
t := len / Math.Tan(Angle / 2);
cx := mx + px * t;
cy := my + py * t;
p0x := P0.x - cx;
p0y := P0.y - cy;
for i := 0 to NSeg + 1 do
begin
an := i * Angle / (NSeg + 1);
xx := Round(cx + p0x * Cos(an) - p0y * Sin(an));
yy := Round(cy + p0x * Sin(an) + p0y * Cos(an));
Canvas.Pen.Color:=clBlue;
Canvas.Brush.Color:=clRed;
Canvas.Ellipse(xx - 3, yy - 3, xx + 4, yy + 4);
end;
end;
and for these arguments it gives : this result
ArcByStartEndAngle(Form1.Image1.Canvas, Point(574,199),Point(62,202), Pi / 2, 8);
Please left a piece of code that can help or at list a translation of c code above for drawing the desired effect.
the following screenshoot could give an idea : ScreenShoot
enter image description here
**

Delphi draw parabola with PlotGird

I am using a PlotGrid component with Firemonkey and I want to be able to draw a parabola in it. Given a very easy program that takes a,b,c as input ( > ax^2 + bx + c = 0) I am going to solve the 2nd degree equation.
As you should know that can be represented with a parabola. I thought that I could use this procedure:
procedure DrawArc(const Center, Radius: TPointF; StartAngle, SweepAngle: Single; const AOpacity: Single); overload;
You can see this picture to better understand the meaning:
I want to be able to draw a parabola in a PlotGrid because the user in this way I can have a "container" for my line. Also, if I resized the component or I am using a mobile device, I won't have to repaint the x/y axis. Is this a good way to go?
I have studied a bit the situation and this is what I have thought:
The focus coords of the parabola should be what in the procedure are called Center.
The Radius.X should be the value of one of the solutions of the equations. I The Radius.Y should be the position of the vertex.
I cannot figure how to setup the sweep angle. Is this too complicated? Should I find another better solution to draw the parabola?
You cannot draw parabola with ellipse arc, it doesn't give needed curve form (only small parabola piece near middle point might be approximated).
If Firemonkey graphics engine supports Bezier curves, you can draw exact parabola with Bezier. To calculate it's coefficients, express X- and Y- parts of parametric cubic curve in power basis
F(x) = -b/2a + (t - 0.5) * needed_parabola_X_range
F(y) = a*F(x)^2 + b * F(x) + c
then transform them into Bernstein polynomial basis (here you need some understanding of Bezier math)
VCL example
var
a, b, c, w: Double;
b2a, baw: Double;
P: array[0..3] of TPoint;
Cx, Cy: array[0..3] of Double;
begin
//vertex at (200, 100)
a := 0.05;
b := -20;
c := 2100;
W := 160; //width, distance between parabola ends
b2a := - 0.5 * b / a;
baw := b2a - 0.5 * W;
Cx[0] := baw;
Cx[1] := W;
Cx[2] := 0;
CX[3] := 0;
Cy[0] := a * baw * baw + c + b * baw;
Cy[1] := b * W + 2 * a * W * baW;
Cy[2] := a * W * W;
Cy[3] := 0;
p[0] := Point(Round(Cx[0]), Round(Cy[0]));
p[1].X := Round(cx[0] + cx[1] / 3);
p[1].Y := Round(cy[0] + cy[1] / 3);
p[2].X := Round(cx[0] + (2 * cx[1] + cx[2]) / 3);
p[2].Y := Round(cy[0] + (2 * cy[1] + cy[2]) / 3);
p[3].X := Round(cx[0] + cx[1] + cx[2] + cx[3]);
p[3].Y := Round(cy[0] + cy[1] + cy[2] + cy[3]);
Canvas.PolyBezier(P);

Rotation has no effect on GetPath?

I'm using Delphi (XE5) to create a graphic component. One challenge is to rotate a closed path by SetWorldTransform, then read back the outline with GetPath. Rotation works ok, but the points retreived from GetPath are not rotated (however, obtating a region (PathToRegion) works as expected!).
My code:
procedure Rotate(DestBitmap : TBitmapEx; Radians : Single; FigureRect : TRect);
// DestBitmap is where to draw the figure. Size of DestBitmap is computed from
//the actual angle and figure size (not shown here). FigureRect is the plain
//figure rectangle without rotation
var
XForm: tagXFORM;
C, S : single;
Points : array of TPoint;
NumPoints : integer;
Bytes : TByteArray;
Rgn : HRGN;
X, Y : integer;
begin
//Locate FigureRect to center of bitmap:
X := (DestBitmap.Width - FigureRect.Width) div 2;
Y := (DestBitmap.Height - FigureRect.Height) div 2;
FigureRect.Location := Point(X,Y);
//Set rotate mode
C := Cos(Radians);
S := Sin(Radians);
XForm.eM11 := C;
XForm.eM12 := S;
XForm.eM21 := -S;
XForm.eM22 := C;
XForm.eDx := (DestBitmap.Width - DestBitmap.Width * C +
DestBitmap.Height * S) / 2;
XForm.eDy := (DestBitmap.Height - DestBitmap.Width * S -
DestBitmap.Height * C) / 2;
SetGraphicsMode(DestBitmap.Canvas.Handle, GM_ADVANCED);
SetWorldTransform(DestBitmap.Canvas.Handle, XForm);
//Rotate the figure
BeginPath(DestBitmap.Canvas.Handle);
DestBitmap.Canvas.Rectangle(FigureRect);
EndPath(DestBitmap.Canvas.Handle);
FlattenPath(DestBitmap.Canvas.Handle);
NumPoints := GetPath(DestBitmap.Canvas.Handle, Points[0], Bytes[0], 0);
SetLength(Points, NumPoints);
GetPath(DestBitmap.Canvas.Handle, Points[0], Bytes[0], NumPoints);
//Points now describes the plain, unrotated figure, but if instead:
//Rgn := PathToRegion(DestBitmap.Canvas.Handle);
//Rgn describes the rotated area, as expected
end;
That is expected, GetPath returns points in logical coordinates. Whereas the resulting region of PathToRegion uses device coordinates - so it is unaffected by the transform. See documentation of both functions.
Or three, SetWorldTransform transforms logical coordinates. To everything in the logical world, nothing has been changed. The transform is with respect to the device.

Image "fade" in / out (Not opacity)

I want to "fade" in / out an image. But not opacity-wise.
Pictures say more than words:
Original image:
Desired image:
How can I do that programatically? Not the way like "use Bitmap.Canvas" but the mathematical approach. ("For dummies" if possible ... :D)
I want the image to have a fade-in / -out area, not linear increasing but "curvy". I guess it has something to do with Bezier curves? If yes, how would I setup the points to get a curve like that?
Or what would be your approach here?
Thanks for any help! :)
Here is roughly how you would go about doing it (as you said, you're looking for the logic and not the full implementation)
Create the basic shape outline: Create a partial sine-wave, such that the semi-period (half-wavelength: P1 = L/2) equals the length (x-coordinate size) of your image.
Add Overtones: Add to it another sine-function. This time with wavelength given by P2 = P1 / 2 + rnd where rnd is a random real number in the interval (-P1/4 , +P1 / 4)
Repeat: Now P2 becomes the new P1.
That way you can generate the 'wavy-waves' by modulating the main wave and you will get the top boundary.
You can change the sign and get the lower boundary.
The word you might be looking for (for the shape, i.e.) is Overtones. You could look up more on generating overtones for optics or acoustics.
This example for adding overtones to a straight line would give a better idea. The code above adds up these sinusoidal waves of randomly shortening periods to create the wave-on-wave effect (source)
Thanks again, hnk. You got me the right ideas. :)
I did a little work and ended up with this:
procedure GenerateOverlayEdges(ABitmap: TBitmap; ARadiusX, ARadiusY: Integer);
const
MAX_ANGLE = 90;
var
ShapePosition, ShapeIndex, ShapesCount,
Angle, X, Y, RadiusX, RadiusY, CenterY: Integer;
PolyPoints: Array of TPoint;
begin
ABitmap.Canvas.Pen.Color := clBlack;
ABitmap.Canvas.Brush.Color := clBlack;
//ABitmap.Canvas.Pen.Color := clWhite;
//ABitmap.Canvas.Brush.Color := clWhite;
RadiusX := ARadiusX;
RadiusY := ARadiusY;
CenterY := Round(ABitmap.Height / 2);
ShapesCount := Ceil(CenterY / RadiusY);
for ShapePosition := 1 to 4 do // 1 = TopLeft, 2 = BottomLeft, 3 = TopRight, 4 = BottomRight
for ShapeIndex := 0 to ShapesCount - 1 do // Index of current "stair"
begin
Finalize(PolyPoints);
SetLength(PolyPoints, MAX_ANGLE + 1);
for Angle := 0 to MAX_ANGLE do
begin
case ShapePosition of
1, 3:
begin
RadiusX := Abs(RadiusX);
RadiusY := Abs(RadiusY);
end;
2, 4:
begin
RadiusX := Abs(RadiusX);
RadiusY := -Abs(RadiusY);
end;
end;
X := Trunc(RadiusX * Cos(Angle * 2 * Pi / 360));
Y := Trunc(RadiusY * Sin(Angle * 2 * Pi / 360));
case ShapePosition of
1:
begin
X := X + ShapeIndex * RadiusX;
Y := Y + CenterY - RadiusY - ShapeIndex * RadiusY;
end;
2:
begin
X := X + ShapeIndex * RadiusX;
Y := Y + CenterY - RadiusY + ShapeIndex * Abs(RadiusY);
end;
3:
begin
X := ABitmap.Width - X - ShapeIndex * Abs(RadiusX);
Y := Y + CenterY - RadiusY - ShapeIndex * RadiusY;
end;
4:
begin
X := ABitmap.Width - X - ShapeIndex * Abs(RadiusX);
Y := Y + CenterY + Abs(RadiusY) + ShapeIndex * Abs(RadiusY);
end;
end;
// Add points as part of a Polyon
PolyPoints[Angle] := Point(X, Y);
end;
// Set Y to the Y borders for the very first and last point of the polygon so we will get a "closed" shape
case ShapePosition of
1, 3:
begin
PolyPoints[0] := Point(PolyPoints[0].X, 0);
PolyPoints[Angle - 1] := Point(PolyPoints[Angle - 1].X, 0);
end;
2, 4:
begin
PolyPoints[0] := Point(PolyPoints[0].X, ABitmap.Height);
PolyPoints[Angle - 1] := Point(PolyPoints[Angle - 1].X, ABitmap.Height);
end;
end;
// Draw the poly points ... and fill the background at the same time
ABitmap.Canvas.Polygon(PolyPoints);
end;
Finalize(PolyPoints);
end;
Usage:
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile('C:\Temp\Osc 2.bmp'); // Original Oscilloscope Image
GenerateOverlayEdges(Bmp, 15, 20);
Bmp.SaveToFile('C:\Temp\Osc 3.bmp');
finally
Bmp.Free;
end;
end;
By changing the RadiusX and RadiusY parameters of the GenerateOverlayEdges function I can adjust the results:
8x8:
15x20:
20x10:

How to create part of a rainbow gradient

I need to generate a gradient bitmap that displays a rainbow gradient between two colors which are chosen by a user. To generate a rainbow is easy. The code below I got from Wiki and slightly adapted it. It has the advantage of being fast and simple.
function TColor_Dialog.GiveRainbowColor (fraction: double): TAlphaColor;
var
m: Double;
r, g, b, mt: Byte;
begin
if fraction <= 0 then m := 0 else
if fraction >= 1 then m := 6
else m := fraction * 6;
mt := (round (frac (m) * $FF));
case Trunc (m) of
0: begin
R := $FF;
G := mt;
B := 0;
end;
1: begin
R := $FF - mt;
G := $FF;
B := 0;
end;
2: begin
R := 0;
G := $FF;
B := mt;
end;
3: begin
R := 0;
G := $FF - mt;
B := $FF;
end;
4: begin
R := mt;
G := 0;
B := $FF;
end;
5: begin
R := $FF;
G := 0;
B := $FF - mt;
end;
end; // case
Result := ColorToQuad (r, g, b);
end; // GiveRainbowColor //
Trouble with this algorithm is it can't show a partial rainbow between two colors. Well, of course it can but than you have to approach the fraction of each color and I don't like that solution. I tried decomposing the color into its r, g, b channels but that did not work. The reason is quite obvious by hindsight. Suppose you need a gradient between FF0000 and 0000FF. You'll have a red color transforming from FF->00 and a blue from 00->FF. However, there is no green (00FF00) which is clearly present in a rainbow gradient.
What I need is a gradient function that I can give two colors and a fraction and it generates a color. Can anyone point me to an article, algorithm or even code?
Update
NGLN's answer is the right answer for this question. Both he and Warren wondered what to do when a a color is not a bright color (a color containing a 0, a $FF and a value). I tried several angles: up/downscaling and HSL interpolation. I finally settled down for the last one as being the most simple.
Basically you have two colors: from and to. Use RGBtoHSL to extract the HSL parameters from each color: RGBtoHSL (col_from, hf, sf, lf). Next compute the hue, saturation and luminance between both colors and reconstruct a new color. This is what NGLN mentions in his update about hue, but if you generalise this principle you have a rainbow between any color.
function TColor_Dialog.interpolate_hsl (col_from, col_to: TAlphaColor; fraction: double): TAlphaColor;
var af, at, ad: uInt8;
hf, ht, hd: single;
sf, st, sd: single;
lf, lt, ld: single;
begin
// Get each rgb color channel
af := GetAValue (col_from);
at := GetAValue (col_to);
RGBtoHSL (col_from, hf, sf, lf);
RGBtoHSL (col_to, ht, st, lt);
// Compute differences
ad := af + Round (fraction * (at - af));
hd := hf + fraction * (ht - hf);
sd := sf + fraction * (st - sf);
ld := lf + fraction * (lt - lf);
Result := MakeColor (HSLtoRGB (hd, sd, ld), ad);
end; // interpolate_hsl //
This gives a rainbow for all colors possible. I apply the same interpolation for the opacity, hence the use of MakeColor to 'fumble' the interpolated alpha channel into the color.
Then you need to calculate the position of a color in the Rainbow; the inverse of GiveRainbowColor:
function RainbowIndex(BrightColor: TColor): Double;
var
R: Byte;
G: Byte;
B: Byte;
begin
R := GetRValue(ColorToRGB(BrightColor));
G := GetGValue(ColorToRGB(BrightColor));
B := GetBValue(ColorToRGB(BrightColor));
if (R * G * B <> 0) or ((R <> 255) and (G <> 255) and (B <> 255)) then
Result := -1
else if B = 0 then
if R = 255 then
Result := 0 + G / 255
else
Result := 1 + (255 - R) / 255
else if R = 0 then
if G = 255 then
Result := 2 + B / 255
else
Result := 3 + (255 - G) / 255
else { G = 0 }
if B = 255 then
Result := 4 + R / 255
else
Result := 5 + (255 - B) / 255;
Result := Result / 6;
end;
(But this displays a problem for colors not having both a 0 and a 255 part. In other words: you would also need to calculate the bright color from a shaded, tinted or grayed color. See update below.)
Example usage to get the rainbow slice from clRed to clBlue:
procedure TForm1.FormPaint(Sender: TObject);
var
Start: Double;
Finish: Double;
X: Integer;
begin
Start := RainbowIndex(clRed);
Finish := RainbowIndex(clBlue);
for X := 0 to ClientWidth - 1 do
begin
Canvas.Brush.Color := GiveRainbowColor(0, ClientWidth - 1, X);
Canvas.FillRect(Bounds(X, 0, 1, 50));
Canvas.Brush.Color :=
GiveRainbowColor(0, ClientWidth - 1, Round(Start + (Finish - Start) * X));
Canvas.FillRect(Bounds(X, 50, 1, 50));
end;
end;
Update:
The RainbowIndex routine above really does nothing more then calculate the hue property of the color. The GraphUtil unit provides conversion routines for the HSL color model which makes this RainbowIndex routine kind of obsolete and gives the advantage to be able to feed any TColor value:
uses
GraphUtil;
const
HLSMAX = 240;
function Hue(AColor: TColor): Double;
var
Hue: Word;
Luminance: Word;
Saturation: Word;
begin
ColorRGBToHLS(ColorToRGB(AColor), Hue, Luminance, Saturation);
Result := Hue / HLSMAX;
end;
Example usage to get the rainbow slice from clMoneyGreen to clPurple:
function RainbowColor(Hue: Double): TColor; overload;
begin
Hue := EnsureRange(Hue, 0, 1) * 6;
case Trunc(Hue) of
0: Result := RGB(255, Round(Frac(Hue) * 255), 0);
1: Result := RGB(255 - Round(Frac(Hue) * 255), 255, 0);
2: Result := RGB(0, 255, Round(Frac(Hue) * 255));
3: Result := RGB(0, 255 - Round(Frac(Hue) * 255), 255);
4: Result := RGB(Round(Frac(Hue) * 255), 0, 255);
else
Result := RGB(255, 0, 255 - Round(Frac(Hue) * 255));
end;
end;
function RainbowColor(MinHue, MaxHue, Hue: Integer): TColor; overload;
begin
Result := RainbowColor((Hue - MinHue) / (MaxHue - MinHue + 1));
end;
procedure TForm1.FormPaint(Sender: TObject);
var
X: Integer;
Start: Double;
Finish: Double;
begin
Start := Hue(clMoneyGreen);
Finish := Hue(clPurple);
for X := 0 to ClientWidth - 1 do
begin
Canvas.Brush.Color := RainbowColor(0, ClientWidth - 1, X);
Canvas.FillRect(Bounds(X, 0, 1, 50));
Canvas.Brush.Color :=
RainbowColor(Start + (Finish - Start) * X / ClientWidth);
Canvas.FillRect(Bounds(X, 50, 1, 50));
end;
end;
Furthermore, the RainbowColor routine could be shortened to:
function RainbowColor(Hue: Double): TColor; overload;
begin
Result := ColorHLStoRGB(Round(Hue * HLSMAX), HLSMAX div 2, HLSMAX);
end;

Resources