lasarus_compotents/bgrabitmap/test/layeroriginal/unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, BCButton, BGRAVirtualScreen, BGRALayers, BGRAStreamLayers,
  BGRABitmap, BGRABitmapTypes, BGRALayerOriginal;

type

  { TForm1 }

  TForm1 = class(TForm)
    BCFlipX: TBCButton;
    BCRotUD: TBCButton;
    BCSave: TBCButton;
    BCFlipY: TBCButton;
    BCRotCW: TBCButton;
    BCRotCCW: TBCButton;
    BCColor1: TBCButton;
    BCColor2: TBCButton;
    BGRAVirtualScreen1: TBGRAVirtualScreen;
    ColorDialog1: TColorDialog;
    cbInterp: TComboBox;
    cbRepeat: TComboBox;
    cbGradientType: TComboBox;
    SaveDialog1: TSaveDialog;
    procedure BCRotUDClick(Sender: TObject);
    procedure BCSaveClick(Sender: TObject);
    procedure BCFlipXClick(Sender: TObject);
    procedure BCFlipYClick(Sender: TObject);
    procedure BCRotCWClick(Sender: TObject);
    procedure BCRotCCWClick(Sender: TObject);
    procedure BCColor1Click(Sender: TObject);
    procedure BCColor2Click(Sender: TObject);
    procedure BGRAVirtualScreen1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure BGRAVirtualScreen1MouseMove(Sender: TObject; {%H-}Shift: TShiftState;
      {%H-}X, {%H-}Y: Integer);
    procedure BGRAVirtualScreen1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
    procedure cbGradientTypeChange(Sender: TObject);
    procedure cbInterpChange(Sender: TObject);
    procedure cbRepeatChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure OriginalChange(Sender: TObject; {%H-}AOriginal: TBGRALayerCustomOriginal;
                var {%H-}ADiff: TBGRAOriginalDiff);
    procedure SetVSCursor(ACursor: TOriginalEditorCursor);
  public
    FLayers: TBGRALayeredBitmap;
  end;

var
  Form1: TForm1;

implementation

uses BGRATransform, BGRASVGOriginal, BGRAGradientOriginal, BGRALazPaint;

{$R *.lfm}

{ TForm1 }

procedure TForm1.BCFlipXClick(Sender: TObject);
begin
  FLayers.HorizontalFlip;
  BGRAVirtualScreen1.DiscardBitmap;
end;

procedure TForm1.BCSaveClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    RegisterLazPaintFormat;
    try
      FLayers.SaveToFile(SaveDialog1.FileName);
    except
      on ex:exception do
        ShowMessage(ex.Message);
    end;
  end;
end;

procedure TForm1.BCRotUDClick(Sender: TObject);
begin
  FLayers.RotateUD;
  BGRAVirtualScreen1.DiscardBitmap;
end;

procedure TForm1.BCFlipYClick(Sender: TObject);
begin
  FLayers.VerticalFlip;
  BGRAVirtualScreen1.DiscardBitmap;
end;

procedure TForm1.BCRotCWClick(Sender: TObject);
begin
  FLayers.RotateCW;
  BGRAVirtualScreen1.DiscardBitmap;
end;

procedure TForm1.BCRotCCWClick(Sender: TObject);
begin
  FLayers.RotateCCW;
  BGRAVirtualScreen1.DiscardBitmap;
end;

procedure TForm1.BCColor1Click(Sender: TObject);
var
  orig: TBGRALayerGradientOriginal;
begin
  orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
  ColorDialog1.Color:= orig.StartColor;
  if ColorDialog1.Execute then orig.StartColor := ColorToBGRA(ColorDialog1.Color);
end;

procedure TForm1.BCColor2Click(Sender: TObject);
var
  orig: TBGRALayerGradientOriginal;
begin
  orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
  ColorDialog1.Color:= orig.EndColor;
  if ColorDialog1.Execute then orig.EndColor := ColorToBGRA(ColorDialog1.Color);
end;

procedure TForm1.BGRAVirtualScreen1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  newCursor: TOriginalEditorCursor;
begin
  FLayers.MouseDown(Button=mbRight,Shift,X,Y,newCursor);
  SetVSCursor(newCursor);
end;

procedure TForm1.BGRAVirtualScreen1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  newCursor: TOriginalEditorCursor;
begin
  FLayers.MouseMove(Shift,X,Y,newCursor);
  SetVSCursor(newCursor);
end;

procedure TForm1.BGRAVirtualScreen1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  newCursor: TOriginalEditorCursor;
begin
  FLayers.MouseUp(Button=mbRight,Shift,X,Y,newCursor);
  SetVSCursor(newCursor);
