Delphi Graphics32 相对鼠标位置(到图层)
Delphi Graphics32 relative mouse position (to the layer)
我有一个 ImgView32,它固定在所有表单边距上。表格已最大化。
ImgView的位图不固定(可以有不同的大小)
我正在尝试使用来自这个问题的代码在透明层上画一条线:
现在的问题是,使用那个确切的代码,我只能在左上角绘制,如下图所示:
如您所见,只能在左上角绘制线条。
如果我尝试为起点和终点添加一些值,整个事情就会变得疯狂。所以我必须找到一种方法来翻译点,这样用户就只能在中心矩形的内部绘制(在图像中可见)
我没主意了。
请帮忙
这是整个单元:
unit MainU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,GR32, GR32_Image, GR32_Layers, GR32_Backends, GR32_PNG, StdCtrls,
ExtCtrls;
type
TForm5 = class(TForm)
ImgView: TImgView32;
Button1: TButton;
Memo: TMemo;
Edit3: TEdit;
Button2: TButton;
RadioGroup1: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
StageNum: Cardinal);
procedure ImgViewResize(Sender: TObject);
private
{ Private declarations }
FStartPoint, FEndPoint: TPoint;
FDrawingLine: boolean;
bm32: TBitmap32;
BL : TBitmapLayer;
FSelection: TPositionedLayer;
public
{ Public declarations }
procedure AddLineToLayer;
procedure AddCircleToLayer;
procedure SwapBuffers32;
procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure LayerMouseUp(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure LayerMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
procedure LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
procedure SetSelection(Value: TPositionedLayer);
property Selection: TPositionedLayer read FSelection write SetSelection;
Procedure SelectGraficLayer(idu:string);
procedure AddTransparentPNGlayer;
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
var
imwidth: integer;
imheight: integer;
OffsX, OffsY: Integer;
const
penwidth = 3;
pencolor = clBlue; // Needs to be a VCL color!
procedure TForm5.AddLineToLayer;
begin
bm32.Canvas.Pen.Color := pencolor;
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
procedure TForm5.FormCreate(Sender: TObject);
var
P: TPoint;
W, H: Single;
begin
imwidth := Form5.ImgView.Width;
imheight := Form5.ImgView.Height;
with ImgView.PaintStages[0]^ do
begin
if Stage = PST_CLEAR_BACKGND then Stage := PST_CUSTOM;
end;
bm32 := TBitmap32.Create;
bm32.DrawMode := dmTransparent;
bm32.SetSize(imwidth,imheight);
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.Pen.Color := pencolor;
with ImgView do
begin
Selection := nil;
Layers.Clear;
Scale := 1;
Scaled := True;
Bitmap.DrawMode := dmTransparent;
Bitmap.SetSize(imwidth, imheight);
Bitmap.Canvas.Pen.Width := 4;//penwidth;
Bitmap.Canvas.Pen.Color := clBlue;
Bitmap.Canvas.FrameRect(Rect(20, 20, imwidth-20, imheight-20));
Bitmap.Canvas.TextOut(15, 32, 'ImgView');
end;
AddTransparentPNGLayer;
BL := TBitmapLayer.Create(ImgView.Layers);
try
BL.Bitmap.DrawMode := dmTransparent;
BL.Bitmap.SetSize(imwidth,imheight);
BL.Bitmap.Canvas.Pen.Width := penwidth;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Location := GR32.FloatRect(0, 0, imwidth, imheight);
BL.Scaled := False;
BL.OnMouseDown := LayerMouseDown;
BL.OnMouseUp := LayerMouseUp;
BL.OnMouseMove := LayerMouseMove;
BL.OnPaint := LayerOnPaint;
except
Edit3.Text:=IntToStr(BL.Index);
BL.Free;
raise;
end;
FDrawingLine := false;
SwapBuffers32;
end;
procedure TForm5.FormDestroy(Sender: TObject);
begin
bm32.Free;
BL.Free;
end;
procedure TForm5.ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
StageNum: Cardinal);
const //0..1
Colors: array [Boolean] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
var
R: TRect;
I, J: Integer;
OddY: Integer;
TilesHorz, TilesVert: Integer;
TileX, TileY: Integer;
TileHeight, TileWidth: Integer;
begin
TileHeight := 13;
TileWidth := 13;
TilesHorz := Buffer.Width div TileWidth;
TilesVert := Buffer.Height div TileHeight;
TileY := 0;
for J := 0 to TilesVert do
begin
TileX := 0;
OddY := J and ;
for I := 0 to TilesHorz do
begin
R.Left := TileX;
R.Top := TileY;
R.Right := TileX + TileWidth;
R.Bottom := TileY + TileHeight;
Buffer.FillRectS(R, Colors[I and = OddY]);
Inc(TileX, TileWidth);
end;
Inc(TileY, TileHeight);
end;
end;
procedure TForm5.ImgViewResize(Sender: TObject);
begin
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
procedure TForm5.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X-OffsX, Y-OffsY);
FDrawingLine := true;
end;
procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X-OffsX, FStartPoint.Y-OffsY);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end;
end;
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end;
procedure TForm5.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
SwapBuffers32;
end;
procedure TForm5.SetSelection(Value: TPositionedLayer);
begin
if Value <> FSelection then
begin
FSelection := Value;
end;
end;
procedure TForm5.SwapBuffers32;
begin
TransparentBlt(
BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;
procedure TForm5.AddTransparentPNGlayer;
var
mypng:TPortableNetworkGraphic32;
B : TBitmapLayer;
P: TPoint;
W, H: Single;
begin
try
mypng := TPortableNetworkGraphic32.Create;
mypng.LoadFromFile('C:\Location\Of\ATransparentPNGFile.png');
B := TBitmapLayer.Create(ImgView.Layers);
with B do
try
mypng.AssignTo(B.Bitmap);
Bitmap.DrawMode := dmBlend;
with ImgView.GetViewportRect do
P := ImgView.ControlToBitmap(GR32.Point((Right + Left) div 2, (Top + Bottom) div 2));
W := Bitmap.Width * 0.5;
H := Bitmap.Height * 0.5;
Location := GR32.FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);
Scaled := True;
OnMouseDown := LayerMouseDown;
except
Free;
raise;
end;
Selection := B;
Edit3.Text:=IntToStr(B.Index);
finally
mypng.Free;
end;
end;
end.
我做错了什么?请测试上面的单元以了解我的意思。请记住添加一个 ImgView 并将其锚定到所有边距,然后在运行时最大化表单并尝试绘制线条...
编辑
上面绿色的图中,中间有一个矩形,更像是一个正方形(不是很明显),但仔细看还是可以看到的。
由于我的问题可能会被误解,请看下图
我只需要能够在 ImgView 中间的白色矩形(位图)中绘图。不知道怎么解释比较好。
让 rectangle/Bitmap 完全适合 ImgView 对我来说不是解决方案,因为那不是我项目的重点。
看看 Paint.net 并想象一下我的项目也做同样的事情(只是没那么复杂)。但原理是一样的:当你开始一个新项目时,你决定你的 document/image 的大小,然后你添加不同的图像作为图层,缩放和旋转它们,现在我想让用户画线特殊层(绘图层)内部
但是一切都发生在该文档大小的范围内。例如在上图中,文档的大小为 A5 (100dpi),缩放比例为 83%。
所以我的问题是我不能让用户在白色矩形(屏幕中间)之外绘制线条。所以他们的线路可以从这些边界开始并在那里结束。
我知道我的测试单元不是很干净。我粘贴了主项目中使用的一些功能,并迅速从中删除了一些与本示例无关的部分。 AddTransparentPng 过程仅允许测试将透明图像添加到 ImgView,这样我就可以测试绘图层是否未覆盖另一个可能的图层。
(Scaled 属性 属于层 (B) 它在 'with B' 语句下。我删除了 With 'ImgView.Bitmap... Location' 语句所以它不会再打扰你了:) )
总之,不影响画线的代码请不要关注。该代码是需要注意的。
编辑
如果我将图层的缩放设置为 true (Scaled:=true) 那么它会把所有东西都弄乱,如下图所示:
我仍然必须使用偏移量,但有点不同
谢谢
好的,我解决了。这是最终(相关)代码:
procedure TForm5.ImgViewResize(Sender: TObject);
begin
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
procedure TForm5.SwapBuffers32;
begin
TransparentBlt(
BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;
procedure TForm5.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X-OffsX, Y-OffsY);
FDrawingLine := true;
end;
procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end;
end;
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end;
procedure TForm5.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
SwapBuffers32;
end;
procedure TForm5.AddLineToLayer;
begin
bm32.Canvas.Pen.Color := pencolor;
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
使用此代码,一切都按预期进行。画线只能发生在边界内
谢谢
错误一
在 LayerMouseMove() 中,您从 BL.Bitmap.Canvas.MoveTo() 中的 FStartPoint 中减去 OffsX 和 OffsY。 FStartPoint 已在 LayerMouseDown() 中调整。我告诉过你 "In the three Mouse procs adjust the X and Y arguments only to become X-OffsX and Y-OffsY." 注意 arguments only
这里的 LayerMouseMove() 更正:
procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
BL.Bitmap.Canvas.Pen.Color := pencolor;
// BL.Bitmap.Canvas.MoveTo(FStartPoint.X-OffsX, FStartPoint.Y-OffsY);
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end;
end;
错误二
我还告诉过您将 if FDrawingLine then ...
条件添加到 LayerMouseUp() 以避免当鼠标按下发生在层外但鼠标松开发生在层内时出现伪线。更正后的 LayerMouseUp():
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end;
end;
错误三
发布的代码与您的第一张图片显示的不一样。该图像看起来像您在 ImgViewResize() 中对 BL.Location := ...
行的注释。可能你这样做是因为 Error one
。无论如何,使用如下 ImgViewResize 和上面的其他更正我得到如下图所示的结果。
procedure TForm5.ImgViewResize(Sender: TObject);
begin
// centering the drawing area
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
变量imwidth
和imheight
定义绘图区域的大小。如果更改这些,则需要重新计算 OffsX
和 OffsY
,并且还需要调整后备缓冲区的大小 bm32
。
角上的线条表示 window 中间的绘图区域(由 imwidth 和 imheight 定义)的范围。当 window 最大化时它也保持不变。
我有一个 ImgView32,它固定在所有表单边距上。表格已最大化。
ImgView的位图不固定(可以有不同的大小)
我正在尝试使用来自这个问题的代码在透明层上画一条线:
现在的问题是,使用那个确切的代码,我只能在左上角绘制,如下图所示:
如您所见,只能在左上角绘制线条。 如果我尝试为起点和终点添加一些值,整个事情就会变得疯狂。所以我必须找到一种方法来翻译点,这样用户就只能在中心矩形的内部绘制(在图像中可见)
我没主意了。
请帮忙
这是整个单元:
unit MainU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,GR32, GR32_Image, GR32_Layers, GR32_Backends, GR32_PNG, StdCtrls,
ExtCtrls;
type
TForm5 = class(TForm)
ImgView: TImgView32;
Button1: TButton;
Memo: TMemo;
Edit3: TEdit;
Button2: TButton;
RadioGroup1: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
StageNum: Cardinal);
procedure ImgViewResize(Sender: TObject);
private
{ Private declarations }
FStartPoint, FEndPoint: TPoint;
FDrawingLine: boolean;
bm32: TBitmap32;
BL : TBitmapLayer;
FSelection: TPositionedLayer;
public
{ Public declarations }
procedure AddLineToLayer;
procedure AddCircleToLayer;
procedure SwapBuffers32;
procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure LayerMouseUp(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure LayerMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
procedure LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
procedure SetSelection(Value: TPositionedLayer);
property Selection: TPositionedLayer read FSelection write SetSelection;
Procedure SelectGraficLayer(idu:string);
procedure AddTransparentPNGlayer;
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
var
imwidth: integer;
imheight: integer;
OffsX, OffsY: Integer;
const
penwidth = 3;
pencolor = clBlue; // Needs to be a VCL color!
procedure TForm5.AddLineToLayer;
begin
bm32.Canvas.Pen.Color := pencolor;
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
procedure TForm5.FormCreate(Sender: TObject);
var
P: TPoint;
W, H: Single;
begin
imwidth := Form5.ImgView.Width;
imheight := Form5.ImgView.Height;
with ImgView.PaintStages[0]^ do
begin
if Stage = PST_CLEAR_BACKGND then Stage := PST_CUSTOM;
end;
bm32 := TBitmap32.Create;
bm32.DrawMode := dmTransparent;
bm32.SetSize(imwidth,imheight);
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.Pen.Color := pencolor;
with ImgView do
begin
Selection := nil;
Layers.Clear;
Scale := 1;
Scaled := True;
Bitmap.DrawMode := dmTransparent;
Bitmap.SetSize(imwidth, imheight);
Bitmap.Canvas.Pen.Width := 4;//penwidth;
Bitmap.Canvas.Pen.Color := clBlue;
Bitmap.Canvas.FrameRect(Rect(20, 20, imwidth-20, imheight-20));
Bitmap.Canvas.TextOut(15, 32, 'ImgView');
end;
AddTransparentPNGLayer;
BL := TBitmapLayer.Create(ImgView.Layers);
try
BL.Bitmap.DrawMode := dmTransparent;
BL.Bitmap.SetSize(imwidth,imheight);
BL.Bitmap.Canvas.Pen.Width := penwidth;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Location := GR32.FloatRect(0, 0, imwidth, imheight);
BL.Scaled := False;
BL.OnMouseDown := LayerMouseDown;
BL.OnMouseUp := LayerMouseUp;
BL.OnMouseMove := LayerMouseMove;
BL.OnPaint := LayerOnPaint;
except
Edit3.Text:=IntToStr(BL.Index);
BL.Free;
raise;
end;
FDrawingLine := false;
SwapBuffers32;
end;
procedure TForm5.FormDestroy(Sender: TObject);
begin
bm32.Free;
BL.Free;
end;
procedure TForm5.ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
StageNum: Cardinal);
const //0..1
Colors: array [Boolean] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
var
R: TRect;
I, J: Integer;
OddY: Integer;
TilesHorz, TilesVert: Integer;
TileX, TileY: Integer;
TileHeight, TileWidth: Integer;
begin
TileHeight := 13;
TileWidth := 13;
TilesHorz := Buffer.Width div TileWidth;
TilesVert := Buffer.Height div TileHeight;
TileY := 0;
for J := 0 to TilesVert do
begin
TileX := 0;
OddY := J and ;
for I := 0 to TilesHorz do
begin
R.Left := TileX;
R.Top := TileY;
R.Right := TileX + TileWidth;
R.Bottom := TileY + TileHeight;
Buffer.FillRectS(R, Colors[I and = OddY]);
Inc(TileX, TileWidth);
end;
Inc(TileY, TileHeight);
end;
end;
procedure TForm5.ImgViewResize(Sender: TObject);
begin
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
procedure TForm5.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X-OffsX, Y-OffsY);
FDrawingLine := true;
end;
procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X-OffsX, FStartPoint.Y-OffsY);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end;
end;
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end;
procedure TForm5.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
SwapBuffers32;
end;
procedure TForm5.SetSelection(Value: TPositionedLayer);
begin
if Value <> FSelection then
begin
FSelection := Value;
end;
end;
procedure TForm5.SwapBuffers32;
begin
TransparentBlt(
BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;
procedure TForm5.AddTransparentPNGlayer;
var
mypng:TPortableNetworkGraphic32;
B : TBitmapLayer;
P: TPoint;
W, H: Single;
begin
try
mypng := TPortableNetworkGraphic32.Create;
mypng.LoadFromFile('C:\Location\Of\ATransparentPNGFile.png');
B := TBitmapLayer.Create(ImgView.Layers);
with B do
try
mypng.AssignTo(B.Bitmap);
Bitmap.DrawMode := dmBlend;
with ImgView.GetViewportRect do
P := ImgView.ControlToBitmap(GR32.Point((Right + Left) div 2, (Top + Bottom) div 2));
W := Bitmap.Width * 0.5;
H := Bitmap.Height * 0.5;
Location := GR32.FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);
Scaled := True;
OnMouseDown := LayerMouseDown;
except
Free;
raise;
end;
Selection := B;
Edit3.Text:=IntToStr(B.Index);
finally
mypng.Free;
end;
end;
end.
我做错了什么?请测试上面的单元以了解我的意思。请记住添加一个 ImgView 并将其锚定到所有边距,然后在运行时最大化表单并尝试绘制线条...
编辑
上面绿色的图中,中间有一个矩形,更像是一个正方形(不是很明显),但仔细看还是可以看到的。
由于我的问题可能会被误解,请看下图
我只需要能够在 ImgView 中间的白色矩形(位图)中绘图。不知道怎么解释比较好。
让 rectangle/Bitmap 完全适合 ImgView 对我来说不是解决方案,因为那不是我项目的重点。
看看 Paint.net 并想象一下我的项目也做同样的事情(只是没那么复杂)。但原理是一样的:当你开始一个新项目时,你决定你的 document/image 的大小,然后你添加不同的图像作为图层,缩放和旋转它们,现在我想让用户画线特殊层(绘图层)内部 但是一切都发生在该文档大小的范围内。例如在上图中,文档的大小为 A5 (100dpi),缩放比例为 83%。
所以我的问题是我不能让用户在白色矩形(屏幕中间)之外绘制线条。所以他们的线路可以从这些边界开始并在那里结束。
我知道我的测试单元不是很干净。我粘贴了主项目中使用的一些功能,并迅速从中删除了一些与本示例无关的部分。 AddTransparentPng 过程仅允许测试将透明图像添加到 ImgView,这样我就可以测试绘图层是否未覆盖另一个可能的图层。
(Scaled 属性 属于层 (B) 它在 'with B' 语句下。我删除了 With 'ImgView.Bitmap... Location' 语句所以它不会再打扰你了:) )
总之,不影响画线的代码请不要关注。该代码是需要注意的。
编辑
如果我将图层的缩放设置为 true (Scaled:=true) 那么它会把所有东西都弄乱,如下图所示:
我仍然必须使用偏移量,但有点不同
谢谢
好的,我解决了。这是最终(相关)代码:
procedure TForm5.ImgViewResize(Sender: TObject);
begin
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
procedure TForm5.SwapBuffers32;
begin
TransparentBlt(
BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;
procedure TForm5.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X-OffsX, Y-OffsY);
FDrawingLine := true;
end;
procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end;
end;
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end;
procedure TForm5.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
SwapBuffers32;
end;
procedure TForm5.AddLineToLayer;
begin
bm32.Canvas.Pen.Color := pencolor;
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
使用此代码,一切都按预期进行。画线只能发生在边界内
谢谢
错误一
在 LayerMouseMove() 中,您从 BL.Bitmap.Canvas.MoveTo() 中的 FStartPoint 中减去 OffsX 和 OffsY。 FStartPoint 已在 LayerMouseDown() 中调整。我告诉过你 "In the three Mouse procs adjust the X and Y arguments only to become X-OffsX and Y-OffsY." 注意 arguments only
这里的 LayerMouseMove() 更正:
procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
BL.Bitmap.Canvas.Pen.Color := pencolor;
// BL.Bitmap.Canvas.MoveTo(FStartPoint.X-OffsX, FStartPoint.Y-OffsY);
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end;
end;
错误二
我还告诉过您将 if FDrawingLine then ...
条件添加到 LayerMouseUp() 以避免当鼠标按下发生在层外但鼠标松开发生在层内时出现伪线。更正后的 LayerMouseUp():
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end;
end;
错误三
发布的代码与您的第一张图片显示的不一样。该图像看起来像您在 ImgViewResize() 中对 BL.Location := ...
行的注释。可能你这样做是因为 Error one
。无论如何,使用如下 ImgViewResize 和上面的其他更正我得到如下图所示的结果。
procedure TForm5.ImgViewResize(Sender: TObject);
begin
// centering the drawing area
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
变量imwidth
和imheight
定义绘图区域的大小。如果更改这些,则需要重新计算 OffsX
和 OffsY
,并且还需要调整后备缓冲区的大小 bm32
。
角上的线条表示 window 中间的绘图区域(由 imwidth 和 imheight 定义)的范围。当 window 最大化时它也保持不变。