GLScene/external/Graphics32/Source/Design/GR32.Design.BitmapEditor.pas

unit GR32.Design.BitmapEditor;

(* ***** 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 Graphics32
 *
 * The Initial Developer of the Original Code is
 * Alex A. Denisov
 *
 * Portions created by the Initial Developer are Copyright (C) 2000-2009
 * the Initial Developer. All Rights Reserved.
 *
 * ***** END LICENSE BLOCK ***** *)

interface

{$include GR32.inc}

uses
{$IFDEF FPC}
  LCLIntf, LCLType, RtlConsts, Buttons, LazIDEIntf, PropEdits,
  ComponentEditors,
{$ELSE}
  Windows, ExtDlgs, ToolWin, Registry, ImgList, Consts, DesignIntf,
  DesignEditors, VCLEditors, Actions, System.ImageList,
{$ENDIF}
  Forms, Controls, ComCtrls, ExtCtrls, StdCtrls, Graphics, Dialogs, Menus,
  SysUtils, Classes, Clipbrd, ActnList,
  GR32,
  GR32_Image,
  GR32_Layers;

type
  TPictureEditorForm = class(TForm)
    TabSheetAlpha: TTabSheet;
    Bevel1: TBevel;
    Cancel: TButton;
    ButtonClear: TToolButton;
    ButtonCopy: TToolButton;
    ImageList: TImageList;
    TabSheetRGB: TTabSheet;
    ButtonLoad: TToolButton;
    MenuItemClear: TMenuItem;
    MenuItemCopy: TMenuItem;
    MenuItemInvert: TMenuItem;
    MenuItemLoad: TMenuItem;
    MenuItemPaste: TMenuItem;
    MenuItemSave: TMenuItem;
    mnSeparator: TMenuItem;
    mnSeparator2: TMenuItem;
    OKButton: TButton;
    PageControl: TPageControl;
    Panel1: TPanel;
    ButtonPaste: TToolButton;
    PopupMenu: TPopupMenu;
    ButtonSave: TToolButton;
    ToolBar: TToolBar;
    ToolButton2: TToolButton;
    ActionList: TActionList;
    ActionLoad: TAction;
    ActionSave: TAction;
    ActionClear: TAction;
    ActionCopy: TAction;
    ActionPaste: TAction;
    ActionInvert: TAction;
    TabSheetRGBA: TTabSheet;
    StatusBar: TStatusBar;
    LabelZoom: TLabel;
    ToolButton1: TToolButton;
    ButtonHelp: TToolButton;
    ActionHelp: TAction;
    ButtonGrid: TToolButton;
    ActionGrid: TAction;
    procedure ActionLoadExecute(Sender: TObject);
    procedure ActionSaveExecute(Sender: TObject);
    procedure ActionHasBitmapUpdate(Sender: TObject);
    procedure ActionClearExecute(Sender: TObject);
    procedure ActionPasteUpdate(Sender: TObject);
    procedure ActionCopyExecute(Sender: TObject);
    procedure ActionPasteExecute(Sender: TObject);
    procedure ActionInvertExecute(Sender: TObject);
    procedure ActionHelpExecute(Sender: TObject);
    procedure ActionGridExecute(Sender: TObject);
    procedure ActionGridUpdate(Sender: TObject);
  protected
{$IFDEF PLATFORM_INDEPENDENT}
    FOpenDialog: TOpenDialog;
    FSaveDialog: TSaveDialog;
{$ELSE}
    FOpenDialog: TOpenPictureDialog;
    FSaveDialog: TSavePictureDialog;
{$ENDIF}
    FImageAllChannels: TImage32;
    FImageRGBChannels: TImage32;
    FImageAlphaChannel: TImage32;
    FLayerPixelGrid: TCustomLayer;
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure ImageChanged(Sender: TObject);
    function CurrentImage: TImage32;
    procedure ResetZoomAndCenter(Image: TImage32);
    procedure SyncZoomAndPan;
  public
    constructor Create(AOwner: TComponent); override;
    procedure LoadFromImage(Source: TPersistent);
  end;

  TBitmap32Editor = class(TComponent)
  private
    FBitmap32: TBitmap32;
    procedure SetBitmap32(Value: TBitmap32);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
    property Bitmap32: TBitmap32 read FBitmap32 write SetBitmap32;
  end;

  TBitmap32Property = class(TClassProperty
{$IFDEF EXT_PROP_EDIT}
    , ICustomPropertyDrawing, ICustomPropertyDrawing80
{$ENDIF}
  )
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
{$IFDEF EXT_PROP_EDIT}
    { ICustomPropertyDrawing }
    procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
    procedure PropDrawValue(Canvas: TCanvas; const ARect: TRect; ASelected: Boolean);
    { ICustomPropertyDrawing80 }
    function PropDrawNameRect(const ARect: TRect): TRect;
    function PropDrawValueRect(const ARect: TRect): TRect;
{$ENDIF}
  end;

  TImage32Editor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