end;

procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
begin
  FLayers.Draw(Bitmap, 0,0);
  FLayers.DrawEditor(Bitmap, 0, 0,0, 8);
end;

procedure TForm1.cbGradientTypeChange(Sender: TObject);
var
  orig: TBGRALayerGradientOriginal;
begin
  orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
  orig.GradientType := TGradientType(cbGradientType.ItemIndex);
end;

procedure TForm1.cbInterpChange(Sender: TObject);
var
  orig: TBGRALayerGradientOriginal;
begin
  orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
  orig.ColorInterpolation := TBGRAColorInterpolation(cbInterp.ItemIndex);
end;

procedure TForm1.cbRepeatChange(Sender: TObject);
var
  orig: TBGRALayerGradientOriginal;
begin
  orig := FLayers.Original[0] as TBGRALayerGradientOriginal;
  orig.Repetition := TBGRAGradientRepetition(cbRepeat.ItemIndex);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  grad: TBGRALayerGradientOriginal;
  svg: TBGRALayerSVGOriginal;
  img: TBGRALayerImageOriginal;
  gradStream: TMemoryStream;
  idxBike, idxImg: Integer;
begin
  FLayers := TBGRALayeredBitmap.Create(640,480);
  flayers.OnOriginalChange := @OriginalChange;

  cbGradientType.ItemIndex:= 0;
  cbInterp.ItemIndex := 0;
  cbRepeat.ItemIndex := 0;

  gradStream := TMemoryStream.Create;
  grad := TBGRALayerGradientOriginal.Create;
  grad.SetColors([CSSWhite, CSSSkyBlue, CSSOrange, CSSRed],
                 [0, 0.2, 0.8, 1]);
  grad.GradientType:= gtLinear;
  grad.Origin := PointF(FLayers.Width/2,40);
  grad.XAxis := grad.origin+PointF(0,400);
  grad.SaveToStream(gradStream);    //save original definition
  grad.Free;

  grad := TBGRALayerGradientOriginal.Create;
  gradStream.Position:= 0;
  grad.LoadFromStream(gradStream); // load original definition
  FLayers.AddLayerFromOwnedOriginal(grad);
  gradStream.free;

  svg := TBGRALayerSVGOriginal.Create;
  svg.LoadFromFile(Application.Location + 'bicycling.svg');
  idxBike := FLayers.AddLayerFromOwnedOriginal(svg);
  FLayers.LayerOpacity[idxBike] := 192;
  FLayers.LayerOriginalMatrix[idxBike] := AffineMatrixTranslation((FLayers.Width-svg.Width*0.5)/2,(FLayers.Height-svg.Height*0.5)/2)*
                                          AffineMatrixScale(0.5,0.5)*
                                          AffineMatrixTranslation(svg.Width/2,svg.Height/2)*
                                          AffineMatrixRotationDeg(30)*
                                          AffineMatrixTranslation(-svg.Width/2,-svg.Height/2);
  FLayers.RenderLayerFromOriginal(idxBike);

  img := TBGRALayerImageOriginal.Create;
  img.LoadFromFile(Application.Location + 'lazarus.jpg');
  idxImg := FLayers.AddLayerFromOwnedOriginal(img);
  FLayers.LayerOriginalMatrix[idxImg] := AffineMatrixTranslation(0, FLayers.Height - img.Height);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FLayers.Free;
end;

procedure TForm1.OriginalChange(Sender: TObject;
  AOriginal: TBGRALayerCustomOriginal;
  var ADiff: TBGRAOriginalDiff);
begin
  BGRAVirtualScreen1.DiscardBitmap;
end;

procedure TForm1.SetVSCursor(ACursor: TOriginalEditorCursor);
begin
  case ACursor of
  oecDefault: BGRAVirtualScreen1.Cursor := crDefault;
  oecMove: BGRAVirtualScreen1.Cursor := crSize;
  oecMoveE: BGRAVirtualScreen1.Cursor := crSizeE;
  oecMoveW: BGRAVirtualScreen1.Cursor := crSizeW;
  oecMoveN: BGRAVirtualScreen1.Cursor := crSizeN;
  oecMoveS: BGRAVirtualScreen1.Cursor := crSizeS;
  oecMoveNE: BGRAVirtualScreen1.Cursor := crSizeNE;
  oecMoveNW: BGRAVirtualScreen1.Cursor := crSizeNW;
  oecMoveSW: BGRAVirtualScreen1.Cursor := crSizeSW;
  oecMoveSE: BGRAVirtualScreen1.Cursor := crSizeSE;
  end;
end;

end.