Delphi Graphics32相对鼠标位置（到图层） [英] Delphi Graphics32 relative mouse position (to the layer)

问题描述

我有一个ImgView32，它固定在所有的窗体边距上。表单最大化。

ImgView的位图不是固定的（可以是不同的大小）

我试图在透明层上画一条线，使用这个问题的其他代码：绘制线在层上

现在的问题是，使用这个确切的代码，我只能绘制在左上角，就像在这个图像中：

您可以观察到，线条只能在左上角绘制。
如果我尝试为开始和结束点添加一些值，整个事情变得疯狂。所以我必须找到一种方式，以这样一种方式来翻译点数，用户只能在图像中看到中心图像​​。

我没有想法。

请帮助

以下是整个单位：

Main $; $ $ $ $ $

接口

使用
Windows，消息，SysUtils，变体，类，图形，控件，窗体，
对话框，GR32，GR32_Image，GR32_Layers， GR32_Backends，GR32_PNG，StdCtrls，
ExtCtrls;

type
TForm5 = class（TForm）
ImgView：TImgView32;
Button1：TButton;
备注：TMemo;
Edit3：TEdit;
Button2：TButton;
RadioGroup1：TRadioGroup;
procedure FormCreate（Sender：TObject）;
procedure FormDestroy（Sender：TObject）;
procedure Button1Click（Sender：TObject）;
程序Button2Click（发件人：TObject）;
程序ImgViewPaintStage（发件人：TObject;缓冲区：TBitmap32;
StageNum：Cardinal）;
程序ImgViewResize（Sender：TObject）;
private
{私有声明}
FStartPoint，FEndPoint：TPoint;
FDrawingLine：boolean;
bm32：TBitmap32;
BL：TBitmapLayer;
FSelection：TPositionedLayer;
public
{公开声明}
程序AddLineToLayer;
程序AddCircleToLayer;
程序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）;
属性选择：TPositionedLayer读取FSelection写SetSelection;

过程SelectGraficLayer（idu：string）;
procedure AddTransparentPNGlayer;

end;

var
Form5：TForm5;

实现

{$ R * .dfm}

var
imwidth：integer;
imheight：integer;
OffsX，OffsY：Integer;

const
penwidth = 3;
pencolor = clBlue; //需要成为VCL颜色！

程序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）;
结束

procedure TForm5.FormCreate（Sender：TObject）;
var
P：TPoint;
W，H：单;
begin
imwidth：= Form5.ImgView.Width;
imheight：= Form5.ImgView.Height;

与ImgView.PaintStages [0] ^ do
begin
如果Stage = PST_CLEAR_BACKGND，则Stage：= PST_CUSTOM;
结束

bm32：= TBitmap32.Create;
bm32.DrawMode：= dmTransparent;
bm32.SetSize（imwidth，imheight）
bm32.Canvas.Pen.Width：= penwidth;
bm32.Canvas.Pen.Color：= pencolor;

with ImgView do
begin
选择：= nil;
Layers.Clear;
比例：= 1;
缩放：= 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'）;
结束

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;
除了
Edit3.Text：= IntToStr（BL.Index）;
BL.Free;
加注
结束

FDrawingLine：= false;
SwapBuffers32;
结束

procedure TForm5.FormDestroy（Sender：TObject）;
begin
bm32.Free;
BL.Free;
结束

程序TForm5.ImgViewPaintStage（发件人：TObject;缓冲区：TBitmap32;
StageNum：Cardinal）;
const //0..1
颜色：数组[布尔值] TColor32 =（$ FFFFFFFF，$ FFB0B0B0）;
var
R：TRect;
I，J：整数;
OddY：整数;
TilesHorz，TilesVert：Integer;
TileX，TileY：Integer;
TileHeight，TileWidth：Integer;
begin
TileHeight：= 13;
TileWidth：= 13;

TilesHorz：= Buffer.Width div TileWidth;
TilesVert：= Buffer.Height div TileHeight;
平铺：= 0;

for J：= 0 to TilesVert do
begin
TileX：= 0;
OddY：= J和$ 1;
为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 $ 1 = OddY]）;
Inc（TileX，TileWidth）;
结束
Inc（TileY，TileHeight）;
结束
结束

程序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）;
结束