implementation

uses
  Math,
  Types,
  GR32.ImageFormats,
  GR32_Filters,
  GR32_Resamplers,
  GR32_Backends_Generic;

{$R *.dfm}
{$R 'GR32.Design.BitmapEditor.res'}

resourcestring
  sInfo = 'Width: %.0n, Height: %.0n';
  sInfoEmpty = '(empty)';
  sZoom = 'Zoom: %.0n%%';
  sHelp = 'Pan by clicking and dragging.'#13+
    'Zoom with the mouse wheel.'#13+
    'Reset zoom and center with the middle mouse button.';

//------------------------------------------------------------------------------
//
//      TPixelGridLayer
//
//------------------------------------------------------------------------------
// Displays a pixel grid on top of the image
//------------------------------------------------------------------------------
type
  TPixelGridLayer = class(TCustomLayer)
  private
    FImage: TCustomImage32;
    FNeedStipple: array[0..1] of boolean;
    FStipple: array[0..1] of TArrayOfColor32;
    FPattern: array[0..1] of DWORD;
    FColorOn: array[0..1] of TColor32;
    FColorOff: array[0..1] of TColor32;
    procedure SetColorOff(const Index: Integer; const Value: TColor32);
    procedure SetColorOn(const Index: Integer; const Value: TColor32);
    procedure SetPattern(const Index: Integer; const Value: DWORD);
    procedure SetStipple(const Index: Integer; const Value: TArrayOfColor32);
    function GetStipple(const Index: Integer): TArrayOfColor32;
  protected
    procedure Paint(Buffer: TBitmap32); override;
  public
    constructor Create(ALayerCollection: TLayerCollection; AImage: TCustomImage32); reintroduce;

    class procedure CreateStipple(var Stipple: TArrayOfColor32; Pattern: DWORD; ColorOn, ColorOff: TColor32);

    property MajorStipple: TArrayOfColor32 index 0 read GetStipple write SetStipple;
    property MajorPattern: DWORD index 0 read FPattern[0] write SetPattern;
    property MajorColorOn: TColor32 index 0 read FColorOn[0] write SetColorOn;
    property MajorColorOff: TColor32 index 0 read FColorOff[0] write SetColorOff;

    property MinorStipple: TArrayOfColor32 index 1 read GetStipple write SetStipple;
    property MinorPattern: DWORD index 1 read FPattern[1] write SetPattern;
    property MinorColorOn: TColor32 index 1 read FColorOn[1] write SetColorOn;
    property MinorColorOff: TColor32 index 1 read FColorOff[1] write SetColorOff;
  end;

//------------------------------------------------------------------------------
//
//      TPixelGridLayer
//
//------------------------------------------------------------------------------
constructor TPixelGridLayer.Create(ALayerCollection: TLayerCollection;
  AImage: TCustomImage32);
begin
  inherited Create(ALayerCollection);
  FImage := AImage;

  FNeedStipple[0] := True;
  FNeedStipple[1] := True;

  FPattern[0] := $55555555;
  FColorOn[0] := $ff353535;
  FColorOff[0] := $ffa0a0a0;

  FPattern[1] := $55555555;
  FColorOn[1] := $ffa0a0a0;
  FColorOff[1] := $ffbfbfbf;
end;

class procedure TPixelGridLayer.CreateStipple(var Stipple: TArrayOfColor32; Pattern: DWORD; ColorOn, ColorOff: TColor32);
var
  i: integer;
  Mask: DWORD;
