bgrabitmap.lazpaint/lazpaintcontrols/lcvectorialfillcontrol.pas

// SPDX-License-Identifier: GPL-3.0-only
unit LCVectorialFillControl;

{$mode objfpc}{$H+}

interface

uses
  Types, Classes, SysUtils, Controls, LCVectorialFillInterface,
  LCVectorialFill, BGRABitmap, BGRABitmapTypes, BGRAGradientScanner,
  LCVectorOriginal;

type
  TLCFillTarget = LCVectorialFillInterface.TLCFillTarget;

const
  ftPen = LCVectorialFillInterface.ftPen;
  ftBack = LCVectorialFillInterface.ftBack;
  ftOutline = LCVectorialFillInterface.ftOutline;

type
  { TLCVectorialFillControl }

  TLCVectorialFillControl = class(TWinControl)
  private
    function GetAllowedFillTypes: TVectorialFillTypes;
    function GetAllowKeyInput: boolean;
    function GetAverageColor: TBGRAPixel;
    function GetCanAdjustToShape: boolean;
    function GetCanEditGradTexPoints: boolean;
    function GetEditingGradTexPoints: boolean;
    function GetFillType: TVectorialFillType;
    function GetGradEndColor: TBGRAPixel;
    function GetGradInterp: TBGRAColorInterpolation;
    function GetGradRepetition: TBGRAGradientRepetition;
    function GetGradStartColor: TBGRAPixel;
    function GetGradType: TGradientType;
    function GetIsTarget: boolean;
    function GetPreferredSizeAsSize: TSize;
    function GetSolidColor: TBGRAPixel;
    function GetTexOpacity: byte;
    function GetTexRepetition: TTextureRepetition;
    function GetTexture: TBGRABitmap;
    function GetToolIconSize: integer;
    function GetVerticalPadding: integer;
    procedure InterfaceMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure InterfaceMouseEnter(Sender: TObject);
    procedure InterfaceMouseLeave(Sender: TObject);
    procedure InterfaceMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure InterfaceMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SetAllowedFillTypes(AValue: TVectorialFillTypes);
    procedure SetAllowKeyInput(AValue: boolean);
    procedure SetCanAdjustToShape(AValue: boolean);
    procedure SetCanEditGradTexPoints(AValue: boolean);
    procedure SetEditingGradTexPoints(AValue: boolean);
    procedure SetFillType(AValue: TVectorialFillType);
    procedure SetGradEndColor(AValue: TBGRAPixel);
    procedure SetGradientType(AValue: TGradientType);
    procedure SetGradInterpolation(AValue: TBGRAColorInterpolation);
    procedure SetGradRepetition(AValue: TBGRAGradientRepetition);
    procedure SetGradStartColor(AValue: TBGRAPixel);
    procedure SetIsTarget(AValue: boolean);
    procedure SetOnChooseColor(AValue: TChooseColorEvent);
    procedure SetOnTextureClick(AValue: TNotifyEvent);
    procedure SetSolidColor(AValue: TBGRAPixel);
    procedure SetTexture(AValue: TBGRABitmap);
    procedure SetTextureOpacity(AValue: byte);
    procedure SetTextureRepetition(AValue: TTextureRepetition);
    procedure SetToolIconSize(AValue: integer);
    procedure SetVerticalPadding(AValue: integer);
  protected
    FInterface: TVectorialFillInterface;
    FOnAdjustToShape: TNotifyEvent;
    FOnEditGradTexPoints: TNotifyEvent;
    FOnChooseColor: TChooseColorEvent;
    FOnFillChange: TNotifyEvent;
    FOnOpacityChange: TNotifyEvent;
    FOnFillTypeChange: TNotifyEvent;
    FOnTextureClick: TNotifyEvent;
    FOnTextureChange: TNotifyEvent;
    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
      {%H-}WithThemeSpace: Boolean); override;
    procedure DoOnAdjustToShape(Sender: TObject);
    procedure DoOnEditGradTexPoints(Sender: TObject);
    procedure DoOnFillChange(Sender: TObject);
    procedure DoOnFillTypeChange(Sender: TObject);
    procedure DoOnOpacityChange(Sender: TObject);
    procedure DoOnTextureClick(Sender: TObject);
    procedure DoOnTextureChange(Sender: TObject);
    procedure DoOnResize; override;
    procedure DoOnChooseColor({%H-}ASender: TObject; AButton: TMouseButton;
      AColorIndex: integer; var AColorValue: TBGRAPixel; out AHandled: boolean);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure AssignFill(AFill: TVectorialFill);
    function CreateShapeFill(AShape: TVectorShape): TVectorialFill;
    procedure UpdateShapeFill(AShape: TVectorShape; ATarget: TLCFillTarget);
    procedure UpdateFillExceptGeometry(ATargetFill: TVectorialFill);
    property FillType: TVectorialFillType read GetFillType write SetFillType;
    property IsTarget: boolean read GetIsTarget write SetIsTarget;
    property AverageColor: TBGRAPixel read GetAverageColor;
    property SolidColor: TBGRAPixel read GetSolidColor write SetSolidColor;
    property GradientType: TGradientType read GetGradType write SetGradientType;
    property GradStartColor: TBGRAPixel read GetGradStartColor write SetGradStartColor;
    property GradEndColor: TBGRAPixel read GetGradEndColor write SetGradEndColor;
    property GradRepetition: TBGRAGradientRepetition read GetGradRepetition write SetGradRepetition;
    property GradInterpolation: TBGRAColorInterpolation read GetGradInterp write SetGradInterpolation;
    property Texture: TBGRABitmap read GetTexture write SetTexture;
    property TextureRepetition: TTextureRepetition read GetTexRepetition write SetTextureRepetition;
    property TextureOpacity: byte read GetTexOpacity write SetTextureOpacity;
    property CanAdjustToShape: boolean read GetCanAdjustToShape write SetCanAdjustToShape;
    property PreferredSize: TSize read GetPreferredSizeAsSize;
    property AllowKeyInput: boolean read GetAllowKeyInput write SetAllowKeyInput;
  published
    property AutoSize;
    property Align;
    property Enabled;
    property Visible;
    property ToolIconSize: integer read GetToolIconSize write SetToolIconSize;
    property VerticalPadding: integer read GetVerticalPadding write SetVerticalPadding;
    property AllowedFillTypes: TVectorialFillTypes read GetAllowedFillTypes write SetAllowedFillTypes;
    property CanEditGradTexPoints: boolean read GetCanEditGradTexPoints write SetCanEditGradTexPoints;
    property EditingGradTexPoints: boolean read GetEditingGradTexPoints write SetEditingGradTexPoints;
    property OnChooseColor: TChooseColorEvent read FOnChooseColor write SetOnChooseColor;
    property OnFillChange: TNotifyEvent read FOnFillChange write FOnFillChange;
    property OnOpacityChange: TNotifyEvent read FOnOpacityChange write FOnOpacityChange;
    property OnTextureChange: TNotifyEvent read FOnTextureChange write FOnTextureChange;
    property OnAdjustToShape: TNotifyEvent read FOnAdjustToShape write FOnAdjustToShape;
    property OnEditGradTexPoints: TNotifyEvent read FOnEditGradTexPoints write FOnEditGradTexPoints;
    property OnFillTypeChange: TNotifyEvent read FOnFillTypeChange write FOnFillTypeChange;
    property OnTextureClick: TNotifyEvent read FOnTextureClick write SetOnTextureClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Lazpaint Controls', [TLCVectorialFillControl]);
