delphi Image32 图形处理 图层

图形图层处理是Image32的主要功能，矢量图形，分层类似 Photoshop看人图层，直接上代码效果。

unit uFrmLayer;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Types, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
  Vcl.Dialogs, Vcl.Menus, Vcl.ComCtrls, Vcl.ToolWin, //
  Img32, Img32.Layers, Img32.Text, Img32.Draw, uLayerDefines,
  uLayerDefinesarrows, //
  Vcl.ExtCtrls, Vcl.Buttons, Vcl.StdCtrls;

type
  TfrmLayer = class(TForm)
    SaveDialog1: TSaveDialog;
    PopupMenu1: TPopupMenu;
    mnuAddImage: TMenuItem;
    mnuAddEllipse: TMenuItem;
    mnuAddRectangle: TMenuItem;
    mnuAddText: TMenuItem;
    N4: TMenuItem;
    mnuBringToFront: TMenuItem;
    mnuSendToBack: TMenuItem;
    N3: TMenuItem;
    mnuDeleteLayer: TMenuItem;
    OpenDialog1: TOpenDialog;
    SpeedButton1: TSpeedButton;
    Panel1: TPanel;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    Label1: TLabel;
    SpeedButton11: TSpeedButton;
    mnuAddText2: TMenuItem;
    mnuAddArrow: TMenuItem;
    mnuRotate: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    N9: TMenuItem;
    ckbOther: TCheckBox;
    ckbHatchBackground: TCheckBox;
    ColorDialog1: TColorDialog;
    btnSetColor: TSpeedButton;
    btnSetPenColor: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure OnToolButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ckbHatchBackgroundClick(Sender: TObject);
    procedure btnSetColorClick(Sender: TObject);
  private
    delayedMovePending: Boolean;
    delayedShift: TShiftState;
    delayedPos: TPoint;

    UseAppOnIdle: Boolean;
    procedure AppOnIdle(Sender: TObject; var Done: Boolean);
    procedure DelayedMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
    layeredImg32: TLayeredImage32;
    fontReader: TFontReader;
    fontCache: TFontCache;
    fontCacheCN: TFontCache;
    wordStrings: TStringList;
    clickedLayer: TLayer32;
    targetLayer: TLayer32;
//    buttonGroup: TGroupLayer32;
    arrowButtonGroup: TGroupLayer32;
    sizingButtonGroup: TSizingGroupLayer32;
    rotatingButtonGroup: TRotatingGroupLayer32;
    popupPoint: TPoint;
    clickPoint: TPoint;
    procedure SetTargetLayer(layer: TLayer32);
    procedure DeleteAllControlButtons;
  protected
    procedure WMERASEBKGND(var message: TMessage); message WM_ERASEBKGND;
  end;

var
  frmLayer: TfrmLayer;

implementation

{$R *.dfm}
{$R WORDS.RES}    // 一些单词列表。
{$R FONT.RES}     // 字体
{$R Cursors.res} // rotation cursor

uses
  Img32.Fmt.BMP, Img32.Fmt.PNG, Img32.Fmt.JPG, Img32.Fmt.QOI, Img32.Fmt.SVG,
  Img32.Vector, Img32.Extra, Img32.Clipper2;

const
  margin = 100;

const
  crRotate = 1;
  crMove = 2;

procedure TfrmLayer.AppOnIdle(Sender: TObject; var Done: Boolean);
begin
  Done := true;
  if not delayedMovePending then
    Exit;
  delayedMovePending := false;
  if not (csDestroying in self.ComponentState) then     //销毁时不要再调用了
    DelayedMouseMove(Sender, delayedShift, delayedPos.X, delayedPos.Y);
end;

procedure TfrmLayer.btnSetColorClick(Sender: TObject);
var
  nTag: NativeInt;