begin
  SetLength(Stipple, 32);
  Mask := $80000000;
  i := 0;
  while (Mask <> 0) do
  begin
    if (Pattern and Mask = 0) then
      Stipple[i] := ColorOff
    else
      Stipple[i] := ColorOn;

    Mask := Mask shr 1;
    inc(i);
  end;
end;

function TPixelGridLayer.GetStipple(const Index: Integer): TArrayOfColor32;
begin
  if (FNeedStipple[Index]) then
    CreateStipple(FStipple[Index], FPattern[Index], FColorOn[Index], FColorOff[Index]);
  Result := FStipple[Index];
end;

procedure TPixelGridLayer.Paint(Buffer: TBitmap32);
var
  i: integer;
  Step: integer;
  MinStep: integer;
  Lines: integer;
  Rect: TRect;
  Size: TSize;
  p: TPoint;
begin
  try
    if (Abs(FImage.Scale) >= 4) then
      Step := 1
    else
      Step := 4;

    // Enforce minimal grid of 4 pixels
    MinStep := Ceil(4 / Abs(FImage.Scale));

    Step := Max(Step, MinStep);

    Rect := FImage.GetBitmapRect;
    Size.cx := FImage.Bitmap.Width;
    Size.cy := FImage.Bitmap.Height;

    // Minor grid
    Buffer.StippleStep := 1;
    Buffer.SetStipple(MinorStipple);
    i := Step;
    Lines := 1;
    while (i < Size.cx) or (i < Size.cy) do
    begin
      if (Abs(FImage.Scale) <= 4) or (Lines mod 8 <> 0) then
      begin
        p := FImage.BitmapToControl(GR32.Point(i, i));

        // Vertical line
        if (i < Size.cx) then
        begin
          Buffer.StippleCounter := 0;
          Buffer.VertLineTSP(p.X, Rect.Top+1, Rect.Bottom-1);
        end;
        // Horizontal line
        if (i < Size.cy) then
        begin
          Buffer.StippleCounter := 0;
          Buffer.HorzLineTSP(Rect.Left+1, p.Y, Rect.Right-1);
        end;
      end;
      inc(i, Step);
      inc(Lines);
    end;

    // Major grid
    Buffer.SetStipple(MajorStipple);
    i := Step*8;
    if (Abs(FImage.Scale) > 4) then
      while (i < Size.cx) or (i < Size.cy) do
      begin
        p := FImage.BitmapToControl(GR32.Point(i, i));

        // Vertical line
        if (i < Size.cx) then
        begin
          Buffer.StippleCounter := 0;
          Buffer.VertLineTSP(p.X, Rect.Top+1, Rect.Bottom-1);
        end;
        // Horizontal line
        if (i < Size.cy) then
        begin
          Buffer.StippleCounter := 0;
          Buffer.HorzLineTSP(Rect.Left+1, p.Y, Rect.Right-1);
        end;

        inc(i, Step*8);
      end;

    // Vertical border kines
    Buffer.StippleCounter := 1;
    Buffer.VertLineTSP(Rect.Left, Rect.Top, Rect.Bottom);
    Buffer.StippleCounter := 1;
    Buffer.VertLineTSP(Rect.Right, Rect.Top, Rect.Bottom);
    // Horizontal border lines
    Buffer.StippleCounter := 0;
    Buffer.HorzLineTSP(Rect.Left+1, Rect.Top, Rect.Right-1);
    Buffer.StippleCounter := 0;
    Buffer.HorzLineTSP(Rect.Left+1, Rect.Bottom, Rect.Right-1);
  except
    // Prevent AV flood due to repaint
    Visible := False;
    raise;
  end;
end;

procedure TPixelGridLayer.SetColorOff(const Index: Integer; const Value: TColor32);
begin
  FColorOff[Index] := Value;
  FNeedStipple[Index] := True;
end;

procedure TPixelGridLayer.SetColorOn(const Index: Integer; const Value: TColor32);
begin
  FColorOn[Index] := Value;
  FNeedStipple[Index] := True;
end;

procedure TPixelGridLayer.SetPattern(const Index: Integer; const Value: DWORD);
begin
  FPattern[Index] := Value;
  FNeedStipple[Index] := True;
