1

Тема: Zvetki demo(из чьей-то курсовой)

Пример основан на коде из курсовой работы на тему "Моделирование движения объектов в Pascal".
Работа была найдена тут
misc.php?action=pun_attachment&item=158&download=0

Исходный код
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 

2

Re: Zvetki demo(из чьей-то курсовой)

А почему на крупных размерах перекрытие такое некрасивое?

3

Re: Zvetki demo(из чьей-то курсовой)

Наверное, автор не учёл, что расстояние надо увеличивать.
Скорее всего, у него разрешение было меньше, и проблема была не заметна.