情人节红攻瑰--Delphi版本

在oschina上看到了用c写的红玫瑰, 以前只见过用js写的, 就随手用delphi翻译了c的代码, 效果还不错哈....

原c作者jokeym贴子 http://www.oschina.net/code/snippet_2373787_48760

我的改版贴子 http://www.oschina.net/code/snippet_212659_48907

以下为代码:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.Math;

// 原作者贴子,
// http://www.oschina.net/code/snippet_2373787_48760

// delphi版本
// ying32


const
  RAND_MAX = $7FFF;
  urosesize: Integer = 500;
  uh: Integer = -250;

type
// 定义结构体
  TDOT = record
    x: Double;
    y: Double;
    z: Double;
    r: Double;  // 红色
    g: double;  // 绿色
    // b(蓝色) 通过 r 计算
  end;

function calc(a, b, c: Double; var d: TDOT): Boolean;
var
  j, n, o, w, z: Double;
  _A, _B: Double;
begin
  Result := False;
  if c > 60 then // 花柄
  begin
    d.x := sin(a * 7) * (13 + 5 / (0.2 + power(b * 4, 4))) - sin(b) * 50;
    d.y := b * urosesize + 50;
    d.z := 625 + cos(a * 7) * (13 + 5 / (0.2 + power(b * 4, 4))) + b * 400;
    d.r := a * 1 - b / 2;
    d.g := a;
    Exit(True);
  end;
  _A := a * 2 - 1;
  _B := b * 2 - 1;

  if _A * _A + _B * _B < 1 then
  begin
    if c > 37 then           // 叶
    begin
      j := Trunc(c) and 1;
      n := IfThen(j <> 0, 6, 4);
      o := 0.5 / (a + 0.01) + cos(b * 125) * 3 - a * 300;
      w := b * uh;

      d.x := o * cos(n) + w * sin(n) + j * 610 - 390;
      d.y := o * sin(n) - w * cos(n) + 550 - j * 350;
      d.z := 1180 + cos(_B + _A) * 99 - j * 300;
      d.r := 0.4 - a * 0.1 + power(1 - _B * _B, -uh * 6) * 0.15 - a * b * 0.4 + cos(a + b) / 5 + power(cos((o * (a + 1) + IfThen(_B > 0, w, -w)) / 25), 30) * 0.1 * (1 - _B * _B);
      d.g := o / 1000 + 0.7 - o * w * 0.000003;
      Exit(True);
    end;

    if c > 32 then           // 花萼
    begin
      c := c * 1.16 - 0.15;
      o := a * 45 - 20;
      w := b * b * uh;
      z := o * sin(c) + w * cos(c) + 620;

      d.x := o * cos(c) - w * sin(c);
      d.y := 28 + cos(_B * 0.5) * 99 - b * b * b * 60 - z / 2 - uh;
      d.z := z;
      d.r := (b * b * 0.3 + power((1 - (_A * _A)), 7) * 0.15 + 0.3) * b;
      d.g := b * 0.7;
      Exit(True);
    end;

        // 花
    o := _A * (2 - b) * (80 - c * 2);
    w := 99 - cos(_A) * 120 - cos(b) * (-uh - c * 4.9) + cos(power(1 - b, 7)) * 50 + c * 2;
    z := o * sin(c) + w * cos(c) + 700;

    d.x := o * cos(c) - w * sin(c);
    d.y := _B * 99 - cos(power(b, 7)) * 50 - c / 3 - z / 1.35 + 450;
    d.z := z;
    d.r := (1 - b / 1.2) * 0.9 + a * 0.1;
    d.g := power((1 - b), 20) / 4 + 0.05;
    Exit(True);
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  zBuffer: array of Smallint;
  i, j: Integer;
  x, y, z, zBufferIndex: Integer;
  dot: TDOT;
  r, g, b: Integer;
begin
  SetLength(zBuffer, urosesize * urosesize);

  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Rect(0, 0, Width, Height));

  Randomize;
  for j := 0 to 1999 do
  begin
    for i := 0 to 9999 do
    begin
      if calc(Random(RAND_MAX) / RAND_MAX, Random(RAND_MAX) / RAND_MAX, (Random(RAND_MAX) mod 46) / 0.74, dot) then
      begin
        z := Trunc(dot.z + 0.5);
        x := Trunc(dot.x * urosesize / z - uh + 0.5);
        y := Trunc(dot.y * urosesize / z - uh + 0.5);
        if y >= urosesize then
          Continue;

        zBufferIndex := y * urosesize + x;

        if (not (zBuffer[zBufferIndex] <> 0)) or (zBuffer[zBufferIndex] > z) then
        begin
          zBuffer[zBufferIndex] := z;

                    // 画点
          r := not Trunc(dot.r * uh);
          if r < 0 then
            r := 0;
          if r > 255 then
            r := 255;
          g := not Trunc(dot.g * uh);
          if g < 0 then
            g := 0;
          if g > 255 then
            g := 255;
          b := not Trunc(dot.r * dot.r *  - 80);
          if b < 0 then
            b := 0;
          if b > 255 then
            b := 255;
          Canvas.Pixels[x + 50, y - 20] := RGB(r, g, b);
        end;
      end;
      Application.ProcessMessages;
    end;
    Sleep(1);
  end;
end;

end.

http://blog.csdn.net/zyjying520/article/details/46592831