:: MVP ::
|
|
:: RSS ::
|
|
|
Как нарисовать эллипс под углом?
// Способ первый
// CX, CY: кооординаты центра эллипса
// A, B: полуоси
// Angle: угол поворота в радианах
procedure EllipseAngle(Canvas: TCanvas; CX, CY, A, B: Integer; Angle: Double);
const
DXY = 0.55228475;
var
X, Y: array[0..12] of Single;
DX, DY: Single;
CF, SF: Single;
Pts: array[0..12] of TPoint;
i: Integer;
begin
DX := A * DXY;
DY := B * DXY;
X[0] := A; Y[0] := 0;
X[1] := A; Y[1] := DY;
X[2] := DX; Y[2] := B;
X[3] := 0; Y[3] := B;
X[4] := -DX; Y[4] := B;
X[5] := -A; Y[5] := DY;
X[6] := -A; Y[6] := 0;
X[7] := -A; Y[7] := -DY;
X[8] := -DX; Y[8] := -B;
X[9] := 0; Y[9] := -B;
X[10] := DX; Y[10] := -B;
X[11] := A; Y[11] := -DY;
X[12] := A; Y[12] := 0;
CF := Cos(Angle);
SF := Sin(Angle);
for i := 0 to 12 do
begin
Pts[i].X := Round(X[i] * CF - Y[i] * SF + CX);
Pts[i].Y := Round(X[i] * SF + Y[i] * CF + CY);
end;
Canvas.PolyBezier(Pts);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EllipseAngle(Canvas, 200, 200, 200, 100, - Pi/4);
end;
// Способ второй
// CX, CY: кооординаты центра эллипса
// A, B : полуоси
// Angle - угол поворота в радианах
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.Button1Click(Sender: TObject);
var
Pts: array[0..12] of TPoint;
begin
CalcRotatedEllipse(200, 200, 200, 70, Pi/6, Pts);
Canvas.PolyBezier(Pts);
end;
|
Как начертить круг?
uses
{...,} Math;
procedure DrawCircle(CenterX, CenterY, Radius: Integer; Canvas: TCanvas;
Color: TColor);
procedure PlotCircle(x, y, x1, y1: Integer);
begin
Canvas.Pixels[x + x1, y + y1] := Color;
Canvas.Pixels[x - x1, y + y1] := Color;
Canvas.Pixels[x + x1, y - y1] := Color;
Canvas.Pixels[x - x1, y - y1] := Color;
Canvas.Pixels[x + y1, y + x1] := Color;
Canvas.Pixels[x - y1, y + x1] := Color;
Canvas.Pixels[x + y1, y - x1] := Color;
Canvas.Pixels[x - y1, y - x1] := Color;
end;
var
x, y, r: Integer;
x1, y1, p: Integer;
begin
x := CenterX;
y := CenterY;
r := Radius;
x1 := 0;
y1 := r;
p := 3 - 2 * r;
while (x1 < y1) do
begin
PlotCircle(x, y, x1, y1);
if (p < 0) then
p := p + 4 * x1 + 6
else
begin
p := p + 4 * (x1 - y1) + 10;
y1 := y1 - 1;
end;
x1 := x1 + 1;
end;
if (x1 = y1) then
PlotCircle(x, y, x1, y1);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DrawCircle(ClientWidth div 2, ClientHeight div 2, Min(ClientWidth div 2,
ClientHeight div 2), Canvas, clBlack);
end;
|
Как изменить размеры полигона?
type
TPolygon = array of TPoint;
procedure ZoomPolygon(var Polygon: TPolygon; const Center: TPoint; const Scale: Double);
var
i: Integer;
begin
for i := 0 to High(Polygon) do
begin
Polygon[i].X := Round(Scale * (Polygon[i].X - Center.X) + Center.X);
Polygon[i].Y := Round(Scale * (Polygon[i].Y - Center.Y) + Center.Y);
end;
end;
|
Как нарисовать сетку из Hexagon'ов?
uses
{...,} Math;
procedure PlotPolygon(const Canvas: TCanvas; const N: Integer; const R: Single;
const XC: Integer; const YC: Integer);
type
TPolygon = array of TPoint;
var
Polygon: TPolygon;
i: Integer;
c: Extended;
s: Extended;
a: Single;
begin
SetLength(Polygon, N);
a := 2 * Pi / N;
for i := 0 to (N - 1) do
begin
SinCos(i * a, s, c);
Polygon[i].X := XC + Round(R * c);
Polygon[i].Y := YC + Round(R * s);
end;
Canvas.Polygon(Polygon);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
w: Single;
h: Single;
x: Integer;
y: Integer;
const
N = 6;
R = 10; // Размен Hexagon'а
begin
w := 1.5 * R;
h := R * Sqrt(3);
for x := 0 to Round(ClientWidth / w) do
for y := 0 to Round(ClientHeight / h) do
if Odd(x) then
PlotPolygon(Canvas, N, R, Round(x * w), Round((y + 0.5) * h))
else
PlotPolygon(Canvas, N, R, Round(x * w), Round(y * h));
end;
|
При использовании материала - ссылка на сайт обязательна
|
|