end;

{ TLCVectorialFillControl }

procedure TLCVectorialFillControl.DoOnChooseColor(ASender: TObject; AButton: TMouseButton;
  AColorIndex: integer; var AColorValue: TBGRAPixel; out AHandled: boolean);
begin
  If Assigned(FOnChooseColor) then
    FOnChooseColor(self, AButton, AColorIndex, AColorValue, AHandled)
  else
    AHandled := false;
end;

procedure TLCVectorialFillControl.DoOnTextureClick(Sender: TObject);
begin
  if Assigned(FOnTextureClick) then FOnTextureClick(self);
end;

function TLCVectorialFillControl.GetAllowedFillTypes: TVectorialFillTypes;
begin
  result := FInterface.AllowedFillTypes;
end;

function TLCVectorialFillControl.GetAllowKeyInput: boolean;
begin
  result := FInterface.AllowKeyInput;
end;

function TLCVectorialFillControl.GetAverageColor: TBGRAPixel;
begin
  result := FInterface.AverageColor;
end;

function TLCVectorialFillControl.GetCanAdjustToShape: boolean;
begin
  result := FInterface.CanAdjustToShape;
end;

function TLCVectorialFillControl.GetCanEditGradTexPoints: boolean;
begin
  result := FInterface.CanEditGradTexPoints;
end;

function TLCVectorialFillControl.GetEditingGradTexPoints: boolean;
begin
  result := FInterface.EditingGradTexPoints;
end;

function TLCVectorialFillControl.GetFillType: TVectorialFillType;
begin
  result := FInterface.FillType;
end;

function TLCVectorialFillControl.GetGradEndColor: TBGRAPixel;
begin
  result := FInterface.GradEndColor;
end;