begin
  if Sender is TSpeedButton then
  begin
    if not Assigned(targetLayer) or not (targetLayer is TMyVectorLayer32) then
      Exit;

    nTag := (Sender as TSpeedButton).Tag;
    if nTag = 1 then  //边框
    begin
      ColorDialog1.Color := RGBColor(TMyVectorLayer32(targetLayer).PenColor);
    end
    else
    begin
      ColorDialog1.Color := RGBColor(TMyVectorLayer32(targetLayer).BrushColor);
    end;

    if not Assigned(targetLayer) or not ColorDialog1.Execute then
      Exit;
    with TMyVectorLayer32(targetLayer) do
    begin
      if nTag = 1 then  //边框
      begin
        PenColor := Color32(ColorDialog1.Color);
      end
      else
      begin
        BrushColor := Color32(ColorDialog1.Color);
      end;
    // this is an easy way to force a repaint and redo hit-testing too.
      SetInnerBounds(InnerBounds);
    end;
    invalidate;
  end;
end;

procedure TfrmLayer.ckbHatchBackgroundClick(Sender: TObject);
begin
  if Assigned(layeredImg32) then
  begin
    with layeredImg32[0] do
    begin
      visible := ckbHatchBackground.Checked;
      if visible then
        HatchBackground(Image);
    end;
    layeredImg32.Invalidate;  //要加上这句 (要不然，图像区域可能不会刷新，导致不绘制)
    invalidate;
  end;
end;

procedure TfrmLayer.DelayedMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  layer: TLayer32;
  rec: TRect;
  dx, dy: Integer;
  newAngle: double;
begin
  dx := X - clickPoint.X;
  dy := Y - clickPoint.Y;
  clickPoint := Point(X, Y);

  if not (ssLeft in Shift) then
  begin
    // just moving the unclicked mouse
    // so update the cursor and exit
    layer := layeredImg32.GetLayerAt(clickPoint, false);
    if Assigned(layer) then
      cursor := layer.CursorId
    else
      cursor := crDefault;
    Exit;
  end;

  // however if nothing was clicked then exit
  if not Assigned(clickedLayer) then
    Exit;

  clickedLayer.Offset(dx, dy);

  // if moving a sizing button
  if (clickedLayer.Parent is TSizingGroupLayer32) then
  begin
    rec := UpdateSizingButtonGroup(clickedLayer);
    targetLayer.SetInnerBounds(RectD(rec));
  end

  // if moving a rotate button
  else if (clickedLayer.Parent = rotatingButtonGroup) then
  begin
    if clickedLayer = rotatingButtonGroup.PivotButton then
    begin
      clickedLayer.Offset(-dx, -dy);      // undo button move above
      rotatingButtonGroup.Offset(dx, dy); // move the whole rotate group
      TRotLayer32(targetLayer).PivotPt := clickedLayer.MidPoint;
    end
    else
    begin
      // Update rotatingButtonGroup and get the new angle
      newAngle := UpdateRotatingButtonGroup(clickedLayer);
      TRotLayer32(targetLayer).Angle := newAngle;
    end;
  end

  // if moving an arrow designer button
  else if (clickedLayer.Parent = arrowButtonGroup) then
  begin
    with targetLayer as TMyArrowLayer32 do
      UpdateArrow(arrowButtonGroup, clickedLayer.Index)
  end

  // if moving targetlayer (ie not a button layer)
  else if (clickedLayer = targetLayer) then
  begin
    if Assigned(sizingButtonGroup) then
      sizingButtonGroup.Offset(dx, dy)
    else if Assigned(rotatingButtonGroup) then
    begin
      if TRotLayer32(targetLayer).AutoPivot then
        rotatingButtonGroup.Offset(dx, dy);
    end
    else if Assigned(arrowButtonGroup) then
      arrowButtonGroup.Offset(dx, dy);
  end;
  Invalidate;
end;

procedure TfrmLayer.DeleteAllControlButtons;
begin
  // delete all 'designer' buttons
//  FreeAndNil(ButtonGroup);
  FreeAndNil(sizingButtonGroup);
  FreeAndNil(rotatingButtonGroup);
  FreeAndNil(arrowButtonGroup);
end;

procedure TfrmLayer.FormCreate(Sender: TObject);
var
  resStream: TResourceStream;
