home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / picdll.zip / FERN.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-16  |  2KB  |  107 lines
  1. unit Fern;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: RUNDLL }
  5.  
  6. interface
  7.  
  8. uses
  9.   SysUtils, WinTypes, WinProcs,
  10.   Messages, Classes, Graphics,
  11.   Controls, Forms, Dialogs,
  12.   StdCtrls, ExtCtrls;
  13.  
  14. type
  15.   TDAry = array[0..3] of Double;
  16.  
  17.   TFerns = class(TForm)
  18.     Timer1: TTimer;
  19.     procedure FormResize(Sender: TObject);
  20.     procedure Timer1Timer(Sender: TObject);
  21.     procedure FormCreate(Sender: TObject);
  22.   private
  23.     MaxX, MaxY: Integer;
  24.     MaxIterations, Count: INteger;
  25.     x, y: Double;
  26.   public
  27.     { Public declarations }
  28.     procedure DoPaint;
  29.   end;
  30.  
  31. const
  32.   a: TDAry = (0, 0.85, 0.2, -0.15);
  33.   b: TDAry = (0, 0.04, -0.26, 0.28);
  34.   c: TDary = (0, -0.04, 0.23, 0.26);
  35.   d: TDAry = (0.16, 0.85, 0.22, 0.24);
  36.   e: TDAry = (0, 0, 0, 0);
  37.   f: TDAry = (0, 1.6, 1.6, 0.44);
  38.  
  39. var
  40.   Ferns: TFerns;
  41.  
  42. procedure ShowFerns(Handle: THandle); export;
  43.  
  44. implementation
  45.  
  46. {$R *.DFM}
  47.  
  48. procedure ShowFerns(Handle: THandle);
  49. begin
  50.   Application.Handle := Handle;
  51.   Ferns := TFerns.Create(Application);
  52.   try
  53.     Ferns.ShowModal;
  54.   finally
  55.     Ferns.Free;
  56.   end;
  57. end;
  58.  
  59. procedure TFerns.DoPaint;
  60. var
  61.   PaintDC: HDC;
  62.   K: Integer;
  63.   TempX, TempY: Double;
  64. begin
  65.   k := Random(100);
  66.   if ((k > 0) and (k <= 85)) then  k := 1;
  67.   if ((K > 85) and (K <= 92)) then k := 2;
  68.   if (k > 92) then K := 3;
  69.   TempX := a[k] * x + b[k] * y + e[k];
  70.   TempY := c[k] * x + d[k] * y + f[k];
  71.   x := TempX;
  72.   y := TempY;
  73.   if ((Count >= MaxIterations) or (Count <> 0)) then
  74.     Canvas.Pixels[Round(x * MaxY / 11 + MaxX / 2),
  75.                   Round(y * - MaxY / 11 + MaxY)] :=  clGreen;
  76.   Count := Count + 1;
  77. end;
  78.  
  79. procedure TFerns.FormResize(Sender: TObject);
  80. begin
  81.   MaxX := Width;
  82.   MaxY := Height;
  83.   MaxIterations := MaxY * 50;
  84. end;
  85.  
  86. procedure TFerns.Timer1Timer(Sender: TObject);
  87. var
  88.   i: Integer;
  89. begin
  90.   if Count > MaxIterations then begin
  91.     Invalidate;
  92.     Count := 0;
  93.   end;
  94.  
  95.   for i := 0 to 200 do
  96.     DoPaint;
  97. end;
  98.  
  99. procedure TFerns.FormCreate(Sender: TObject);
  100. begin
  101.   Count := 0;
  102.   x := 0;
  103.   y := 0;
  104. end;
  105.  
  106. end.
  107.