function TLCVectorialFillControl.GetGradInterp: TBGRAColorInterpolation;
begin
  result := FInterface.GradInterpolation;
end;

function TLCVectorialFillControl.GetGradRepetition: TBGRAGradientRepetition;
begin
  result := FInterface.GradRepetition;
end;

function TLCVectorialFillControl.GetGradStartColor: TBGRAPixel;
begin
  result := FInterface.GradStartColor;
end;

function TLCVectorialFillControl.GetGradType: TGradientType;
begin
  result := FInterface.GradientType;
end;

function TLCVectorialFillControl.GetIsTarget: boolean;
begin
  result := FInterface.IsTarget;
end;

function TLCVectorialFillControl.GetPreferredSizeAsSize: TSize;
begin
  result.cx:= Width;
  result.cy:= Height;
  GetPreferredSize(result.cx, result.cy);
end;

function TLCVectorialFillControl.GetSolidColor: TBGRAPixel;
begin
  result := FInterface.SolidColor;
end;

function TLCVectorialFillControl.GetTexOpacity: byte;
begin
  result := FInterface.TextureOpacity;
end;

function TLCVectorialFillControl.GetTexRepetition: TTextureRepetition;
begin
  result := FInterface.TextureRepetition;
end;

function TLCVectorialFillControl.GetTexture: TBGRABitmap;
begin
  result := FInterface.Texture;
end;

function TLCVectorialFillControl.GetToolIconSize: integer;
begin
  result := FInterface.ImageListSize.cy;
end;

function TLCVectorialFillControl.GetVerticalPadding: integer;
begin
  result := FInterface.VerticalPadding;
end;

procedure TLCVectorialFillControl.InterfaceMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(OnMouseDown) then OnMouseDown(self, Button, Shift, X,Y);
end;

procedure TLCVectorialFillControl.InterfaceMouseEnter(Sender: TObject);
begin
  if Assigned(OnMouseEnter) then OnMouseEnter(self);
end;

procedure TLCVectorialFillControl.InterfaceMouseLeave(Sender: TObject);
begin
  if Assigned(OnMouseLeave) then OnMouseLeave(self);
end;

procedure TLCVectorialFillControl.InterfaceMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(OnMouseMove) then OnMouseMove(self, Shift, X,Y);
end;

procedure TLCVectorialFillControl.InterfaceMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(OnMouseUp) then OnMouseUp(self, Button, Shift, X,Y);
end;

procedure TLCVectorialFillControl.SetAllowedFillTypes(
  AValue: TVectorialFillTypes);
begin
  FInterface.AllowedFillTypes:= AValue;
end;

procedure TLCVectorialFillControl.SetAllowKeyInput(AValue: boolean);
begin
  FInterface.AllowKeyInput := AValue;
end;

procedure TLCVectorialFillControl.SetCanAdjustToShape(AValue: boolean);
begin
  FInterface.CanAdjustToShape := AValue;
end;

procedure TLCVectorialFillControl.SetCanEditGradTexPoints(AValue: boolean);
begin
  FInterface.CanEditGradTexPoints:= AValue;
end;

procedure TLCVectorialFillControl.SetEditingGradTexPoints(AValue: boolean);
begin
  FInterface.EditingGradTexPoints := AValue;
end;

procedure TLCVectorialFillControl.SetFillType(AValue: TVectorialFillType);
begin
  FInterface.FillType := AValue;
end;

procedure TLCVectorialFillControl.SetGradEndColor(AValue: TBGRAPixel);
begin
  FInterface.GradEndColor := AValue;
end;

procedure TLCVectorialFillControl.SetGradientType(AValue: TGradientType);
begin
  FInterface.GradientType := AValue;
end;

procedure TLCVectorialFillControl.SetGradInterpolation(
  AValue: TBGRAColorInterpolation);
begin
  FInterface.GradInterpolation := AValue;
end;

procedure TLCVectorialFillControl.SetGradRepetition(
  AValue: TBGRAGradientRepetition);
begin
  FInterface.GradRepetition := AValue;
end;

procedure TLCVectorialFillControl.SetGradStartColor(AValue: TBGRAPixel);
begin
  FInterface.GradStartColor := AValue;
end;

procedure TLCVectorialFillControl.SetIsTarget(AValue: boolean);
begin
  FInterface.IsTarget := AValue;
end;

procedure TLCVectorialFillControl.SetOnChooseColor(AValue: TChooseColorEvent);
begin
  if FOnChooseColor=AValue then Exit;
  FOnChooseColor:=AValue;
end;