end;

procedure TPixelGridLayer.SetStipple(const Index: Integer;
  const Value: TArrayOfColor32);
begin
  FStipple[Index] := Value;
  FNeedStipple[Index] := False;
end;

{ TPictureEditorForm }

function TPictureEditorForm.CurrentImage: TImage32;
begin
  if PageControl.ActivePage = TabSheetRGB then
    Result := FImageRGBChannels
  else
  if PageControl.ActivePage = TabSheetAlpha then
    Result := FImageAlphaChannel
  else
    Result := FImageAllChannels
end;

procedure TPictureEditorForm.LoadFromImage(Source: TPersistent);

  procedure UpdateImageBackground(Image: TImage32);
  begin
    if (Image.Bitmap.Empty) then
    begin
      Image.Background.OuterBorderColor := clNone;
      Image.Background.InnerBorderColor := clNone;
      Image.Background.InnerBorderWidth := 0;
      Image.Background.FillStyle := bfsCheckers;
    end else
    begin
      Image.Background.OuterBorderColor := clGray;
      Image.Background.InnerBorderColor := clWhite;
      Image.Background.InnerBorderWidth := 8;
      Image.Background.FillStyle := bfsColor;
    end;
  end;

begin
  FImageAllChannels.BeginUpdate;
  FImageRGBChannels.BeginUpdate;
  FImageAlphaChannel.BeginUpdate;
  try
    if CurrentImage = FImageAllChannels then
    begin
      // Load RGBA bitmap, separate into RGB and A

      // Load RGBA
      FImageAllChannels.Bitmap.Assign(Source);
      FImageAllChannels.Bitmap.DrawMode := dmBlend;

      // Separate RGB
      FImageRGBChannels.Bitmap.Assign(FImageAllChannels.Bitmap);
      FImageRGBChannels.Bitmap.ResetAlpha;

      // Separate A
      AlphaToGrayscale(FImageAlphaChannel.Bitmap, FImageAllChannels.Bitmap);
      FImageAlphaChannel.Bitmap.ResetAlpha;
    end else
    if CurrentImage = FImageRGBChannels then
    begin
      // Load RGB bitmap, keep existing A

      // Load RGB
      if (Source <> nil) then
      begin
        FImageRGBChannels.Bitmap.Assign(Source);
        FImageRGBChannels.Bitmap.ResetAlpha;
      end else
        FImageRGBChannels.Bitmap.Clear($FF000000);

      // Merge A and RGB into RGBA
      FImageAllChannels.Bitmap.Assign(FImageRGBChannels.Bitmap);
      FImageAllChannels.Bitmap.DrawMode := dmBlend;
      if (not FImageAlphaChannel.Bitmap.Empty) then
        IntensityToAlpha(FImageAllChannels.Bitmap, FImageAlphaChannel.Bitmap)
      else
        FImageAllChannels.Bitmap.ResetAlpha;
    end else
    if CurrentImage = FImageAlphaChannel then
    begin
      // Load A bitmap, keep existing RGB
      if (Source <> nil) then
        FImageAlphaChannel.Bitmap.Assign(Source)
      else
        FImageAlphaChannel.Bitmap.Clear($FFFFFFFF);
      ColorToGrayscale(FImageAlphaChannel.Bitmap, FImageAlphaChannel.Bitmap);

      // Merge A and RGB into RGBA
      if (not FImageRGBChannels.Bitmap.Empty) then
      begin
        FImageAllChannels.Bitmap.Assign(FImageRGBChannels.Bitmap);
        FImageAllChannels.Bitmap.DrawMode := dmBlend;
      end else
      begin
        FImageAllChannels.Bitmap.SetSizeFrom(FImageAlphaChannel.Bitmap);
        FImageAllChannels.Bitmap.Clear;
      end;
      IntensityToAlpha(FImageAllChannels.Bitmap, FImageAlphaChannel.Bitmap);
    end;

    ResetZoomAndCenter(FImageAllChannels);
    ResetZoomAndCenter(FImageRGBChannels);
    ResetZoomAndCenter(FImageAlphaChannel);

    UpdateImageBackground(FImageAllChannels);
    UpdateImageBackground(FImageRGBChannels);
    UpdateImageBackground(FImageAlphaChannel);
  finally
    FImageAllChannels.EndUpdate;
    FImageRGBChannels.EndUpdate;
    FImageAlphaChannel.EndUpdate;
  end;
  FImageAllChannels.Changed;
  FImageRGBChannels.Changed;
  FImageAlphaChannel.Changed;

  if (FImageAllChannels.Bitmap.Empty) then
    StatusBar.Panels[3].Text := sInfoEmpty
  else
    StatusBar.Panels[3].Text := Format(sInfo, [1.0*FImageAllChannels.Bitmap.Width, 1.0*FImageAllChannels.Bitmap.Height]);
