1 unit distortions_main;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9 ComCtrls, StdCtrls, BGRABitmap, BGRABitmapTypes, BGRAGradientScanner,
10 LMessages, EpikTimer;
11
12 type
13
14 { TWaveDistortion }
15
16 TWaveDistortion = class(TBGRACustomScanner)
17 private
18 FSource : IBGRAScanner;
19 FCenter : TPointF;
20 FRadius, FAmplitude: Single;
21 public
22 Delta: single;
23 constructor Create(source : IBGRAScanner; center : TPointF; radius, amplitude: single);
ScanAtnull24 function ScanAt(X, Y: Single): TBGRAPixel; override;
25 end;
26
27 { TForm1 }
28
29 TForm1 = class(TForm)
30 Label1: TLabel;
31 Label2: TLabel;
32 Panel1: TPanel;
33 Timer1: TTimer;
34 TrackBar_Angle: TTrackBar;
35 TrackBar_Scale: TTrackBar;
36 procedure FormCreate(Sender: TObject);
37 procedure FormDestroy(Sender: TObject);
38 procedure FormPaint(Sender: TObject);
39 procedure Timer1Timer(Sender: TObject);
40 procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
41 private
42 { private declarations }
43 public
44 { public declarations }
45 image: TBGRABitmap;
46 grad: TBGRAGradientScanner;
47 multigrad: TBGRAMultiGradient;
48 delta: single;
49 timer: TEpikTimer;
50 end;
51
52 var
53 Form1: TForm1;
54
55 implementation
56
57 uses BGRATransform;
58
59 { TWaveDistortion }
60
61 constructor TWaveDistortion.Create(source: IBGRAScanner; center : TPointF; radius, amplitude: single);
62 begin
63 FSource := Source;
64 FCenter := center;
65 FRadius := radius;
66 FAmplitude := amplitude;
67 Delta := 0;
68 end;
69
TWaveDistortion.ScanAtnull70 function TWaveDistortion.ScanAt(X, Y: Single): TBGRAPixel;
71 var d: single;
72 p,v: TPointF;
73 begin
74 p := PointF(X,Y);
75 v := p-FCenter;
76 d := sqrt(v*v);
77 if d <> 0 then v.Scale(1/d);
78 p.Offset( v*(sin(d*2*Pi/FRadius+Delta)*FAmplitude) );
79 result := FSource.ScanAt(p.X,p.Y);
80 end;
81
82 {$R *.lfm}
83
84 { TForm1 }
85
86 procedure TForm1.FormPaint(Sender: TObject);
87 const ampl = 10;
88 var bmp: TBGRABitmap;
89 tx,ty: integer;
90 x,y,rx,ry,scale :single;
91
92 procedure DrawEllipse(source: IBGRAScanner);
93 var
94 disto: TWaveDistortion;
95 affine: TBGRAAffineScannerTransform;
96 begin
97 affine := TBGRAAffineScannerTransform.Create(source);
98 affine.RotateDeg(TrackBar_Angle.Position);
99 affine.Scale(scale,scale);
100 affine.Translate(x,y);
101 disto := TWaveDistortion.Create(affine,PointF(x,y),(rx+ry)/2*0.6,ampl);
102 disto.Delta := Delta;
103 bmp.FillEllipseAntialias(x,y,rx,ry,disto);
104 disto.Free;
105 affine.free;
106 end;
107
108 begin
109 timer.Clear;
110 timer.start;
111 tx := ClientWidth;
112 ty := Panel1.Top;
113 scale := TrackBar_Scale.Position/10;
114 bmp := TBGRABitmap.Create(tx,ty, BGRAWhite);
115 x := tx/4;
116 y := ty/2;
117 rx := tx/4*0.8;
118 ry := ty/2*0.8;
119 image.ScanOffset := Point(round(image.width/2),round(image.Height/2));
120 DrawEllipse(image);
121
122 x := 3*tx/4;
123 y := ty/2;
124 bmp.FillEllipseAntialias(x,y,rx,ry,BGRABlack);
125 grad := TBGRAGradientScanner.Create(multigrad,gtRadial,PointF(0.4*rx/scale,-0.4*ry/scale),PointF(0.4*rx/scale+rx,-0.4*ry/scale),False);
126 DrawEllipse(grad);
127 grad.free;
128
129 timer.Stop;
130 bmp.TextOut(0,0,inttostr(round(timer.Elapsed*1000))+ ' ms',BGRABlack);
131 bmp.Draw(Canvas,0,0);
132 bmp.Free;
133 end;
134
135 procedure TForm1.Timer1Timer(Sender: TObject);
136 begin
137 Timer1.Enabled := false;
138 Delta -= 10*Pi/180;
139 Repaint;
140 Timer1.Enabled := true;
141 end;
142
143 procedure TForm1.WMEraseBkgnd(var Message: TLMEraseBkgnd);
144 begin
145 //
146 end;
147
148 procedure TForm1.FormCreate(Sender: TObject);
149 begin
150 image := TBGRABitmap.Create('spheres.png');
151 timer := TEpikTimer.Create(self);
152 multigrad := TBGRAMultiGradient.Create([BGRAWhite,BGRA(255,235,96),BGRA(255,160,0),BGRA(140,0,0),BGRA(64,0,0),BGRA(160,64,0)],[0,0.2,0.4,0.8,0.9,1],True);
153 end;
154
155 procedure TForm1.FormDestroy(Sender: TObject);
156 begin
157 image.free;
158 multigrad.Free;
159 end;
160
161 end.
162
163