begin
  self.BorderStyle := bsNone;
  ckbHatchBackground.Checked := True;
  Randomize;
  InitHsl(); // 初始化变量的值

  layeredImg32 := TLayeredImage32.Create; // sized in FormResize below.
  // add a hatched background design layer (see FormResize below).

  // layeredImg32.Resampler := rNearestResampler; //draft quality (fast)
  layeredImg32.Resampler := rBiLinearResampler; // high quality (pretty fast)
  // layeredImg32.Resampler := rBiCubicResampler; //best quality (slower)

  layeredImg32.AddLayer(TLayer32); // 添加一个背景层

  // create text rendering objects     这个字体只支持英文
  fontReader := FontManager.LoadFromResource('FONT_NSB', RT_RCDATA);
  fontCache := TFontCache.Create(fontReader, DpiAware(48));

  //要支持中文，必须加载中文字体
  fontCacheCN := TFontCache.Create(FontManager.Load('Arial Unicode MS', 800), DPIAware(16));

  TMyVectorLayer32.FFontCache := fontCacheCN;
  // load a word list (for random words) 一些英语单词
  wordStrings := TStringList.Create;
  resStream := TResourceStream.Create(hInstance, 'WORDS', RT_RCDATA);
  try
    wordStrings.LoadFromStream(resStream);
  finally
    resStream.Free;
  end;
  popupPoint := Point(layeredImg32.MidPoint); // 这里可能是0

  Screen.Cursors[crRotate] := LoadImage(HInstance, 'ROTATE', IMAGE_CURSOR, 32, 32, LR_DEFAULTSIZE);
  Screen.Cursors[crMove] := LoadImage(HInstance, 'MOVE', IMAGE_CURSOR, 32, 32, LR_DEFAULTSIZE);

  UseAppOnIdle := true; // //这个方法，解决了拖动调整大小时卡顿现象 (不使用这种方式，64位程序还行，但32位程序卡顿明显)
  if UseAppOnIdle then
    Application.OnIdle := AppOnIdle;
end;

procedure TfrmLayer.FormDestroy(Sender: TObject);
begin
  wordStrings.Free;
  fontCache.Free;
  FreeAndNil(layeredImg32);
  fontReader.Free;    //如果不释放，重新进入可能添加文字看不见
  fontCacheCN.Free;
  Application.OnIdle := nil;
end;

procedure TfrmLayer.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) and Assigned(targetLayer) then
  begin
    SetTargetLayer(nil); // 取消选择
    Key := 0;
  end;
end;

procedure TfrmLayer.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  clickPoint := System.Types.Point(X, Y);
  clickedLayer := layeredImg32.GetLayerAt(clickPoint); // 通过点获取哪个图层.

  if not Assigned(clickedLayer) then
  begin
    DeleteAllControlButtons; // 释放选中点图层组。
    targetLayer := nil;
  end
  else if (clickedLayer = targetLayer) or (clickedLayer is TButtonDesignerLayer32) then
    Exit
  else if (clickedLayer is TRotLayer32) then
  begin
    // nb: TMyRasterLayer32 and TMyVectorLayer32 are both TRotatableLayer32
    // so this is clicking on a new target layer
    DeleteAllControlButtons;
    targetLayer := TRotLayer32(clickedLayer);

    if (clickedLayer is TMyArrowLayer32) then
      arrowButtonGroup := CreateButtonGroup(layeredImg32.Root, TMyArrowLayer32(clickedLayer).Paths[0], bsRound, DefaultButtonSize, clGreen32)
    else
      sizingButtonGroup := CreateSizingButtonGroup(targetLayer, ssCorners, bsRound, DefaultButtonSize, clRed32);
  end;
//  else if Assigned(clickedLayer)                    //
//    and (clickedLayer is THitTestLayer32)           //
//    and not (clickedLayer is TButtonDesignerLayer32) // 不是选中点图层组
//    and (clickedLayer <> targetLayer) then          // 不是选中的目标层
//    SetTargetLayer(clickedLayer);
  Invalidate; // 要求重新绘制
end;

procedure TfrmLayer.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  pt: TPoint;
//  dx, dy: Integer;
//  layer: TLayer32;
//  rec: TRect;
begin
  pt := System.Types.Point(X, Y);

  //=============================
  if UseAppOnIdle then   //这个方法，解决了拖动调整大小时卡顿现象
  begin
    delayedShift := Shift;
    delayedPos := pt;
    delayedMovePending := true;
  end
  else
    DelayedMouseMove(Sender, Shift, pt.X, pt.Y);
  Exit;
  //=====旧的，少量方式========================