end;

procedure TPictureEditorForm.ResetZoomAndCenter(Image: TImage32);
var
  Size: TSize;
begin
  Image.BeginUpdate;
  try
    // Reset Zoom...
    Image.Scale := 1;

    // ...and Center image
    Size := Image.GetBitmapSize;
    Image.OffsetHorz := (Image.Width-Size.cx) div 2;
    Image.OffsetVert := (Image.Height-Size.cy) div 2;
  finally
    Image.EndUpdate;
  end;
  Image.Changed;
end;

procedure TPictureEditorForm.SyncZoomAndPan;

  procedure DoSync(Image: TImage32);
  begin
    if (Image = CurrentImage) then
      exit;

    Image.BeginUpdate; // Avoid recursion
    try
      Image.Scale := CurrentImage.Scale;
      Image.OffsetHorz := CurrentImage.OffsetHorz;
      Image.OffsetVert := CurrentImage.OffsetVert;
    finally
      Image.EndUpdate;
    end;
    // Invalidate without firing OnChange
    Image.ForceFullInvalidate;
  end;

begin
  if (CurrentImage = nil) then
    exit;

  LabelZoom.Caption := Format(sZoom, [CurrentImage.Scale * 100]);

  DoSync(FImageAllChannels);
  DoSync(FImageRGBChannels);
  DoSync(FImageAlphaChannel);
end;

constructor TPictureEditorForm.Create(AOwner: TComponent);

  function CreateImage32(AParent: TWinControl): TImage32;
  begin
    Result := TImage32.Create(Self);
    Result.Parent := AParent;
    Result.Align := alClient;
    Result.BitmapAlign := baCustom;
    Result.Cursor := crCross;
    Result.PopupMenu := PopupMenu;
    Result.Background.CheckersStyle := bcsMedium;
    Result.Background.OuterBorderColor := clGray;
    Result.Background.InnerBorderColor := clWhite;
    Result.Background.InnerBorderWidth := 8;
    Result.Background.FillStyle := bfsCheckers;
    Result.MousePan.Enabled := True;
    Result.MousePan.PanCursor := crSizeAll;
    Result.MouseZoom.Enabled := True;
    Result.MouseZoom.Animate := True;
    Result.TabStop := True; // Required for mouse wheel
    Result.Scale := 1;
    Result.ScaleMode := smScale;
    Result.OnMouseMove := ImageMouseMove;
    Result.OnMouseDown := ImageMouseDown;
    Result.OnChange := ImageChanged;
  end;

  procedure LoadGlyphs;
  var
    ResourceName: string;
    Bitmap: TBitmap;
    Stream: TResourceStream;
  const
    sBitmapNames: array[0..7] of string = (
      'GR32_OPEN',
      'GR32_SAVE',
      'GR32_CLEAR',
      'GR32_COPY',
      'GR32_PASTE',
      'GR32_INVERT',
      'GR32_HELP',
      'GR32_GRID'
    );
  begin
    // We're not storing bitmaps in the imagelist in order to support FPC.
    // FPC's TImageList doesn't have the ColorDepth property.
    ImageList.Clear;
{$ifndef FPC}
    ImageList.ColorDepth := cd32bit;
{$endif FPC}
    Bitmap := TBitmap.Create;
    try
      for ResourceName in sBitmapNames do
      begin
        Stream := TResourceStream.Create(hInstance, ResourceName, 'BITMAP32');
        try
          Bitmap.LoadFromStream(Stream);
        finally
          Stream.Free;
        end;

        ImageList.AddMasked(Bitmap, -1);
      end;
    finally
      Bitmap.Free;
    end;
  end;

