Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Рисование фрактальных графов
...Очередная нетленка, которую я предлагаю Вам, написана мной самостоятельно (идею и примеры, реализованные в программе, я нашел в апрельском номере журнала "Химия и жизнь" за 1995 год). Теоретически она производит трансляцию L-систем с выводом образовавшихся фрактальных графов, а практически рисует кусты и деревья. Вроде бесполезно, но очень красиво. Эта программа написана для TP7, хотя легко переносится на Delphi (как то я уже переводил ее, но модуль бесследно исчез). Буду надеяться, что она придется Вам по душе.
usesgraph, crt; const
GrafType = 1; {1..3} type
PointPtr = ^Point; Point = record
X, Y: Word; Angle: Real; Next: PointPtr end
; GrfLine = array
[0..5000] of
Byte; ChangeType = array
[1..30] of
record
Mean: Char; NewString: string
end
; var
K, T, Dx, Dy, StepLength, GrafLength: Word; grDriver, Xt: Integer; grMode: Integer; ErrCode: Integer; CurPosition: Point; Descript: GrfLine; StartLine: string
absolute
Descript; ChangeNumber, Generation: Byte; Changes: ChangeType; AngleStep: Real; Mem: Pointer; procedure
Replace(var
Stroka: GrfLine; OldChar: Char; Repl: string
); var
I, J: Word; begin
if
(GrafLength = 0) or
(Length(Repl) = 0) then
Exit; I := 1; while
I <= GrafLength do
begin
if
Chr(Stroka[I]) = OldChar then
begin
for
J := GrafLength downto
I + 1 do
Stroka[J + Length(Repl) - 1] := Stroka[J]; for
J := 1 to
Length(Repl) do
Stroka[I + J - 1] := Ord(Repl[J]); I := I + J; GrafLength := GrafLength + Length(Repl) - 1; continue end
; I := I + 1 end
end
; procedure
PushCoord(var
Ptr: PointPtr; C: Point); var
P: PointPtr; begin
New(P); P^.X := C.X; P^.Y := C.Y; P^.Angle := C.Angle; P^.Next := Ptr; Ptr := P end
; procedure
PopCoord(var
Ptr: PointPtr; var
Res: Point); begin
if
Ptr <> nil
then
begin
Res.X := Ptr^.X; Res.Y := Ptr^.Y; Res.Angle := Ptr^.Angle; Ptr := Ptr^.Next end
end
; procedure
FindGrafCoord(var
Dx, Dy: Word; Angle: Real; StepLength: Word); begin
Dx := Round(Sin(Angle) * StepLength * GetMaxX / GetMaxY); Dy := Round(-Cos(Angle) * StepLength); end
; procedure
NewAngle(Way: ShortInt; var
Angle: Real; AngleStep: Real); begin
if
Way >= 0 then
Angle := Angle + AngleStep else
Angle := Angle - AngleStep; if
Angle >= 4 * Pi then
Angle := Angle - 4 * Pi; if
Angle < 0 then
Angle := 4 * Pi + Angle end
; procedure
Rost(var
Descr: GrfLine; Cn: Byte; Ch: ChangeType); var
I: Byte; begin
for
I := 1 to
Cn do
Replace(Descr, Ch[I].Mean, Ch[I].NewString); end
; procedure
Init1; begin
AngleStep := Pi / 8; StepLength := 7; Generation := 4; ChangeNumber := 1; CurPosition.Next := nil
; StartLine := 'F'; GrafLength := Length(StartLine); with
Changes[1] do
begin
Mean := 'F'; NewString := 'FF+[+F-F-F]-[-F+F+F]' end
; end
; procedure
Init2; begin
AngleStep := Pi / 4; StepLength := 3; Generation := 5; ChangeNumber := 2; CurPosition.Next := nil
; StartLine := 'G'; GrafLength := Length(StartLine); with
Changes[1] do
begin
Mean := 'G'; NewString := 'GFX[+G][-G]' end
; with
Changes[2] do
begin
Mean := 'X'; NewString := 'X[-FFF][+FFF]FX' end
; end
; procedure
Init3; begin
AngleStep := Pi / 10; StepLength := 9; Generation := 5; ChangeNumber := 5; CurPosition.Next := nil
; StartLine := 'SLFF'; GrafLength := Length(StartLine); with
Changes[1] do
begin
Mean := 'S'; NewString := '[+++G][---G]TS' end
; with
Changes[2] do
begin
Mean := 'G'; NewString := '+H[-G]L' end
; with
Changes[3] do
begin
Mean := 'H'; NewString := '-G[+H]L' end
; with
Changes[4] do
begin
Mean := 'T'; NewString := 'TL' end
; with
Changes[5] do
begin
Mean := 'L'; NewString := '[-FFF][+FFF]F' end
; end
; begin
case
GrafType of
1: Init1; 2: Init2; 3: Init3; else
end
; grDriver := detect; InitGraph(grDriver, grMode, ''); ErrCode := GraphResult; if
ErrCode <> grOk then
begin
WriteLn('Graphics error:', GraphErrorMsg(ErrCode)); Halt(1) end
; with
CurPosition do
begin
X := GetMaxX div
2; Y := GetMaxY; Angle := 0; MoveTo(X, Y) end
; SetColor(white); for
K := 1 to
Generation do
begin
Rost(Descript, ChangeNumber, Changes); Mark(Mem); for
T := 1 to
GrafLength do
begin
case
Chr(Descript[T]) of
'F': begin
FindGrafCoord(Dx, Dy, CurPosition.Angle, StepLength); with
CurPosition do
begin
Xt := X + Dx; if
Xt < 0 then
X := 0 else
X := Xt; if
X > GetMaxX then
X := GetMaxX; Xt := Y + Dy; if
Xt < 0 then
Y := 0 else
Y := Xt; if
Y > GetMaxY then
Y := GetMaxY; LineTo(X, Y) end
end
; 'f': begin
FindGrafCoord(Dx, Dy, CurPosition.Angle, StepLength); with
CurPosition do
begin
Xt := X + Dx; if
Xt < 0 then
X := 0 else
X := Xt; if
X > GetMaxX then
X := GetMaxX; Xt := Y + Dy; if
Xt < 0 then
Y := 0 else
Y := Xt; if
Y > GetMaxY then
Y := GetMaxY; MoveTo(X, Y) end
end
; '+': NewAngle(1, CurPosition.Angle, AngleStep); '-': NewAngle(-1, CurPosition.Angle, AngleStep); 'I': NewAngle(1, CurPosition.Angle, 2 * Pi); '[': PushCoord(CurPosition.Next, CurPosition); ']': begin
PopCoord(CurPosition.Next, CurPosition); with
CurPosition do
MoveTo(X, Y) end
end
end
; Dispose(Mem); Delay(1000) end
; repeat
until
KeyPressed; CloseGraph end
.