//
//  if not (ssLeft in Shift) then    //没有按鼠标左键
//  begin
//    // not moving anything so just update the cursor  不移动任何东西，所以只更新光标
//    layer := layeredImg32.GetLayerAt(pt);
//    if Assigned(layer) then
//      Cursor := layer.CursorId
//    else
//      Cursor := crDefault;
//    Exit;
//  end;
//
//  if not Assigned(clickedLayer) then
//    Exit; //没有点击的对象，退出
//
//  dx := pt.X - clickPoint.X;  //通过点击时的位置，计算偏移量X
//  dy := pt.Y - clickPoint.Y;  //通过点击时的位置，计算偏移量Y
//  clickPoint := pt;           //下次从当前位置再计算
//
//  if clickedLayer is TButtonDesignerLayer32 then
//  begin
//    //  clickedLayer 是四周控制点对象（不改变大小，但要调整位置）
//    clickedLayer.Offset(dx, dy);
//    // now call UpdateSizingButtonGroup to reposition the other buttons   现在调用UpdateSizingButtonGroup来重新定位其他按钮
//    // in the sizing group and get the bounds rect for the target layer   在尺寸组中，并获得目标层的边界rect
//    rec := UpdateSizingButtonGroup(clickedLayer);  //根据按钮组，获取区域大小
//    targetLayer.SetInnerBounds(RectD(rec));    //设置目标对象绑定位置及大小
//  end
//  else if Assigned(targetLayer) then
//  begin   //移动层
//    targetLayer.Offset(dx, dy);
////    if Assigned(buttonGroup) then  //编辑四周的控制点跟随移动
////      buttonGroup.Offset(dx, dy);
//  end;
//  Invalidate;   // 要求重新绘制
end;

procedure TfrmLayer.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  clickedLayer := nil;    //点击对象清空
end;

procedure TfrmLayer.FormPaint(Sender: TObject);
var
  img: TImage32;
  updateRect: TRect;
begin
  // layeredImg32.GetMergedImage optionally returns the portion of    layeredImg32.GetMergedImage可选地返回的部分
  // the image that's changed since the previous GetMergedImage call. 自上次GetMergedImage调用以来更改的图像
  // Painting only this changed region significantly speeds up drawing. 仅绘制此已更改的区域可显著加快绘制速度。
  img := layeredImg32.GetMergedImage(false, updateRect);
  // only update 'updateRect' otherwise repainting can be quite slow  仅更新“updateRect”，否则重新绘制可能会非常缓慢
  if not IsEmptyRect(updateRect) then
  begin
    img.CopyToDc(updateRect, updateRect, Canvas.Handle);
  end;
end;

procedure TfrmLayer.FormResize(Sender: TObject);
begin
  if not Assigned(layeredImg32) then
    Exit;
  layeredImg32.SetSize(ClientWidth, ClientHeight);    //设置对象尺寸
  // and resize and repaint the hatched design background layer
  with TLayer32(layeredImg32[0]) do
  begin
    // nb: use SetSize not Resize which would waste CPU cycles stretching any previous hatching
    //    使用SetSize而不是Resize，这将浪费CPU周期拉伸任何先前的图案填充
    SetSize(layeredImg32.Width, layeredImg32.Height);
    HatchBackground(Image); //重绘制背景层
  end;
  Invalidate;
end;

procedure TfrmLayer.FormShow(Sender: TObject);
begin
  popupPoint := Point(layeredImg32.MidPoint);    //Create时中心点可能为 0,0 ,导致添加对象时显示在左上方
  FormResize(self);                              //要重新设置尺寸
end;

procedure TfrmLayer.OnToolButtonClick(Sender: TObject);
var
  nTag: NativeInt;
  newLayer: TLayer32;
  X, Y: Integer;
  rec: TRect;
  randomWord: string;
  tmp: TPathsD;
  recd: TRectD;
  rasterLayer: TMyRasterLayer32;
