Delphi Graphics32 相对鼠标位置(相对于图层)

标签 delphi delphi-xe graphics32

我有一个 ImgView32，它锚定到所有表单边距。表单已最大化。

ImgView的位图不固定(可以是不同大小)

我正在尝试使用此问题中的代码在透明层上画一条线:Drawing lines on layer

现在的问题是，使用确切的代码，我只能在左上角绘制，如下图所示: drawing after resizing the form (maximize)

正如您所观察到的，只能在左上角绘制线条。 如果我尝试为起点和终点添加一些值，整个事情就会变得疯狂。因此，我必须找到一种方法来平移点，使用户只能在中心矩形内部进行绘制(在图像中可见)

我没有主意了。

请帮忙

这是整个单元:

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.

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

编辑

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

由于我的问题可能会被误解，请看下图image

我需要能够仅在 ImgView 中间的白色矩形(位图)中绘制。我不知道如何更好地解释。

让矩形/位图完全适合 ImgView 对我来说不是一个解决方案，因为这不是我项目的重点。

看一下 Paint.net，想象一下我的项目也做了同样的事情(除了它没那么复杂)。但原理是相同的:当你开始一个新项目时，你决定文档/图像的大小，然后添加不同的图像作为图层，缩放和旋转它们，现在我想允许用户在其中画线特殊层(绘图层) 但一切都发生在该文档大小的范围内。例如上图中，文档尺寸为 A5 (100dpi)，缩放比例为 83%。

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

我知道我的测试设备并不完全干净。我粘贴了主项目中使用的一些函数，并快速从中删除了一些与本示例无关的部分。 AddTransparentPng 过程仅允许测试向 ImgView 添加透明图像，以便我可以测试绘图层是否未覆盖另一个可能的层。

(Scaled 属性属于图层 (B)，它位于“with B”语句下。我删除了 With“ImgView.Bitmap... Location”语句，这样它就不会再打扰您了:))

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

编辑 如果我将图层的缩放设置为 true (Scaled:=true) 那么它会把一切搞乱，如下图所示: enter image description here

我仍然需要使用偏移量，但略有不同

谢谢

最佳答案

错误一

在 LayerMouseMove() 中，您从 BL.Bitmap.Canvas.MoveTo() 中的 FStartPoint 减去 OffsX 和 OffsY。 FStartPoint 已在 LayerMouseDown() 中调整。我告诉过你“在三个鼠标过程中调整 X 和 Y 参数，使其变为 X-OffsX 和 Y-OffsY”。注意仅参数这是更正的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;

错误二

我还告诉您向 LayerMouseUp() 添加 if FDrawingLine then ... 条件，以避免当鼠标按下发生在图层外部但鼠标弹起发生在图层内部时出现虚假线条。更正后的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 := ... 行。您这样做可能是因为错误一。无论如何，使用如下的 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 的大小。

enter image description here

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

关于Delphi Graphics32 相对鼠标位置(相对于图层)，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/28550072/

上一篇：java - 如何将 Json(来自过程)映射到 Java 对象

下一篇：sql - 根据找到匹配项的位置动态按列对结果进行排序

相关文章：

xml - 德尔福 XE 和 OmniXML : Using SelectNode()?

delphi - Delphi-如何检查数据集是否已获取所有行？

delphi - 使用 FireDac 将日期插入 MS Access 数据库

delphi - 在Delphi中使用UTF8生成动态HTML页面

c++ - 需要帮助将 Graphics32 Delphi 示例转换为 C++

Delphi - Graphics32，绘制抗锯齿圆角矩形

delphi - 有人知道 Graphics32 目前的状况吗？

delphi - 获取服务的描述？

delphi - 遗留 Delphi 项目中的 32 位透明 PNG 问题

windows - 最小化应用程序时隐藏表单

©2024 IT工具网  联系我们