begin
  inherited;

  LoadGlyphs;

  FImageAllChannels := CreateImage32(TabSheetRGBA);
  FImageRGBChannels := CreateImage32(TabSheetRGB);
  FImageAlphaChannel := CreateImage32(TabSheetAlpha);

  FImageAllChannels.Bitmap.DrawMode := dmBlend;

  FLayerPixelGrid := TPixelGridLayer.Create(FImageAllChannels.Layers, FImageAllChannels);
  FLayerPixelGrid.Visible := False;

{$IFDEF PLATFORM_INDEPENDENT}
  FOpenDialog := TOpenDialog.Create(Self);
  FSaveDialog := TSaveDialog.Create(Self);
{$ELSE}
  FOpenDialog := TOpenPictureDialog.Create(Self);
  FSaveDialog := TSavePictureDialog.Create(Self);
{$ENDIF}
  FOpenDialog.Filter := ImageFormatManager.BuildFileFilter(IImageFormatReader, True) +
    '|' + SDefaultFilter;
  FSaveDialog.Filter := ImageFormatManager.BuildFileFilter(IImageFormatWriter) +
    '|' + SDefaultFilter;
end;


{ TBitmap32Editor }

constructor TBitmap32Editor.Create(AOwner: TComponent);
begin
  inherited;
  FBitmap32 := TBitmap32.Create;
end;

destructor TBitmap32Editor.Destroy;
begin
  FBitmap32.Free;
  inherited;
end;

function TBitmap32Editor.Execute: Boolean;
var
  PictureEditorForm: TPictureEditorForm;
begin
  PictureEditorForm := TPictureEditorForm.Create(Self);
  try

    PictureEditorForm.LoadFromImage(FBitmap32);

    Result := (PictureEditorForm.ShowModal = mrOK);

    if Result then
      FBitmap32.Assign(PictureEditorForm.FImageAllChannels.Bitmap);

  finally
    PictureEditorForm.Free;
  end;
end;

procedure TBitmap32Editor.SetBitmap32(Value: TBitmap32);
begin
  try
    FBitmap32.Assign(Value);
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

{ TBitmap32Property }

procedure TBitmap32Property.Edit;
var
  BitmapEditor: TBitmap32Editor;
begin
  try
    BitmapEditor := TBitmap32Editor.Create(nil);
    try
{$IFDEF FPC}
      BitmapEditor.Bitmap32 := TBitmap32(GetObjectValue);
{$ELSE}
      BitmapEditor.Bitmap32 := TBitmap32(Pointer(GetOrdValue));
{$ENDIF}
      if BitmapEditor.Execute then
      begin
{$IFDEF FPC}
        SetPtrValue(BitmapEditor.Bitmap32);
{$ELSE}
        SetOrdValue(Longint(BitmapEditor.Bitmap32));
{$ENDIF}
      end;
    finally
      BitmapEditor.Free;
    end;
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

function TBitmap32Property.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paSubProperties];
end;

function TBitmap32Property.GetValue: string;
var
  Bitmap: TBitmap32;
begin
  try
{$IFDEF FPC}
    Bitmap := TBitmap32(GetObjectValue);
{$ELSE}
    Bitmap := TBitmap32(GetOrdValue);
{$ENDIF}
    if (Bitmap = nil) or Bitmap.Empty then
      Result := srNone
    else
      Result := Format('%s [%d,%d]', [Bitmap.ClassName, Bitmap.Width, Bitmap.Height]);
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

{$IFDEF EXT_PROP_EDIT}
procedure TBitmap32Property.PropDrawValue(Canvas: TCanvas;
  const ARect: TRect; ASelected: Boolean);
var
  Bitmap32: TBitmap32;
  TmpBitmap: TBitmap32;
  R: TRect;
