GLScene/Externals/Graphics32/Source/GR32.Paint.Tool.pas

unit GR32.Paint.Tool;

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1 or LGPL 2.1 with linking exception
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * Alternatively, the contents of this file may be used under the terms of the
 * Free Pascal modified version of the GNU Lesser General Public License
 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
 * of this license are applicable instead of those above.
 * Please see the file LICENSE.txt for additional information concerning this
 * license.
 *
 * The Original Code is Paint tools for Graphics32
 *
 * The Initial Developer of the Original Code is
 * Anders Melander, [email protected]
 *
 * Portions created by the Initial Developer are Copyright (C) 2008-2025
 * the Initial Developer. All Rights Reserved.
 *
 * ***** END LICENSE BLOCK ***** *)

interface

{$INCLUDE GR32.inc}

uses
  Classes,
  Controls,
  GR32,
  GR32.Paint.Host.API,
  GR32.Paint.Tool.API;


//------------------------------------------------------------------------------
//
//      TCustomBitmap32PaintTool
//
//------------------------------------------------------------------------------
// IBitmap32PaintTool reference implementation
//------------------------------------------------------------------------------
type
  TCustomBitmap32PaintTool = class(TInterfacedObject, IBitmap32PaintExtension, IBitmap32PaintTool)
  strict private
    FPaintHost: IBitmap32PaintHost;
    FSettingValues: ISettingValues;
    FActive: boolean;
  strict protected
    // IBitmap32PaintExtension,
    function GetIsVisible: boolean; virtual;
    function GetIsEnabled: boolean; virtual;
    function GetCaption: string; virtual;
    function GetHint: string; virtual;
    function GetDescription: string; virtual;
    function GetAttribution: string; virtual;
    procedure Clear; virtual;
    procedure Reset; virtual;
    property IsVisible: boolean read GetIsVisible;
    property IsEnabled: boolean read GetIsEnabled;
    property Caption: string read GetCaption;
    property Hint: string read GetHint;
    property Description: string read GetDescription;
    property Attribution: string read GetAttribution;

  strict protected
    // IBitmap32PaintTool
    procedure Activate(var Continue: boolean); virtual;
    procedure Deactivate; virtual;
    procedure BeginTool(var Continue: boolean); virtual;
    procedure EndTool; virtual;

    procedure MouseDown(const Context: IBitmap32PaintToolContext; Button: TMouseButton); virtual;
    procedure MouseMove(const Context: IBitmap32PaintToolContext); virtual;
    procedure MouseUp(const Context: IBitmap32PaintToolContext; Button: TMouseButton); virtual;
    procedure MouseEnter; virtual;
    procedure MouseLeave; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
    procedure KeyUp(var Key: Word; Shift: TShiftState); virtual;
    procedure BeginAction(const Context: IBitmap32PaintToolContext; var ToolState: TBitmap32PaintToolState); virtual;
    procedure ContinueAction(const Context: IBitmap32PaintToolContext; var ToolState: TBitmap32PaintToolState); virtual;
    procedure EndAction(const Context: IBitmap32PaintToolContext; var ToolState: TBitmap32PaintToolState); virtual;
    procedure CallbackAction(Buffer: TBitmap32; Data: pointer; var Result: boolean); virtual;

    function GetCursor(out Cursor: TCursor): boolean; virtual;
    function GetSnapMouse: boolean; virtual;
    property SnapMouse: boolean read GetSnapMouse;
    function GetToolFeatures: TBitmap32PaintToolFeatures; virtual;

  strict protected
    procedure SnapToSquare(const StartPos: TPoint; var Pos: TPoint);

  public
    constructor Create(const APaintHost: IBitmap32PaintHost); virtual;
    destructor Destroy; override;

    function ActiveColor(Shift: TShiftState; Invert: boolean = False): TColor32; overload;
    function ActiveColor(PrimaryColor, SecondaryColor: TColor32; Shift: TShiftState; Invert: boolean = False): TColor32; overload; virtual;

    property PaintHost: IBitmap32PaintHost read FPaintHost;
    property Active: boolean read FActive;
  end;

  TBitmap32PaintToolClass = class of TCustomBitmap32PaintTool;



