Тема: Zvetki demo(из чьей-то курсовой)
Пример основан на коде из курсовой работы на тему "Моделирование движения объектов в Pascal".
Работа была найдена тут
▼Исходный код
program Zvetki;
uses
KolibriOS;
function Trunc(Value: Extended): Int64;
asm
FLD Value
SUB ESP, 12
FNSTCW word ptr [ESP]
FNSTCW word ptr [ESP + 2]
OR word ptr [ESP + 2], $0F00
FLDCW word ptr [ESP + 2]
FISTP qword ptr [ESP + 4]
FLDCW word ptr [ESP]
POP ECX
POP EAX
POP EDX
end;
function Sin(Value: Extended): Extended;
asm
FLD Value
FSIN
end;
function Cos(Value: Extended): Extended;
asm
FLD Value
FCOS
end;
var
WndLeft, WndTop, WndWidth, WndHeight: LongInt;
Hue: Word;
type
TRGBQuad = packed record
Blue: Byte;
Green: Byte;
Red: Byte;
Alpha: Byte;
end;
(* H = [0..360]; S = [0..255]; V = [0..255] *)
function HSV2RGB(H, S, V: LongWord): LongWord;
const
D: LongWord = 255 * 60;
var
F, VS: LongWord;
begin
with TRGBQuad(Result) Do
begin
if S = 0 then
begin
Red := V;
Green := V;
Blue := V;
end
else
begin
if H = 360 then H := 0;
F := H mod 60;
H := H div 60;
VS := V * S;
case H of
0:
begin
Red := V;
Green := V - (VS * (60 - F)) div D;
Blue := V - VS div 255;
end;
1:
begin
Red := V - (VS * F) div D;
Green := V;
Blue := V - VS div 255;
end;
2:
begin
Red := V - VS div 255;
Green := V;
Blue := V - (VS * (60 - F)) div D;
end;
3:
begin
Red := V - VS div 255;
Green := V - (VS * F) div D;
Blue := V;
end;
4:
begin
Red := V - (VS * (60 - F)) div D;
Green := V - VS div 255;
Blue := V;
end;
5:
begin
Red := V;
Green := V - VS div 255;
Blue := V - (VS * F) div D;
end;
end;
end;
end;
end;
var
m, x1, y1, l, c, x0, y0, x2, y2, ii: Integer;
h, x, y, a, b, z, f, r, hp, ll, p: Real;
procedure Init;
begin
Randomize;
ii := 0;
m := 5;
a := 0;
b := 2 * PI;
r := 5;
x2 := WndWidth div 2;
y2 := WndHeight div 2;
hp := 2 * PI / 15;
ll := 0.5;
end;
procedure On_Redraw;
begin
Init;
BeginDraw;
DrawWindow(WndLeft, WndTop, WndWidth, WndHeight, 'Zvetki', $003F3F3F,
WS_SKINNED_FIXED + WS_CLIENT_COORDS + WS_CAPTION, CAPTION_MOVABLE);
EndDraw;
end;
procedure Draw;
var
i: Integer;
begin
p := ii * hp;
l := Trunc(Random(5) + 2);
x0 := x2 + Trunc (m * r * Cos(p));
y0 := y2 - Trunc(m * r * Sin(p));
c := Trunc(Random(6) + 9);
h := (b - a) / 1000;
for i := 1 to 1000 do
begin
f := a + i * h;
z := ll * (Sin(l * f) - Cos(l * f));
x := z * Cos(f);
y := z * Sin(f);
x1 := Trunc(x0 + x * m);
y1 := Trunc(y0 - y * m);
SetPixel(x1, y1, HSV2RGB(Hue, 192, 255));
end;
r := r + 0.5;
ll := ll + 0.05;
Inc(ii);
if ii > 14 then
ii := 0;
Inc(Hue, WndHeight div 60);
if Hue >= 360 then
Hue := 0;
if (x1 < 0) or (y1 < 0) or (x1 > WndWidth) or (y1 > WndHeight) then
On_Redraw;
end;
begin
with GetScreenSize do
begin
WndWidth := Width * 6 div 7;
WndHeight := Height * 6 div 7;
WndLeft := (Width - WndWidth) div 2;
WndTop := (Height - WndHeight) div 2;
end;
while True do
case WaitEventByTime(10) of
REDRAW_EVENT:
On_Redraw;
KEY_EVENT:
Break;
BUTTON_EVENT:
if GetButton.ID = 1 then
Break;
else
Draw;
end;
end.
Скомпилированное приложение Zvetki.kex
Post's attachments
0.gif 1.98 Мб, 33 скачиваний с 2022-02-15
Zvetki.kex 1.37 Кб, 77 скачиваний с 2022-02-15