情人节红攻瑰--Delphi版本

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

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

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

以下为代码:

1. unit Unit1;
2. interface
3. uses
4. Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
5. Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
6. type
7. TForm1 = class(TForm)
8. btn1: TButton;
9. procedure btn1Click(Sender: TObject);
10. private
11. public
12. { Public declarations }
13. end;
14. var
15. Form1: TForm1;
16. implementation
17. {$R *.dfm}
18. uses
19. System.Math;
20. // 原作者贴子,
21. // http://www.oschina.net/code/snippet_2373787_48760
22. // delphi版本
23. // ying32
24. const
25. RAND_MAX = $7FFF;
26. urosesize: Integer = 500;
27. uh: Integer = -250;
28. type
29. // 定义结构体
30. TDOT = record
31. x: Double;
32. y: Double;
33. z: Double;
34. r: Double;  // 红色
35. g: double;  // 绿色
36. // b(蓝色) 通过 r 计算
37. end;
38. function calc(a, b, c: Double; var d: TDOT): Boolean;
39. var
40. j, n, o, w, z: Double;
41. _A, _B: Double;
42. begin
43. Result := False;
44. if c > 60 then // 花柄
45. begin
46. d.x := sin(a * 7) * (13 + 5 / (0.2 + power(b * 4, 4))) - sin(b) * 50;
47. d.y := b * urosesize + 50;
48. d.z := 625 + cos(a * 7) * (13 + 5 / (0.2 + power(b * 4, 4))) + b * 400;
49. d.r := a * 1 - b / 2;
50. d.g := a;
51. Exit(True);
52. end;
53. _A := a * 2 - 1;
54. _B := b * 2 - 1;
55. if _A * _A + _B * _B < 1 then
56. begin
57. if c > 37 then           // 叶
58. begin
59. j := Trunc(c) and 1;
60. n := IfThen(j <> 0, 6, 4);
61. o := 0.5 / (a + 0.01) + cos(b * 125) * 3 - a * 300;
62. w := b * uh;
63. d.x := o * cos(n) + w * sin(n) + j * 610 - 390;
64. d.y := o * sin(n) - w * cos(n) + 550 - j * 350;
65. d.z := 1180 + cos(_B + _A) * 99 - j * 300;
66. 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);
67. d.g := o / 1000 + 0.7 - o * w * 0.000003;
68. Exit(True);
69. end;
70. if c > 32 then           // 花萼
71. begin
72. c := c * 1.16 - 0.15;
73. o := a * 45 - 20;
74. w := b * b * uh;
75. z := o * sin(c) + w * cos(c) + 620;
76. d.x := o * cos(c) - w * sin(c);
77. d.y := 28 + cos(_B * 0.5) * 99 - b * b * b * 60 - z / 2 - uh;
78. d.z := z;
79. d.r := (b * b * 0.3 + power((1 - (_A * _A)), 7) * 0.15 + 0.3) * b;
80. d.g := b * 0.7;
81. Exit(True);
82. end;
83. // 花
84. o := _A * (2 - b) * (80 - c * 2);
85. w := 99 - cos(_A) * 120 - cos(b) * (-uh - c * 4.9) + cos(power(1 - b, 7)) * 50 + c * 2;
86. z := o * sin(c) + w * cos(c) + 700;
87. d.x := o * cos(c) - w * sin(c);
88. d.y := _B * 99 - cos(power(b, 7)) * 50 - c / 3 - z / 1.35 + 450;
89. d.z := z;
90. d.r := (1 - b / 1.2) * 0.9 + a * 0.1;
91. d.g := power((1 - b), 20) / 4 + 0.05;
92. Exit(True);
93. end;
94. end;
95. procedure TForm1.btn1Click(Sender: TObject);
96. var
97. zBuffer: array of Smallint;
98. i, j: Integer;
99. x, y, z, zBufferIndex: Integer;
100. dot: TDOT;
101. r, g, b: Integer;
102. begin
103. SetLength(zBuffer, urosesize * urosesize);
104. Canvas.Brush.Color := clWhite;
105. Canvas.FillRect(Rect(0, 0, Width, Height));
106. Randomize;
107. for j := 0 to 1999 do
108. begin
109. for i := 0 to 9999 do
110. begin
111. if calc(Random(RAND_MAX) / RAND_MAX, Random(RAND_MAX) / RAND_MAX, (Random(RAND_MAX) mod 46) / 0.74, dot) then
112. begin
113. z := Trunc(dot.z + 0.5);
114. x := Trunc(dot.x * urosesize / z - uh + 0.5);
115. y := Trunc(dot.y * urosesize / z - uh + 0.5);
116. if y >= urosesize then
117. Continue;
118. zBufferIndex := y * urosesize + x;
119. if (not (zBuffer[zBufferIndex] <> 0)) or (zBuffer[zBufferIndex] > z) then
120. begin
121. zBuffer[zBufferIndex] := z;
122. // 画点
123. r := not Trunc(dot.r * uh);
124. if r < 0 then
125. r := 0;
126. if r > 255 then
127. r := 255;
128. g := not Trunc(dot.g * uh);
129. if g < 0 then
130. g := 0;
131. if g > 255 then
132. g := 255;
133. b := not Trunc(dot.r * dot.r *  - 80);
134. if b < 0 then
135. b := 0;
136. if b > 255 then
137. b := 255;
138. Canvas.Pixels[x + 50, y - 20] := RGB(r, g, b);
139. end;
140. end;
141. Application.ProcessMessages;
142. end;
143. Sleep(1);
144. end;
145. end;
146. end.

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