图形图层处理是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.
标签：begin,end,Sender,图形处理,delphi,targetLayer,procedure,图层,layeredImg32 From： https://www.cnblogs.com/bluejade/p/18246836