procedure TForm5.LayerMouseDown（Sender：TObject; Buttons：TMouseButton;
Shift：TShiftState; X，Y：Integer）;
begin
FStartPoint：= Point（X-OffsX，Y-OffsY）;
FDrawingLine：= true;
结束

procedure TForm5.LayerMouseMove（Sender：TObject; Shift：TShiftState; X，Y：Integer）;
开始
如果FDrawingLine然后
开始
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）;
结束
结束

procedure TForm5.LayerMouseUp（Sender：TObject; Buttons：TMouseButton;
Shift：TShiftState; X，Y：Integer）;
begin
FDrawingLine：= false;
FEndPoint：=点（X-OffsX，Y-OffsY）;
AddLineToLayer;
SwapBuffers32;
结束

procedure TForm5.LayerOnPaint（Sender：TObject; Buffer：TBitmap32）;
begin
SwapBuffers32;
结束

程序TForm5.SetSelection（Value：TPositionedLayer）;
begin
如果Value<> FSelection然后
begin
FSelection：= Value;
结束
结束

程序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）;
结束

程序TForm5.AddTransparentPNGlayer;
var
mypng：TPortableNetworkGraphic32;
B：TBitmapLayer;
P：TPoint;
W，H：单;
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;
位置：= GR32.FloatRect（P.X-W，P.Y-H，P.X + W，P.Y + H）;
缩放：= True;
OnMouseDown：= LayerMouseDown;
除了
免费;
加注
结束
选择：= B;
Edit3.Text：= IntToStr（B.Index）;
finally
mypng.Free;
结束
结束

结束。

我做错了什么？请测试上面的单位，看看我的意思。记住添加一个ImgView并将其锚定到所有边距，然后在运行时，最大化窗体并尝试绘制线条。

编辑

在上面的绿色图像中，有一个正方形，更像是正中间的正方形（不是很明显），但如果仔细观察，您可以看到它

由于我的问题可能被误解，请查看以下图片

我只需要在ImgView中间的白色矩形（Bitmap）中绘制。我不知道如何更好地解释。

我不是一个解决方案，使矩形/位图完全符合ImgView，因为这不是我的观点项目。

看看Paint.net，并想象我的项目类型是一样的（除非是那么复杂）。但是原理是一样的：当你开始一个新的项目时你决定你的文档/图像的大小，然后添加不同的图像作为图层，你缩放和旋转它们，现在我想允许用户在一个特殊的层（绘图层）
但是一切都发生在文档大小的边界内。像上面的图像一样，文档的尺寸为A5（100dpi），缩放83％。

所以我的问题是我不能允许用户在白色矩形外面绘制线条（屏幕中间）。所以他们的线条可以从那些边界开始，并在那里结束。

我知道我的测试单位不是很干净。我粘贴了主要项目中使用的一些功能，并迅速从其中删除了与此示例无关的部分。 AddTransparentPng过程只允许测试向ImgView添加透明图像，以便我可以测试绘图层是否不覆盖另一个可能的拉线器。

（Scaled属性属于图层（B），它使用'with B'语句，我删除了With'ImgView.Bitmap ... Location'语句它不会打扰你了:) :)

无论如何，请不要注意不影响线条绘制的代码。这个代码是需要注意的。

编辑
如果我将图层的缩放设置为true（Scaled：= true）混乱一切，如下图所示：

我还需要使用偏移量，但有一点不同

谢谢

解决方案

错误一个

在LayerMouseMove（）中，您可以从BLBitmap中的FStartPoint中减去OffsX和OffsY .Canvas.MoveTo（）。 FStartPoint已经在LayerMouseDown（）中进行了调整。我告诉你：在三个鼠标进程中，只能将X和Y参数调整为X-OffsX和Y-OffsY。注意只有参数这里是LayerMouseMove（）更正：

 程序TForm5.LayerMouseMove （发件人：TObject; Shift：TShiftState; X，
 Y：整数）; 
开始
如果FDrawingLine然后
开始
 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）; 
结束
结束
  

错误二

我也告诉你，如果FDrawingLine然后... 条件到LayerMouseUp（），以避免杂散行，当鼠标在图层之外，但是鼠标向上时，你添加发生在里面修正的LayerMouseUp（）：

 程序TForm5.LayerMouseUp（发件人：TObject;按钮：TMouseButton; 
 Shift：TShiftState ; X，Y：整数）; 