begin
  Bitmap32 := TBitmap32(GetOrdValue);
  if Bitmap32.Empty then
    DefaultPropertyDrawValue(Self, Canvas, ARect)
  else
  begin
    R := ARect;
    R.Right := R.Left + R.Bottom - R.Top;

    TmpBitmap := TBitmap32.Create;
    TmpBitmap.Width := R.Right - R.Left;
    TmpBitmap.Height := R.Bottom - R.Top;
    TDraftResampler.Create(TmpBitmap);
    TmpBitmap.Draw(TmpBitmap.BoundsRect, Bitmap32.BoundsRect, Bitmap32);
    TmpBitmap.DrawTo(Canvas.Handle, R, TmpBitmap.BoundsRect);
    TmpBitmap.Free;

    R.Left := R.Right;
    R.Right := ARect.Right;
    DefaultPropertyDrawValue(Self, Canvas, R);
  end;
end;

procedure TBitmap32Property.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
begin
  DefaultPropertyDrawName(Self, ACanvas, ARect);
end;

function TBitmap32Property.PropDrawNameRect(const ARect: TRect): TRect;
begin
  Result := ARect;
end;

function TBitmap32Property.PropDrawValueRect(const ARect: TRect): TRect;
begin
  if TBitmap32(GetOrdValue).Empty then
    Result := ARect
  else
    Result := Rect(ARect.Left, ARect.Top, (ARect.Bottom - ARect.Top) + ARect.Left, ARect.Bottom);
end;

{$ENDIF}

procedure TBitmap32Property.SetValue(const Value: string);
begin
  if Value = '' then
    SetOrdValue(0);
end;

{ TImage32Editor }

procedure TImage32Editor.ExecuteVerb(Index: Integer);
var
  Img: TCustomImage32;
  BitmapEditor: TBitmap32Editor;
begin
  Img := Component as TCustomImage32;
  if Index = 0 then
  begin
    BitmapEditor := TBitmap32Editor.Create(nil);
    try
      BitmapEditor.Bitmap32 := Img.Bitmap;
      if BitmapEditor.Execute then
      begin
        Img.Bitmap := BitmapEditor.Bitmap32;
        Designer.Modified;
      end;
    finally
      BitmapEditor.Free;
    end;
  end;
end;

function TImage32Editor.GetVerb(Index: Integer): string;
begin
  if Index = 0 then
    Result := 'Bitmap32 Editor...';
end;

function TImage32Editor.GetVerbCount: Integer;
begin
  Result := 1;
end;

procedure TPictureEditorForm.ActionClearExecute(Sender: TObject);
begin
  LoadFromImage(nil);
end;

procedure TPictureEditorForm.ActionLoadExecute(Sender: TObject);
var
  Bitmap: TBitmap32;