//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

implementation

uses
  Math, SysUtils;

//------------------------------------------------------------------------------
//
//      TCustomBitmap32PaintTool
//
//------------------------------------------------------------------------------
constructor TCustomBitmap32PaintTool.Create(const APaintHost: IBitmap32PaintHost);
begin
  inherited Create;
  FPaintHost := APaintHost;
  FSettingValues := FPaintHost.GetToolSettings('');
end;

destructor TCustomBitmap32PaintTool.Destroy;
begin
  FPaintHost := nil;
  inherited Destroy;
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.BeginTool(var Continue: boolean);
begin
  Continue := True;
  FActive := True;
end;

procedure TCustomBitmap32PaintTool.EndTool;
begin
  FActive := False;
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.Activate(var Continue: boolean);
begin
end;

procedure TCustomBitmap32PaintTool.Deactivate;
begin
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.ActiveColor(PrimaryColor, SecondaryColor: TColor32; Shift: TShiftState; Invert: boolean): TColor32;
begin
  if ((ssRight in Shift) xor Invert) then
    Result := SecondaryColor
  else
    Result := PrimaryColor;
end;

function TCustomBitmap32PaintTool.ActiveColor(Shift: TShiftState; Invert: boolean): TColor32;
begin
  Result := ActiveColor(PaintHost.ColorPrimary, PaintHost.ColorSecondary, Shift, Invert);
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.CallbackAction(Buffer: TBitmap32;
  Data: pointer; var Result: boolean);
begin
  Result := False;
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.Clear;
begin
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetAttribution: string;
begin
  Result := '';
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetCaption: string;
begin
  Result := '';
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetHint: string;
begin
  Result := Caption;
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetIsEnabled: boolean;
begin
  Result := True;
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetIsVisible: boolean;
begin
  Result := True;
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetSnapMouse: boolean;
begin
  Result := False;
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetToolFeatures: TBitmap32PaintToolFeatures;
begin
  Result := [];
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.KeyDown(var Key: Word; Shift: TShiftState);
begin
end;

procedure TCustomBitmap32PaintTool.KeyUp(var Key: Word; Shift: TShiftState);
begin
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetCursor(out Cursor: TCursor): boolean;
begin
  Cursor := crCross;
  Result := True;
end;

//------------------------------------------------------------------------------

function TCustomBitmap32PaintTool.GetDescription: string;
begin
  Result := '';
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.MouseDown(const Context: IBitmap32PaintToolContext; Button: TMouseButton);
begin
end;

procedure TCustomBitmap32PaintTool.MouseMove(const Context: IBitmap32PaintToolContext);
begin
end;

procedure TCustomBitmap32PaintTool.MouseUp(const Context: IBitmap32PaintToolContext; Button: TMouseButton);
begin
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.MouseEnter;
begin
end;

procedure TCustomBitmap32PaintTool.MouseLeave;
begin
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.BeginAction(const Context: IBitmap32PaintToolContext; var ToolState: TBitmap32PaintToolState);
begin
end;

procedure TCustomBitmap32PaintTool.ContinueAction(const Context: IBitmap32PaintToolContext; var ToolState: TBitmap32PaintToolState);
begin
end;

procedure TCustomBitmap32PaintTool.EndAction(const Context: IBitmap32PaintToolContext; var ToolState: TBitmap32PaintToolState);
begin
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.Reset;
begin
end;

//------------------------------------------------------------------------------

procedure TCustomBitmap32PaintTool.SnapToSquare(const StartPos: TPoint; var Pos: TPoint);

  function Sign(Value: integer): integer; inline;
  begin
    if (Value < 0) then
      Result := -1
    else
      Result := 1;
  end;

var
  dx, dy: integer;
begin
  dx := Pos.X-StartPos.X;
  dy := Pos.Y-StartPos.Y;

  if (Abs(dx) > Abs(dy)) then
    Pos.Y := StartPos.Y+Sign(dy)*Abs(dx)
  else
  if (Abs(dx) < Abs(dy)) then
    Pos.X := StartPos.X+Sign(dx)*Abs(dy);
end;

//------------------------------------------------------------------------------

end.