开始
如果FDrawingLine然后
开始
 FDrawingLine：= false; 
 FEndPoint：=点（X-OffsX，Y-OffsY）; 
 AddLineToLayer; 
 SwapBuffers32; 
结束
结束
  

错误三

发布的代码不会像您的第一个图像显示。图像看起来像您将在ImgViewResize（）中留下 BL.Location：= ... 的行。可能你是这样做的，因为错误一个。无论如何，使用ImgViewResize如下和上面的其他更正，我得到如下图所示的结果。

  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）; 
结束
  

变量 imwidth 和 imheight 定义绘图区域的大小。如果您更改这些，则需要重新计算 OffsX 和 OffsY ，您需要调整后缓冲区大小 bm32 。

角落中的线表示窗口中间的绘图区域（由imwidth和imheight定义）的范围。当窗口最大化时，它保持不变。

I have a ImgView32, that is anchored to all form margins. The form is maximized.

The bitmap of ImgView is not fixed (it can be of different sizes)

I am trying to draw a line on a transparent layer using ther code from this question:Drawing lines on layer

Now the problem is that, using that exact code, I can only draw in the top-left corner, like in this image:

As you can observe, the lines can be drawn only in the left top corner. If I try to add some value to the Start and End Points, the whole thing goes crazy. So I must find a way to translate the points in such a fashion that, the user will be able to draw only inside of the center rect (visible in the image)

I am out of ideas.

Please help

Here is the whole unit:

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 $1;
    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 $1 = 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.

What am I doing wrong? Please test the unit above to see what I mean. Remember to add a ImgView and anchor it to all margins, then at runtime, maximize the form and try to draw the lines...

EDIT

In the green image above, there is a rect, more like a square in the middle of it (not very visible) but you can see it if you look closely.

Since my problem might be misunderstood, please take a look at the following image

I need to be able to draw ONLY in the white rectangle (Bitmap) in the middle of the ImgView. I do not know how to explain better.

It is not a solution for me to make the rectangle/Bitmap fit exactly the ImgView, because that is not the point of my project.

Take a look at Paint.net and imagine that my project kind of does the same (except it's not that complex). But the principle is the same: you decide the size of your document/image when you start a new project, then you add different images as layers, you scale and rotate them, and now I want to allow the users to draw lines inside of a special layer (the drawing layer) But everything happens inside the boundaries of that document size. Like for example in the above image, the size of the document there is A5 (100dpi) scaled at 83%.

So my problem is that I cannot allow the users to draw the lines outside the white rectangle (middle of the screen). So their lines can start in those boundaries and end there.

I know my test unit is not perfectly clean. I pasted some functions used in the main project and quickly removed some parts from them that are not relevant to this example. The AddTransparentPng procedure is there only to allow the testing of adding a transparent image to the ImgView so I can test if the drawing layer is not covering another possible latyer.

(The Scaled property belongs to the layer (B) it's under the 'with B' statement. I removed the With 'ImgView.Bitmap... Location' statement so it would not bother you anymore :) )

Anyway, please do not pay attention to the code that does not affect the drawing of lines. That code is what needs attention.

EDIT If I set the layer's scaled to true (Scaled:=true) then it messes everything up, like in the image bellow:

I still have to use offsets but a little differently

Thank you

解决方案

Error one

In LayerMouseMove() you subtract OffsX and OffsY from FStartPoint in BL.Bitmap.Canvas.MoveTo(). FStartPoint was already adjusted in LayerMouseDown(). I told you to "In the three Mouse procs adjust the X and Y arguments only to become X-OffsX and Y-OffsY." Note arguments only Here's LayerMouseMove() corrected:

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;

Error two

I also told you to add if FDrawingLine then ... condition to LayerMouseUp() to avoid spurious line when the mouse down happens outside of the layer, but mouse up occurs inside. The corrected 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;

Error three

The posted code does not perform as your first image shows. The image looks like you would have outcommented the line BL.Location := ... in ImgViewResize(). Possibly you did this because of Error one. Anyway, with ImgViewResize as follows and the other corrections above I get the result as shown in the picture that follows.

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;

Variables imwidth and imheight defines the size of the drawing area. If you change these you need to recalculate OffsX and OffsY and you need to resize the backbuffer bm32 as well.

The lines in the corners indicate the extent of the drawing area (defined by imwidth and imheight) in the middle of the window. It stays the same also when the window is maximized.

这篇关于Delphi Graphics32相对鼠标位置（到图层）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！