1 unit Unit1;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9   StdCtrls, BCButton, BGRAVirtualScreen, BGRALayers, BGRAStreamLayers,
10   BGRABitmap, BGRABitmapTypes, BGRALayerOriginal;
11 
12 type
13 
14   { TForm1 }
15 
16   TForm1 = class(TForm)
17     BCFlipX: TBCButton;
18     BCRotUD: TBCButton;
19     BCSave: TBCButton;
20     BCFlipY: TBCButton;
21     BCRotCW: TBCButton;
22     BCRotCCW: TBCButton;
23     BCColor1: TBCButton;
24     BCColor2: TBCButton;
25     BGRAVirtualScreen1: TBGRAVirtualScreen;
26     ColorDialog1: TColorDialog;
27     cbInterp: TComboBox;
28     cbRepeat: TComboBox;
29     cbGradientType: TComboBox;
30     SaveDialog1: TSaveDialog;
31     procedure BCRotUDClick(Sender: TObject);
32     procedure BCSaveClick(Sender: TObject);
33     procedure BCFlipXClick(Sender: TObject);
34     procedure BCFlipYClick(Sender: TObject);
35     procedure BCRotCWClick(Sender: TObject);
36     procedure BCRotCCWClick(Sender: TObject);
37     procedure BCColor1Click(Sender: TObject);
38     procedure BCColor2Click(Sender: TObject);
39     procedure BGRAVirtualScreen1MouseDown(Sender: TObject;
40       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
41     procedure BGRAVirtualScreen1MouseMove(Sender: TObject; {%H-}Shift: TShiftState;
42       {%H-}X, {%H-}Y: Integer);
43     procedure BGRAVirtualScreen1MouseUp(Sender: TObject; Button: TMouseButton;
44       Shift: TShiftState; X, Y: Integer);
45     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
46     procedure cbGradientTypeChange(Sender: TObject);
47     procedure cbInterpChange(Sender: TObject);
48     procedure cbRepeatChange(Sender: TObject);
49     procedure FormCreate(Sender: TObject);
50     procedure FormDestroy(Sender: TObject);
51   private
52     procedure OriginalChange(Sender: TObject; {%H-}AOriginal: TBGRALayerCustomOriginal;
53                 var {%H-}ADiff: TBGRAOriginalDiff);
54     procedure SetVSCursor(ACursor: TOriginalEditorCursor);
55   public
56     FLayers: TBGRALayeredBitmap;
57   end;
58 
59 var
60   Form1: TForm1;
61 
62 implementation
63 
64 uses BGRATransform, BGRASVGOriginal, BGRAGradientOriginal, BGRALazPaint;
65 
66 {$R *.lfm}
67 
68 { TForm1 }
69 
70 procedure TForm1.BCFlipXClick(Sender: TObject);
71 begin
72   FLayers.HorizontalFlip;
73   BGRAVirtualScreen1.DiscardBitmap;
74 end;
75 
76 procedure TForm1.BCSaveClick(Sender: TObject);
77 begin
78   if SaveDialog1.Execute then
79   begin
80     RegisterLazPaintFormat;
81     try
82       FLayers.SaveToFile(SaveDialog1.FileName);
83     except
84       on ex:exception do
85         ShowMessage(ex.Message);
86     end;
87   end;
88 end;
89 
90 procedure TForm1.BCRotUDClick(Sender: TObject);
91 begin
92   FLayers.RotateUD;
93   BGRAVirtualScreen1.DiscardBitmap;
94 end;
95 
96 procedure TForm1.BCFlipYClick(Sender: TObject);
97 begin
98   FLayers.VerticalFlip;
99   BGRAVirtualScreen1.DiscardBitmap;
100 end;
101 
102 procedure TForm1.BCRotCWClick(Sender: TObject);
103 begin
104   FLayers.RotateCW;
105   BGRAVirtualScreen1.DiscardBitmap;
106 end;
107 
108 procedure TForm1.BCRotCCWClick(Sender: TObject);
109 begin
110   FLayers.RotateCCW;
111   BGRAVirtualScreen1.DiscardBitmap;
112 end;
113 
114 procedure TForm1.BCColor1Click(Sender: TObject);
115 var
116   orig: TBGRALayerGradientOriginal;
117 begin
118   orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
119   ColorDialog1.Color:= orig.StartColor;
120   if ColorDialog1.Execute then orig.StartColor := ColorToBGRA(ColorDialog1.Color);
121 end;
122 
123 procedure TForm1.BCColor2Click(Sender: TObject);
124 var
125   orig: TBGRALayerGradientOriginal;
126 begin
127   orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
128   ColorDialog1.Color:= orig.EndColor;
129   if ColorDialog1.Execute then orig.EndColor := ColorToBGRA(ColorDialog1.Color);
130 end;
131 
132 procedure TForm1.BGRAVirtualScreen1MouseDown(Sender: TObject;
133   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
134 var
135   newCursor: TOriginalEditorCursor;
136 begin
137   FLayers.MouseDown(Button=mbRight,Shift,X,Y,newCursor);
138   SetVSCursor(newCursor);
139 end;
140 
141 procedure TForm1.BGRAVirtualScreen1MouseMove(Sender: TObject;
142   Shift: TShiftState; X, Y: Integer);
143 var
144   newCursor: TOriginalEditorCursor;
145 begin
146   FLayers.MouseMove(Shift,X,Y,newCursor);
147   SetVSCursor(newCursor);
148 end;
149 
150 procedure TForm1.BGRAVirtualScreen1MouseUp(Sender: TObject;
151   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
152 var
153   newCursor: TOriginalEditorCursor;
154 begin
155   FLayers.MouseUp(Button=mbRight,Shift,X,Y,newCursor);
156   SetVSCursor(newCursor);
157 end;
158 
159 procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
160 begin
161   FLayers.Draw(Bitmap, 0,0);
162   FLayers.DrawEditor(Bitmap, 0, 0,0, 8);
163 end;
164 
165 procedure TForm1.cbGradientTypeChange(Sender: TObject);
166 var
167   orig: TBGRALayerGradientOriginal;
168 begin
169   orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
170   orig.GradientType := TGradientType(cbGradientType.ItemIndex);
171 end;
172 
173 procedure TForm1.cbInterpChange(Sender: TObject);
174 var
175   orig: TBGRALayerGradientOriginal;
176 begin
177   orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
178   orig.ColorInterpolation := TBGRAColorInterpolation(cbInterp.ItemIndex);
179 end;
180 
181 procedure TForm1.cbRepeatChange(Sender: TObject);
182 var
183   orig: TBGRALayerGradientOriginal;
184 begin
185   orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
186   orig.Repetition := TBGRAGradientRepetition(cbRepeat.ItemIndex);
187 end;
188 
189 procedure TForm1.FormCreate(Sender: TObject);
190 var
191   grad: TBGRALayerGradientOriginal;
192   svg: TBGRALayerSVGOriginal;
193   img: TBGRALayerImageOriginal;
194   gradStream: TMemoryStream;
195   idxBike, idxImg: Integer;
196 begin
197   FLayers := TBGRALayeredBitmap.Create(640,480);
198   flayers.OnOriginalChange := @OriginalChange;
199 
200   cbGradientType.ItemIndex:= 0;
201   cbInterp.ItemIndex := 0;
202   cbRepeat.ItemIndex := 0;
203 
204   gradStream := TMemoryStream.Create;
205   grad := TBGRALayerGradientOriginal.Create;
206   grad.StartColor := CSSSkyBlue;
207   grad.EndColor := CSSOrange;
208   grad.GradientType:= gtLinear;
209   grad.Origin := PointF(FLayers.Width/2,100);
210   grad.XAxis := grad.origin+PointF(0,250);
211   grad.SaveToStream(gradStream);    //save original definition
212   grad.Free;
213 
214   grad := TBGRALayerGradientOriginal.Create;
215   gradStream.Position:= 0;
216   grad.LoadFromStream(gradStream); // load original definition
217   FLayers.AddLayerFromOwnedOriginal(grad);
218   gradStream.free;
219 
220   svg := TBGRALayerSVGOriginal.Create;
221   svg.LoadFromFile(Application.Location + 'bicycling.svg');
222   idxBike := FLayers.AddLayerFromOwnedOriginal(svg);
223   FLayers.LayerOpacity[idxBike] := 192;
224   FLayers.LayerOriginalMatrix[idxBike] := AffineMatrixTranslation((FLayers.Width-svg.Width*0.5)/2,(FLayers.Height-svg.Height*0.5)/2)*
225                                           AffineMatrixScale(0.5,0.5)*
226                                           AffineMatrixTranslation(svg.Width/2,svg.Height/2)*
227                                           AffineMatrixRotationDeg(30)*
228                                           AffineMatrixTranslation(-svg.Width/2,-svg.Height/2);
229   FLayers.RenderLayerFromOriginal(idxBike);
230 
231   img := TBGRALayerImageOriginal.Create;
232   img.LoadFromFile(Application.Location + 'lazarus.jpg');
233   idxImg := FLayers.AddLayerFromOwnedOriginal(img);
234   FLayers.LayerOriginalMatrix[idxImg] := AffineMatrixTranslation(0, FLayers.Height - img.Height);
235 end;
236 
237 procedure TForm1.FormDestroy(Sender: TObject);
238 begin
239   FLayers.Free;
240 end;
241 
242 procedure TForm1.OriginalChange(Sender: TObject;
243   AOriginal: TBGRALayerCustomOriginal;
244   var ADiff: TBGRAOriginalDiff);
245 begin
246   BGRAVirtualScreen1.DiscardBitmap;
247 end;
248 
249 procedure TForm1.SetVSCursor(ACursor: TOriginalEditorCursor);
250 begin
251   case ACursor of
252   oecDefault: BGRAVirtualScreen1.Cursor := crDefault;
253   oecMove: BGRAVirtualScreen1.Cursor := crSize;
254   oecMoveE: BGRAVirtualScreen1.Cursor := crSizeE;
255   oecMoveW: BGRAVirtualScreen1.Cursor := crSizeW;
256   oecMoveN: BGRAVirtualScreen1.Cursor := crSizeN;
257   oecMoveS: BGRAVirtualScreen1.Cursor := crSizeS;
258   oecMoveNE: BGRAVirtualScreen1.Cursor := crSizeNE;
259   oecMoveNW: BGRAVirtualScreen1.Cursor := crSizeNW;
260   oecMoveSW: BGRAVirtualScreen1.Cursor := crSizeSW;
261   oecMoveSE: BGRAVirtualScreen1.Cursor := crSizeSE;
262   end;
263 end;
264 
265 end.
266 
267