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