情人节红攻瑰--Delphi版本

OStack程序员社区-中国程序员成长平台 › 门户 › 编程›综合其他

原作者: [db:作者] 来自: [db:来源] 收藏邀请

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

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

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

以下为代码:

[delphi] view plain copy

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.