-2

我有一个“ Form2 ”，它有一个ScrollBox和一个PaintBox.

还存在另一个名为“ Form3 ”（也有PaintBox内部）的表单，它的父ScrollBox级为“Form2” 。然后我需要根据坐标在“Form3”上绘制一个矩形=>孔。Form2.PaintBox

这个有可能？

提前感谢任何建议/帮助。

在此处输入图像描述

表格1：

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.

表格2：

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;

表格 3：

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;

表格2 .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

表格3 .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

版：

这个问题基本上是我上一个问题的延续

4

1 回答 1

3

这是一个测试应用程序，用于在“客户端”端的图像中演示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根据您的第一个问题，我在滚动框中使用了 a ，因为我真的不明白您为什么要更改为绘画框。但是TImage，如果您愿意的话，使用油漆盒代替 油漆盒也不是问题。

根据要求，添加了使用的背景图片

在此处输入图像描述

于 2019-01-02T20:41:07.150 回答