var
  displayAngle: double;
  pivot: TPointD;
begin
  if Sender is TComponent then
  begin
    nTag := (Sender as TComponent).Tag;
    case nTag of
      1: {$REGION ' // 添加图片'}
        begin
          if not OpenDialog1.Execute then
            Exit;

          if ckbOther.Checked then
          begin
            newLayer := layeredImg32.AddLayer(TMyRasterLayer32) as TRotLayer32;
            with TMyRasterLayer32(newLayer) do
              Init(OpenDialog1.filename, layeredImg32.MidPoint);
            SetTargetLayer(newLayer);
          end
          else
          begin
            rasterLayer := layeredImg32.AddLayer(TMyRasterLayer32) as TMyRasterLayer32;
            with rasterLayer do
            begin
              MasterImage.LoadFromFile(OpenDialog1.FileName);
              if MasterImage.IsEmpty then
              begin
                Free;
                Exit;
              end;
              Init(layeredImg32.MidPoint);
            end;
            SetTargetLayer(rasterLayer);
          end;
          targetLayer.Invalidate;
          Invalidate;
        end; {$ENDREGION}
      2: {$REGION '// 添加矩形'}
        begin
          if ckbOther.Checked then
          begin
            if Assigned(targetLayer) then
              recd := MakeRandomRect(targetLayer.Image.MidPoint)
            else
              recd := MakeRandomRect(layeredImg32.MidPoint);
            newLayer := layeredImg32.AddLayer(TMyVectorLayer32, targetLayer, 'rectangle') as TMyVectorLayer32;
            newLayer.SetInnerBounds(recd);
            TMyVectorLayer32(newLayer).UpdateHitTestAndClipPath;
            SetTargetLayer(newLayer);
          end
          else
          begin

          // create a semi-random sized object
            X := DpiAware(25 + Random(100));
            Y := DpiAware(25 + Random(100));
            rec := Img32.Vector.Rect(popupPoint.X - X, popupPoint.Y - Y, popupPoint.X + X, popupPoint.Y + Y);

            newLayer := layeredImg32.AddLayer(TMyVectorLayer32);
            with newLayer as TMyVectorLayer32 do
            begin
              OuterMargin := DpiAware(5); // do this before setting paths :)
              Paths := Img32.Vector.Paths(Rectangle(rec));
            end;
            SetTargetLayer(newLayer);
          end;
          targetLayer.Invalidate;
          Invalidate;
        end; {$ENDREGION}
      3: {$REGION '// 添加椭圆'}
        begin
          if ckbOther.Checked then
          begin
            if Assigned(targetLayer) then
              recd := MakeRandomRect(targetLayer.Image.MidPoint)
            else
              recd := MakeRandomRect(layeredImg32.MidPoint);
            newLayer := layeredImg32.AddLayer(TMyVectorLayer32, targetLayer, 'ellipse') as TMyVectorLayer32;
            // setting a path will automatically define the layer's bounds
            TMyVectorLayer32(newLayer).Paths := Paths(MakeEllipse(Rect(recd)));
            TMyVectorLayer32(newLayer).UpdateHitTestAndClipPath;
            SetTargetLayer(newLayer);
          end
          else
          begin
            // create a semi-random sized object
            X := DpiAware(25 + Random(100));
            Y := DpiAware(25 + Random(100));
            rec := Img32.Vector.Rect(popupPoint.X - X, popupPoint.Y - Y, popupPoint.X + X, popupPoint.Y + Y);
            // create the new layer
            newLayer := TMyVectorLayer32(layeredImg32.AddLayer(TMyVectorLayer32));
            with newLayer as TMyVectorLayer32 do
            begin
              OuterMargin := DpiAware(5); // do this before setting paths :)
              Paths := Img32.Vector.Paths(Ellipse(rec));
            end;
            SetTargetLayer(newLayer);
          end;
          targetLayer.Invalidate;
          Invalidate;
        end; {$ENDREGION}
      4: {$REGION '// 添加随机文本'}
        begin
          if ckbOther.Checked then  //2种方法添加
          begin
            newLayer := layeredImg32.AddLayer(TMyTextLayer32);
            with TMyTextLayer32(newLayer) do
              Init(wordStrings[Random(wordStrings.Count)], layeredImg32.MidPoint, fontCache);
            SetTargetLayer(newLayer);
          end
          else
          begin
            randomWord := wordStrings[Random(wordStrings.Count)];
            tmp := fontCache.GetTextOutline(0, 0, randomWord);
            tmp := ScalePath(tmp, 1, 2.0);
            recd := Img32.Vector.GetBoundsD(tmp);
            with popupPoint do
              tmp := TranslatePath(tmp, X - recd.Left - recd.Width / 2, Y - recd.Top - recd.Height / 2);

            newLayer := layeredImg32.AddLayer(TMyVectorLayer32);  //TMyVectorLayer32 自定义矢量类，有随机颜色
            with newLayer as TMyVectorLayer32 do
            begin
              OuterMargin := DpiAware(5); // do this before setting paths :)
              Paths := tmp;
            end;
            SetTargetLayer(newLayer);
          end;
        end; {$ENDREGION}
      5: {$REGION '//添加文本'}
        begin
          randomWord := '';
          if InputQuery('录入文本', '请录入文本内容:', randomWord) then
          begin
            tmp := fontCacheCN.GetTextOutline(0, 0, randomWord);
            tmp := ScalePath(tmp, 1, 2.0);
            recd := Img32.Vector.GetBoundsD(tmp);
            with popupPoint do
              tmp := TranslatePath(tmp, X - recd.Left - recd.Width / 2, Y - recd.Top - recd.Height / 2);

            newLayer := layeredImg32.AddLayer(TMyVectorLayer32);
            with newLayer as TMyVectorLayer32 do    //TMyVectorLayer32 自定义矢量类，有随机颜色
            begin
              OuterMargin := DpiAware(5); // do this before setting paths :)
              Paths := tmp;
            end;
            SetTargetLayer(newLayer);
          end;
        end; {$ENDREGION}
      6: {$REGION '//添加箭头'}
        begin
          newLayer := layeredImg32.AddLayer(TMyArrowLayer32, nil, 'arrow');
          with TMyArrowLayer32(newLayer) do
            Init(layeredImg32.MidPoint);
          SetTargetLayer(newLayer);
        end; {$ENDREGION}
      7: {$REGION '//添加星形'}
        begin
          if Assigned(targetLayer) then
            recd := MakeRandomSquare(targetLayer.Image.MidPoint)
          else
            recd := MakeRandomSquare(layeredImg32.MidPoint);
          newLayer := layeredImg32.AddLayer(TMyStarLayer32, targetLayer, 'star') as TMyVectorLayer32;
            // setting a path will automatically define the layer's bounds
          TMyStarLayer32(newLayer).Paths := Paths(MakeStar(recd));
          TMyStarLayer32(newLayer).UpdateHitTestAndClipPath;
          SetTargetLayer(newLayer);
          targetLayer.Invalidate;
          Invalidate;
        end; {$ENDREGION}
      101: // 删除
        begin
          if not Assigned(targetLayer) then
            Exit;
          FreeAndNil(targetLayer);
          DeleteAllControlButtons;
          clickedLayer := nil;
          Invalidate;
        end;
      102: // 剪切
        begin
          if Assigned(targetLayer) then
          begin
            targetLayer.Image.CopyToClipBoard;
            FreeAndNil(targetLayer);
            DeleteAllControlButtons;
            Invalidate;
          end;
        end;
      103: // 复制
        begin
          if Assigned(targetLayer) then
            targetLayer.Image.CopyToClipBoard;
        end;
      104: // 粘贴
        begin
          if not TImage32.CanPasteFromClipBoard then
            Exit;
          DeleteAllControlButtons;
          rasterLayer := layeredImg32.AddLayer(TMyRasterLayer32) as TMyRasterLayer32;
          with rasterLayer do
          begin
            MasterImage.PasteFromClipBoard;
            if MasterImage.IsEmpty then
            begin
              Free;
              Exit;
            end;
            Init(layeredImg32.MidPoint);
          end;
          SetTargetLayer(rasterLayer);
          Invalidate;
        end;
      105: //克隆
        begin
          if not Assigned(targetLayer) then
            Exit;
          DeleteAllControlButtons;
          if targetLayer is TMyRasterLayer32 then
            TMyRasterLayer32(targetLayer).Clone
          else if targetLayer is TMyVectorLayer32 then
            TMyVectorLayer32(targetLayer).Clone;
          Invalidate;
        end;
      106: //旋转
        begin
          if not Assigned(targetLayer) then
            Exit;
          clickedLayer := nil;

          if Assigned(rotatingButtonGroup) then
          begin      // toggle off rotating buttons and toggle on sizing or control buttons
            DeleteAllControlButtons;
            if (targetLayer is TMyArrowLayer32) then
              arrowButtonGroup := CreateButtonGroup(layeredImg32.Root, TMyArrowLayer32(targetLayer).Paths[0], bsRound, DefaultButtonSize, clGreen32)
            else
              sizingButtonGroup := CreateSizingButtonGroup(targetLayer, ssCorners, bsRound, DefaultButtonSize, clRed32);
          end
          else
          begin      // toggle on the rotating button using the previous rotation angle
            DeleteAllControlButtons;

            pivot := targetLayer.MidPoint;

            with TRotLayer32(targetLayer) do
            begin
              if not AutoPivot then
                PivotPt := pivot;
              displayAngle := Angle;
            end;
            rotatingButtonGroup := CreateRotatingButtonGroup(targetLayer, pivot, DPIAware(10), clWhite32, clLime32, displayAngle, -Angle90);
            rotatingButtonGroup.AngleButton.CursorId := crRotate;
          end;
          Invalidate;
        end;
      201: // 前置
        begin
          if not Assigned(targetLayer) then
            Exit;

          // don't send above the (top-most) sizing button group
          if targetLayer.Index = targetLayer.Parent.ChildCount - 2 then
            Exit;

          if targetLayer.BringForwardOne then
            Invalidate;
        end;
      202: // 后置
        begin
          // don't send below the (bottom-most) hatched background.
          if targetLayer.Index = 1 then
            Exit;

          if targetLayer.SendBackOne then
            Invalidate;
        end;
    end;
  end;