begin
  if not FOpenDialog.Execute then
    exit;

  Bitmap := TBitmap32.Create(TMemoryBackend);
  try
    Bitmap.LoadFromFile(FOpenDialog.Filename);
    LoadFromImage(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

procedure TPictureEditorForm.ActionPasteExecute(Sender: TObject);
var
  Bitmap: TBitmap32;
begin
  Bitmap := TBitmap32.Create;
  try
    Bitmap.Assign(Clipboard);
    LoadFromImage(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

procedure TPictureEditorForm.ActionPasteUpdate(Sender: TObject);
begin
  try
    TAction(Sender).Enabled := ImageFormatManager.ClipboardFormats.CanPasteFromClipboard;
  except
{$IFDEF FPC}
    TAction(Sender).Enabled := False;
{$ELSE FPC}
    on E: EClipboardException do
      TAction(Sender).Enabled := False; // Something else has the clipboard open
{$ENDIF FPC}
  end;
end;

procedure TPictureEditorForm.ActionSaveExecute(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  if (CurrentImage.Bitmap.Empty) then
    exit;

  FSaveDialog.DefaultExt := GraphicExtension(TBitmap);

  if not FSaveDialog.Execute then
    exit;

  if (CurrentImage = FImageAllChannels) or
    (not SameText(ExtractFileExt(FSaveDialog.Filename), GraphicExtension(TBitmap))) then
    // Save in 32-bit RGBA bitmap (or whatever format we have chosen)
    FImageAllChannels.Bitmap.SaveToFile(FSaveDialog.Filename)
  else
  begin
    // Save 24-bit RGB bitmap
    Bitmap := TBitmap.Create;
    try
      Bitmap.Assign(CurrentImage.Bitmap);
      Bitmap.PixelFormat := pf24Bit;

      Bitmap.SaveToFile(FSaveDialog.Filename)
    finally
      Bitmap.Free;
    end;
  end;
end;

procedure TPictureEditorForm.ActionCopyExecute(Sender: TObject);
begin
  Clipboard.Assign(CurrentImage.Bitmap);
end;

procedure TPictureEditorForm.ActionGridExecute(Sender: TObject);
begin
  FLayerPixelGrid.Visible := TAction(Sender).Checked;
end;

procedure TPictureEditorForm.ActionGridUpdate(Sender: TObject);
begin
  TAction(Sender).Checked := FLayerPixelGrid.Visible;
end;

procedure TPictureEditorForm.ActionHasBitmapUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (CurrentImage <> nil) and (not CurrentImage.Bitmap.Empty);
end;

procedure TPictureEditorForm.ActionHelpExecute(Sender: TObject);
begin
  ShowMessage(sHelp);
end;

procedure TPictureEditorForm.ActionInvertExecute(Sender: TObject);
begin
  if (CurrentImage = FImageAllChannels) then
  begin
    Invert(FImageAllChannels.Bitmap, FImageAllChannels.Bitmap);
    InvertRGB(FImageRGBChannels.Bitmap, FImageRGBChannels.Bitmap);
    InvertRGB(FImageAlphaChannel.Bitmap, FImageAlphaChannel.Bitmap);
  end else
  if (CurrentImage = FImageRGBChannels) then
  begin
    InvertRGB(FImageAllChannels.Bitmap, FImageAllChannels.Bitmap);
    InvertRGB(FImageRGBChannels.Bitmap, FImageRGBChannels.Bitmap);
  end else
  begin
    Invert(FImageAllChannels.Bitmap, FImageAllChannels.Bitmap, [ccAlpha]);
    InvertRGB(FImageAlphaChannel.Bitmap, FImageAlphaChannel.Bitmap);
  end;
end;

procedure TPictureEditorForm.ImageChanged(Sender: TObject);
begin
  SyncZoomAndPan;
end;

procedure TPictureEditorForm.ImageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  if (Button = mbMiddle) then
    ResetZoomAndCenter(TImage32(Sender));
end;

procedure TPictureEditorForm.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
var
  Image: TImage32;
  P: TPoint;
  Color: TColor32Entry;
  ColorHex: string;
  ColorChannels: string;
begin
  Image := TImage32(Sender);

  if (Image.IsMousePanning) then
    exit;

  if (Image.Bitmap = nil) or (Image.Bitmap.Empty) then
  begin
    StatusBar.Panels[0].Text := '';
    StatusBar.Panels[1].Text := '';
    StatusBar.Panels[2].Text := '';
    exit;
  end;

  P := Image.ControlToBitmap(GR32.Point(X, Y));

  if (P.X >= 0) and (P.Y >= 0) and
    (P.X < Image.Bitmap.Width) and (P.Y < Image.Bitmap.Height) then
  begin
    Color := TColor32Entry(Image.Bitmap[P.X, P.Y]);

    if (Image = FImageAllChannels) then
    begin
      ColorHex := Format('ARGB: $%.8X', [Color.ARGB]);
      ColorChannels := Format('A:%-3d R:%-3d G:%-3d B:%-3d', [Color.A, Color.R, Color.G, Color.B]);
    end else
    if (Image = FImageRGBChannels) then
    begin
      ColorHex := Format('RGB: $%.6X', [Color.ARGB and $00FFFFFF]);
      ColorChannels := Format('R:%-3d G:%-3d B:%-3d', [Color.R, Color.G, Color.B]);
    end else
    begin
      ColorHex := Format('Alpha: $%.2X', [Color.R]);
      ColorChannels := Format('A:%-3d', [Color.R]);
    end;

    StatusBar.Panels[0].Text := ColorHex;
    StatusBar.Panels[1].Text := ColorChannels;
    StatusBar.Panels[2].Text := Format('X:%-2d Y:%-2d', [P.X, P.Y])
  end else
  begin
    StatusBar.Panels[0].Text := '';
    StatusBar.Panels[1].Text := '';
    StatusBar.Panels[2].Text := '';
  end;
end;

end.