Как сделать калькулятор в Delphi?

Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.

Как Delphi реализует многоплатформенную разработку?

Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...

Рисование кривых по заданным точкам

Советы » Графика » Рисование кривых по заданным точкам

Здесь я использую процедуру рисования кривой Безье между двумя точками. Можно задать кривизну кривой(20-35 лучше всего). Можно задать число отрезков между соседними точками, а если в процедуре DrawSlice убрать коментарий со строки

//  num_slices:=trunc(sqrt(sqr(p1.x-p2.x)+sqr(p1.y-p2.y)));

то число отрезков между соседними точками будет расчитываться автоматически, исходя из растояния между ними. Если потребуются дополнительные коментарии, пишите по адресу andrus78@mail.ru

unit

u_bezier; interface

uses

Windows, Graphics, SysUtils; type

TArrayPoint = array

of

TPoint; //массив точек const

num_slices: integer = 20; //число отрезков между двумя точками krivizna: integer = 30; //кривизна кривой (длина плеча направляющей) procedure

DrawBezier(acanv: TCanvas; var

ArrPoint: TArrayPoint); ///////////////////////////////////////////////////////////////////// implementation

uses

unit1; type

TBezierPoint = record

//точка Безье x, y: integer; //основной узел xl, yl, //левая контрольная точка xr, yr: single; //правая контрольная точка end

; TArrayBezierPoint = array

of

TBezierPoint; //массив точек Безье const

grad_to_rad = pi / 180; //перевод градусов в радианы rad_to_grad = 180 / pi; //перевод радиан в градусы rad_90 = 90 * grad_to_rad; //90 градусов в радианах rad_180 = 180 * grad_to_rad; //180 градусов в радианах rad_270 = 270 * grad_to_rad; //270 градусов в радианах rad_360 = 360 * grad_to_rad; //360 градусов в радианах var

Canvas: TCanvas; //рабочий холст, на котором происходит рисование //определить угол в радианах между точкой и положительным направлением оси х function

GetAngle(dx, dy: single): single; begin

if

dx = 0 then

begin

if

dy = 0 then

Result := 0 else

if

dy < 0 then

Result := rad_270 else

Result := rad_90; exit end

; Result := arctan(abs(dy) / abs(dx)); if

dy < 0 then

if

dx < 0 then

Result := rad_180 + Result else

Result := rad_360 - Result else

if

dx < 0 then

Result := rad_180 - Result end

; //определить направляющие линии к точке p procedure

GetCooPerpendikular(a, o, b: TPoint; var

p: TBezierPoint); var

alfa, beta, gamma, dx, dy, angle_napr: single; l1, l2: single; begin

dx := a.x - o.x; dy := a.y - o.y; alfa := GetAngle(dx, dy); l1 := sqrt(dx * dx + dy * dy) * (krivizna / 100); //растояние oa dx := b.x - o.x; dy := b.y - o.y; beta := GetAngle(dx, dy); l2 := sqrt(dx * dx + dy * dy) * (krivizna / 100); //растояние ob gamma := (alfa + beta) / 2; //биссектриса угла aob if

alfa > beta then

angle_napr := gamma + rad_90 else

angle_napr := gamma - rad_90; p.xl := o.x + l1 * cos(angle_napr); p.yl := o.y + l1 * sin(angle_napr); p.xr := o.x + l2 * cos(angle_napr + rad_180); p.yr := o.y + l2 * sin(angle_napr + rad_180) end

; //вычислить координаты точки, лежащей на участке кривой между //двумя точками Безье в пределах от 0 до 1 procedure

BezierValue(P1, P2: TBezierPoint; t: single; var

X, Y: integer); var

t_sq, t_cb, r1, r2, r3, r4: single; begin

t_sq := t * t; t_cb := t * t_sq; r1 := (1 - 3 * t + 3 * t_sq - t_cb); r2 := (3 * t - 6 * t_sq + 3 * t_cb); r3 := (3 * t_sq - 3 * t_cb); r4 := (t_cb); X := round(r1 * p1.x + r2 * p1.xr + r3 * p2.xl + r4 * p2.x); Y := round(r1 * p1.y + r2 * p1.yr + r3 * p2.yl + r4 * p2.y) end

; //рисуй участок кривой между двумя точками Безье procedure

DrawSlice(p1, p2: TBezierPoint); var

i: integer; x, y: integer; r1, r2: TRect; begin

// если убрать комментарий, то количество отрезков между соседними // точками будет расчитываться исходя из растояния между ними // num_slices:=trunc(sqrt(sqr(p1.x-p2.x)+sqr(p1.y-p2.y))); Canvas.MoveTo(p1.x, p1.y); for

i := 1 to

num_slices - 1 do

begin

BezierValue(p1, p2, i / num_slices, x, y); Canvas.LineTo(x, y) end

; Canvas.LineTo(p2.x, p2.y) end

; //рисуй кривую на холсте acanv по точкам массива ArrPoint procedure

DrawBezier(acanv: TCanvas; var

ArrPoint: TArrayPoint); var

ArrBezPoint: TArrayBezierPoint; i, num_point: integer; a, o, b: TPoint; begin

Canvas := acanv; num_point := high(ArrPoint) + 1; SetLength(ArrBezPoint, num_point); for

i := 0 to

num_point - 1 do

begin

ArrBezPoint[i].x := ArrPoint[i].x; ArrBezPoint[i].y := ArrPoint[i].y; end

; ArrBezPoint[0].xr := ArrPoint[0].x; ArrBezPoint[0].yr := ArrPoint[0].y; ArrBezPoint[0].xl := ArrPoint[0].x; ArrBezPoint[0].yl := ArrPoint[0].y; for

i := 1 to

num_point - 2 do

begin

a := ArrPoint[i - 1]; o := ArrPoint[i]; b := ArrPoint[i + 1]; GetCooPerpendikular(a, o, b, ArrBezPoint[i]) end

; ArrBezPoint[num_point - 1].xr := ArrPoint[num_point - 1].x; ArrBezPoint[num_point - 1].yr := ArrPoint[num_point - 1].y; ArrBezPoint[num_point - 1].xl := ArrPoint[num_point - 1].x; ArrBezPoint[num_point - 1].yl := ArrPoint[num_point - 1].y; for

i := 1 to

num_point - 1 do

DrawSlice(ArrBezPoint[i - 1], ArrBezPoint[i]) end

; end

. // *********************************** // // использовать этот модуль можно так: // // *********************************** // procedure

TForm1.Button2Click(Sender: TObject); var

ArrPoint: TArrayPoint; begin

SetLength(ArrPoint, 5); ArrPoint[0].x := random(200); ArrPoint[0].y := random(200); ArrPoint[1].x := random(200); ArrPoint[1].y := random(200); ArrPoint[2].x := random(200); ArrPoint[2].y := random(200); ArrPoint[3].x := random(200); ArrPoint[3].y := random(200); ArrPoint[4].x := random(200); ArrPoint[4].y := random(200); num_slices := 10; krivizna := 30; DrawBezier(Form1.Canvas, ArrPoint) end

; // нужно не забыть включить модуль в список используемых: // implementation // uses u_bezier;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2024 - All Rights Reserved - www.delphirus.com