delphi delphi-10-seattle mouse-coordinates tscrollbox paintbox

How draw a rectangle/hole in a "Form3" using coordinates of a PaintBox present in "Form2"?

I have a "Form2" that have a ScrollBox and a PaintBox.

Also exists another Form called "Form3" (also with a PaintBox inside) that have the ScrollBox of "Form2" as your parent. Then i need draw a rectangle => hole over "Form3" based on coordinates of Form2.PaintBox.

This is possible?

Thanks in advance by any suggestion/help.

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

EDITION:

This question is basically a continuation of my previous question

Solution

Here is a testapp to demonstrate alignment of Server.Form3 with Client.Form3 in the image of "client" side.

First Form2. It's the main form in this testapp. It has a scrollbox and in that an image (the image of the "client" side), here represented by a 1000 x 400 brickwall. The image has a green rectangle centered vertically and horisontally, mimicing the Form3 visible on the client side.

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.

Then we have Form3, which here is just a 400 wide x 300 high borderless form with a couple of buttons and a red drawn outline. It can be alphablended or fully transparent. It is set to alphablended with blend value of 127. When Form2.Button3 is clicked it switches to transparent. The yellow fill color is the 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;

First screenshot shows Form2 only

Second image shows Form2 with Form3 as alphablended, slightly scrolled

And the third image shows Form2 with Form3 as transparent, further scrolled

Now that Client.Form3 is centered to the screen of the client and Server.Form3 is centered to the image of the client screen, any holes you draw with the same coordinates, should coincide.

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.

As requested, added the background image used