如何使用“Form 2”中存在的 Paint Box 的坐标在“Form”中绘制矩形/孔？
Posted
技术标签:
【中文标题】如何使用“Form 2”中存在的 Paint Box 的坐标在“Form”中绘制矩形/孔？【英文标题】：How draw a rectangle/hole in a "Form3" using coordinates of a PaintBox present in "Form2"? 【发布时间】：2019-05-29 07:53:58 【问题描述】：我有一个“Form2”，它有一个ScrollBox 和一个PaintBox。
还存在另一个名为“Form3”的表单（内部也有一个PaintBox），它的父级为“Form2” 的ScrollBox。然后我需要根据Form2.PaintBox 的坐标在 "Form3" 上画一个 rectangle => hole。
这可能吗？
提前感谢任何建议/帮助。
Form1：
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
Private declarations
public
Public declarations
end;
var
Form1: TForm1;
implementation
uses
Unit2;
$R *.dfm
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Show;
end;
end.
Form2：
type
TForm2 = class(TForm)
Panel1: TPanel;
ScrollBox1: TScrollBox;
Button1: TButton;
Image1: TImage;
Button2: TButton;
OpenDialog1: TOpenDialog;
Button3: TButton;
PaintBox1: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
Private declarations
public
Public declarations
end;
var
Form2: TForm2;
implementation
uses
Unit3;
$R *.dfm
procedure TForm2.Button2Click(Sender: TObject);
begin
Form3.Close;
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
with TOpenDialog.Create(self) do
try
Caption := 'Open Image';
Options := [ofPathMustExist, ofFileMustExist];
if Execute then
Image1.Picture.LoadFromFile(FileName);
finally
Free;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
Form3 := TForm3.Create(self);
Form3.Parent := ScrollBox1;
Form3.Show;
end;
Form3：
type
TForm3 = class(TForm)
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1Paint(Sender: TObject);
private
Private declarations
FSelecting: Boolean;
FSelection: TRect;
pos1, pos2, pos3, pos4: Integer;
public
Public declarations
end;
var
Form3: TForm3;
implementation
uses
Unit2;
$R *.dfm
procedure TForm3.FormCreate(Sender: TObject);
begin
Left := (Form2.Image1.Width - Width) div 2;
Top := (Form2.Image1.Height - Height) div 2;
end;
procedure TForm3.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FSelection.Left := X;
FSelection.Top := Y;
FSelecting := True;
end;
procedure TForm3.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if FSelecting then
begin
FSelection.Right := X;
FSelection.Bottom := Y;
PaintBox1.Invalidate;
end;
end;
procedure TForm3.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
FormRegion: HRGN;
HoleRegion: HRGN;
begin
FSelecting := False;
FSelection.Right := X;
FSelection.Bottom := Y;
PaintBox1.Invalidate;
pos1 := FSelection.Left;
pos2 := FSelection.Top;
pos3 := X;
pos4 := Y;
FSelection.NormalizeRect;
if FSelection.IsEmpty then
SetWindowRgn(Handle, 0, True)
else
begin
FormRegion := CreateRectRgn(0, 0, Width, Height);
HoleRegion := CreateRectRgn(pos1, pos2, pos3, pos4);
CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
SetWindowRgn(Handle, FormRegion, True);
end;
end;
procedure TForm3.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Brush.Style := bsClear;
PaintBox1.Canvas.Pen.Style := psSolid;
PaintBox1.Canvas.Pen.Color := clBlue;
PaintBox1.Canvas.Rectangle(FSelection)
end;
Form2 .DFM：
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 478
ClientWidth = 767
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 767
Height = 47
Align = alTop
TabOrder = 0
object Button1: TButton
Left = 24
Top = 8
Width = 89
Height = 25
Caption = 'Form3 Open'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 119
Top = 8
Width = 89
Height = 25
Caption = 'Form3 Close'
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton
Left = 232
Top = 8
Width = 89
Height = 25
Caption = 'Open image'
TabOrder = 2
OnClick = Button3Click
end
end
object ScrollBox1: TScrollBox
Left = 0
Top = 47
Width = 767
Height = 431
Align = alClient
TabOrder = 1
object Image1: TImage
Left = 3
Top = 4
Width = 558
Height = 301
AutoSize = True
end
object PaintBox1: TPaintBox
Left = 0
Top = 0
Width = 763
Height = 427
Align = alClient
ExplicitLeft = 80
ExplicitTop = 40
ExplicitWidth = 105
ExplicitHeight = 105
end
end
object OpenDialog1: TOpenDialog
Left = 360
end
end
Form3 .DFM：
object Form3: TForm3
Left = 0
Top = 0
BorderStyle = bsNone
Caption = 'Form3'
ClientHeight = 365
ClientWidth = 533
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDefaultSizeOnly
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object PaintBox1: TPaintBox
Left = 0
Top = 0
Width = 533
Height = 365
Align = alClient
OnMouseDown = PaintBox1MouseDown
OnMouseMove = PaintBox1MouseMove
OnMouseUp = PaintBox1MouseUp
OnPaint = PaintBox1Paint
ExplicitLeft = 328
ExplicitTop = 200
ExplicitWidth = 105
ExplicitHeight = 105
end
end
版本：
这个问题基本上是我previous question的延续
【问题讨论】：
这个问题和你之前的问题有什么不同？ @DavidHeffernan，我的目标是关注this suggestion，因为我可以看到“Form3”的后面并将矩形发送到Form2.PaintBox 坐标中的客户端（就像我之前所做的那样） ，“Form3”中失去透明度让我选择了这个替代方案。
好的。这个问题与您之前的问题有何不同？
问题很清楚，但你什么都不懂。
这个问题看起来和你之前的一样。如何以两种不同的形式关联坐标。我问了你一个简单的问题。你似乎在逃避。这个问题与您之前的问题有何不同？
【参考方案1】：
这是一个测试应用程序，用于演示“客户端”图像中Server.Form3 与Client.Form3 的对齐方式。
首先Form2。它是这个 testapp 中的主要形式。它有一个滚动框和一个图像（“客户端”端的图像），这里用 1000 x 400 的砖墙表示。该图像有一个垂直和水平居中的绿色矩形，模仿客户端可见的Form3。
type
TScrollBox = class(Vcl.forms.TScrollBox) // we need to handle scroll events
protected
procedure WMHScroll(var Msg: TMessage); message WM_HSCROLL;
procedure WMVScroll(var Msg: TMessage); message WM_VSCROLL;
end;
TForm2 = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ScrollBox1Resize(Sender: TObject);
private
Private declarations
protected // we also need to react to form moves
procedure WMWindowPosChanged(var Msg: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
public
Public declarations
end;
var
Form2: TForm2;
implementation
// a helper function
function fnMyRgn(HostControl: TWinControl; Form: TForm): HRGN;
begin
result := CreateRectRgn(
(HostControl.ClientOrigin.X - Form.Left),
(HostControl.ClientOrigin.Y - Form.Top),
(HostControl.ClientOrigin.X - Form.Left + HostControl.ClientWidth),
(HostControl.ClientOrigin.Y - Form.Top + HostControl.ClientHeight));
end;
// Note how Form3 is centered to the scrollbox content (the image) by using scrollbar ranges
procedure TForm2.Button1Click(Sender: TObject);
var
rgn: HRGN;
begin
Form3 := TForm3.Create(self);
Form3.Left := ScrollBox1.ClientOrigin.X - ScrollBox1.HorzScrollBar.Position +
(ScrollBox1.HorzScrollBar.Range - Form3.Width) div 2;
Form3.Top := ScrollBox1.ClientOrigin.Y - ScrollBox1.VertScrollBar.Position +
(ScrollBox1.VertScrollBar.Range - Form3.Height) div 2;
rgn := fnMyRgn(ScrollBox1, Form3);
if 0 = SetWindowRgn(Form3.Handle, rgn, True) then
DeleteObject(rgn);
Form3.Visible := True;
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
Form3.Close;
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
Form3.AlphaBlend := False;
Form3.TransparentColor := True;
end;
// Scrollbox is anchored to all sides of the form,
// ergo, size changes if form size changes
procedure TForm2.ScrollBox1Resize(Sender: TObject);
var
ScrBox: TScrollBox;
rgn: hRgn;
begin
if Form3 = nil then exit;
ScrBox := Sender as TScrollBox;
Form3.Left := ScrBox.ClientOrigin.X - ScrBox.HorzScrollBar.Position +
(ScrBox.HorzScrollBar.Range - Form3.Width) div 2;
Form3.Top := ScrBox.ClientOrigin.Y - ScrBox.VertScrollBar.Position +
(ScrBox.VertScrollBar.Range - Form3.Height) div 2;
rgn := fnMyRgn(ScrBox, Form3);
if 0 = SetWindowRgn(Form3.Handle, rgn, True)then
DeleteObject(rgn);
end;
// Form3 must be moved if Form2 is moved
procedure TForm2.WMWindowPosChanged(var Msg: TWMWindowPosChanged);
begin
inherited;
if Form3 = nil then exit;
Form3.Left := ScrollBox1.ClientOrigin.X - ScrollBox1.HorzScrollBar.Position +
(ScrollBox1.HorzScrollBar.Range - Form3.Width) div 2;
Form3.Top := ScrollBox1.ClientOrigin.Y - ScrollBox1.VertScrollBar.Position +
(ScrollBox1.VertScrollBar.Range - Form3.Height) div 2;
end;
TScrollBox
procedure TScrollBox.WMHScroll(var Msg: TMessage);
var
rgn: hRgn;
begin
inherited;
if Form3 = nil then exit;
Form3.Left := self.ClientOrigin.X - HorzScrollBar.Position +
(HorzScrollBar.Range - Form3.Width) div 2;
rgn := fnMyRgn(self, Form3);
if 0 = SetWindowRgn(Form3.Handle, rgn, True) then
DeleteObject(rgn);
end;
procedure TScrollBox.WMVScroll(var Msg: TMessage);
var
rgn: hRgn;
begin
inherited;
if Form3 = nil then exit;
Form3.Top := self.ClientOrigin.Y - VertScrollBar.Position +
(VertScrollBar.Range - Form3.Height) div 2;
rgn := fnMyRgn(self, Form3);
if 0 = SetWindowRgn(Form3.Handle, rgn, True) then
DeleteObject(rgn);
end;
end.
然后我们有Form3，这里只是一个 400 宽 x 300 高的无边框表单，带有几个按钮和一个红色的轮廓。它可以是字母混合的或完全透明的。它设置为 alphablend，混合值为 127。单击Form2.Button3 时，它会切换为透明。黄色填充颜色是TransparentColoValue
type
TForm3 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormPaint(Sender: TObject);
private
public
end;
var
Form3: TForm3;
implementation
$R *.dfm
uses Unit2;
procedure TForm3.FormPaint(Sender: TObject);
begin
Canvas.Pen.Color := clRed;
Canvas.Pen.Style := psSolid;
Canvas.Pen.Width := 3;
Canvas.Rectangle(1, 1, clientwidth-1, clientheight-1);
end;
第一个屏幕截图仅显示 Form2
第二张图片显示 Form2 和 Form3 字母混合，略微滚动
第三张图片显示Form2，Form3 透明，进一步滚动
现在Client.Form3 以客户端屏幕为中心，Server.Form3 以客户端屏幕图像为中心，您使用相同坐标绘制的任何孔都应该重合。
另请注意，根据您的第一个问题，我在滚动框中使用了TImage，因为我真的不明白您为什么要更改为画框。但是，如果您愿意的话，使用颜料盒代替 TImage 也不是问题。
根据要求，添加使用的背景图片
【讨论】：
Note also that I used a TImage in the scrollbox according your first question, because I don't really understand why you would change to a paintbox. It would however, not be a problem to use a paintbox instead of the TImage, if you prefer that. PaintBox 仅用于绘制（用鼠标），Server.Form2 到 Server.Form3 透明的矩形。
好吧，我没有重读上一个问题，记错了，不过就像我说的，你可以用TPaintBox代替TImage。
可以上传"The image has a green rectangle centered"吗？我想执行你的代码示例，更接近你的做法。以上是关于如何使用“Form 2”中存在的 Paint Box 的坐标在“Form”中绘制矩形/孔？的主要内容，如果未能解决你的问题，请参考以下文章