end;

procedure TfrmLayer.PopupMenu1Popup(Sender: TObject);
begin   //右键快捷菜单点击
  mnuBringToFront.Enabled := Assigned(targetLayer) and (targetLayer.Index < layeredImg32.Root.ChildCount - 2);
  mnuSendToBack.Enabled := Assigned(targetLayer) and (targetLayer.Index > 1);
  mnuDeleteLayer.Enabled := Assigned(targetLayer);

  if Sender = PopupMenu1 then
  begin
    GetCursorPos(popupPoint);
    popupPoint := ScreenToClient(popupPoint);
  end
  else
    popupPoint := Point(layeredImg32.MidPoint);
end;

procedure TfrmLayer.SetTargetLayer(layer: TLayer32);
begin
  //设置目标对象
  DeleteAllControlButtons; //如果有，释放之前的四周控件点
  if targetLayer = layer then
    Exit;
  targetLayer := layer;
  clickedLayer := nil;
//  if not Assigned(targetLayer) then
//    Exit;
  // add sizing buttons around the target layer  //添加层四周控制点
  if layer is TMyArrowLayer32 then
  begin
    with TMyArrowLayer32(layer) do
      arrowButtonGroup := CreateButtonGroup(layeredImg32.Root, Paths[0], bsRound, DefaultButtonSize, clGreen32);
  end
  else
//    buttonGroup := CreateSizingButtonGroup(layer, ssCorners, bsRound, DpiAware(10), clGreen32);
    sizingButtonGroup := CreateSizingButtonGroup(layer, ssCorners, bsRound, DefaultButtonSize, clRed32);
  Invalidate;
end;

procedure TfrmLayer.WMERASEBKGND(var message: TMessage);
begin
  // don't erase because we're only doing partial paints (see FormPaint below)
  message.Result := 1;
end;

end.

欢迎微信搜一搜 IT软件部落 关注公众号，你可以了解更详细的内容

欢儿微信扫码关注 IT软件部落 公众号，你可以了解更详细的内容