procedure TLCVectorialFillControl.SetOnTextureClick(AValue: TNotifyEvent);
begin
  if FOnTextureClick=AValue then Exit;
  FOnTextureClick:=AValue;
  if Assigned(FOnTextureClick) then
    FInterface.OnTextureClick:= @DoOnTextureClick
  else
    FInterface.OnTextureClick:= nil;
end;

procedure TLCVectorialFillControl.SetSolidColor(AValue: TBGRAPixel);
begin
  FInterface.SolidColor := AValue;
end;

procedure TLCVectorialFillControl.SetTexture(AValue: TBGRABitmap);
begin
  FInterface.Texture := AValue;
end;

procedure TLCVectorialFillControl.SetTextureOpacity(AValue: byte);
begin
  FInterface.TextureOpacity := AValue;
end;

procedure TLCVectorialFillControl.SetTextureRepetition(
  AValue: TTextureRepetition);
begin
  FInterface.TextureRepetition := AValue;
end;

procedure TLCVectorialFillControl.SetToolIconSize(AValue: integer);
begin
  FInterface.ImageListSize := Size(AValue,AValue);
end;

procedure TLCVectorialFillControl.SetVerticalPadding(AValue: integer);
begin
  FInterface.VerticalPadding:= AValue;
end;

procedure TLCVectorialFillControl.CalculatePreferredSize(var PreferredWidth,
  PreferredHeight: integer; WithThemeSpace: Boolean);
begin
  with FInterface.PreferredSize do
  begin
    PreferredWidth := cx;
    PreferredHeight := cy;
  end;
end;

procedure TLCVectorialFillControl.DoOnAdjustToShape(Sender: TObject);
begin
  if Assigned(FOnAdjustToShape) then FOnAdjustToShape(self);
end;

procedure TLCVectorialFillControl.DoOnEditGradTexPoints(Sender: TObject);
begin
  if Assigned(FOnEditGradTexPoints) then FOnEditGradTexPoints(self);
end;

procedure TLCVectorialFillControl.DoOnFillChange(Sender: TObject);
begin
  if Assigned(FOnFillChange) then FOnFillChange(self);
end;

procedure TLCVectorialFillControl.DoOnFillTypeChange(Sender: TObject);
begin
  InvalidatePreferredSize;
  AdjustSize;
  if Assigned(FOnFillTypeChange) then FOnFillTypeChange(self);
end;

procedure TLCVectorialFillControl.DoOnOpacityChange(Sender: TObject);
begin
  if Assigned(FOnOpacityChange) then FOnOpacityChange(self);
end;

procedure TLCVectorialFillControl.DoOnTextureChange(Sender: TObject);
begin
  if Assigned(FOnTextureChange) then FOnTextureChange(self);
end;

procedure TLCVectorialFillControl.DoOnResize;
begin
  inherited DoOnResize;
  FInterface.LoadImageList;
  FInterface.ContainerSizeChanged;
end;

constructor TLCVectorialFillControl.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  FInterface := TVectorialFillInterface.Create(nil, 16,16);
  FInterface.OnChooseColor:=@DoOnChooseColor;
  FInterface.OnFillChange:=@DoOnFillChange;
  FInterface.OnTextureChange:=@DoOnTextureChange;
  FInterface.OnAdjustToShape:=@DoOnAdjustToShape;
  FInterface.OnEditGradTexPoints:=@DoOnEditGradTexPoints;
  FInterface.OnFillTypeChange:=@DoOnFillTypeChange;
  FInterface.OnOpacityChange:=@DoOnOpacityChange;
  FInterface.OnMouseMove:=@InterfaceMouseMove;
  FInterface.OnMouseDown:=@InterfaceMouseDown;
  FInterface.OnMouseUp:=@InterfaceMouseUp;
  FInterface.OnMouseEnter:=@InterfaceMouseEnter;
  FInterface.OnMouseLeave:=@InterfaceMouseLeave;
  FInterface.Container := self;
end;

destructor TLCVectorialFillControl.Destroy;
begin
  FreeAndNil(FInterface);
  inherited Destroy;
end;

procedure TLCVectorialFillControl.AssignFill(AFill: TVectorialFill);
begin
  FInterface.AssignFill(AFill);
end;

function TLCVectorialFillControl.CreateShapeFill(AShape: TVectorShape): TVectorialFill;
begin
  result := FInterface.CreateShapeFill(AShape);
end;

procedure TLCVectorialFillControl.UpdateShapeFill(AShape: TVectorShape;
  ATarget: TLCFillTarget);
begin
  FInterface.UpdateShapeFill(AShape, ATarget);
end;

procedure TLCVectorialFillControl.UpdateFillExceptGeometry(ATargetFill: TVectorialFill);
begin
  FInterface.UpdateFillExceptGeometry(ATargetFill);
end;

end.