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

Question

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

@DavidHeffernan, my goal is follow [this suggestion](https://stackoverflow.com/questions/53949578/how-align-a-same-form-in-client-side-and-server-side-respectively?noredirect=1#comment94794811_53949578), since that i'm able to see behind "Form3" and send the rectangle to client in `Form2.PaintBox` coordinates (like i'm making before), the lose of transparency in "Form3" that made me choose this alternative. — , Jan 02 '19 at 17:08
The goal is align "Form3" in server and client, but since that also can be possible make what i said on previous comment. `Form3.Parent := Form2.ScrollBox` was the suggestion. You have another? — , Jan 02 '19 at 17:15
The question looks the same as your previous one. How to relate coordinates in two different forms. I asked you a simple question. You seem evasive. How does this question differ from your previous one? — David Heffernan, Jan 02 '19 at 17:28
Then, i'm searching something to solve this, what was suggested (`Form3.Server.Parent := Form2.Server.ScrollBox`) on previous question, lose the transparency of "Form3.Server" that i need. This is the unique solution? — , Jan 02 '19 at 17:35
Then this present question here, is a attempt to follow what was suggested. In my opinion, making a rectangle/hole on `Form3.Server` in `Form2.Server.PaintBox` coordinates, this can imitate like how i made before the suggestion (`Form3.Server.Parent := Form2.Server.ScrollBox`). — , Jan 02 '19 at 17:37
If this question seems the same previous to you, then why you not answerd the previous (if have a solution)? — , Jan 02 '19 at 17:45
**PS:**: Again, *`This present question here, is a attempt to follow what was suggested, but based in my necessity.`* only this :-) — , Jan 02 '19 at 17:50
Never mind. If you don't know whether or not this question is the same as the previous, then this can't be constructive. — David Heffernan, Jan 02 '19 at 18:09
Lucas, I see I wasn't fully clear in my writing about parenting `Form3` to `Form2` in your earlier post. As a continuation I meant to say: To avoid loosing transparency, let `Form3` be free floating (unparented) and use regions to clip it to the area of `Form2.ScrollBox`, so it doesn't float over outside of the scrollbox. Luckily you are already using regions, so it should be easy to adopt. — Tom Brunberg, Jan 02 '19 at 18:16
@TomBrunberg, then you is saying that `Form3.Server.Parent := Form2.Server.ScrollBox` not is more a solution? or still is? because this i not understood this part *`To avoid loosing transparency, let Form3 be free floating (unparented) and use regions to clip it to the area of Form2.ScrollBox`* <= this must be with `Parent` (like you said before) or no? — , Jan 02 '19 at 18:33
I will happy, if you can gove a answer with a code example about this. — , Jan 02 '19 at 18:38
If, as I have understood it, `Form3` must be semitransparent, don't parent it to `Form2`. Instead, let it be free floating, above everything else and use regions to clip it to be visible only within the area of `Form2.ScrollBox`. — Tom Brunberg, Jan 02 '19 at 18:39
From where did the need for the paintboxes suddenly appear? They were not there before. — Tom Brunberg, Jan 02 '19 at 18:43
@TomBrunberg, i had added 1 `PaintBox` in **Server.Form3** to draw, already that i had lost transparency and not was possible draw (behind `Server.Form3`) in `Server.Form2.PaintBox` anymore. — , Jan 02 '19 at 18:47

Tom Brunberg · Accepted Answer · 2019-01-02T22:39:06.403

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

*`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** was used only to draw (with mouse), the rectangle in `Server.Form2` through of `Server.Form3` transparent. — , Jan 02 '19 at 21:31
Ok, I didn't reread the previous question, and remembered wrong, but as I said, you can use a `TPaintBox` instead of the `TImage`. — Tom Brunberg, Jan 02 '19 at 22:10
could upload of *`"The image has a green rectangle centered"`* please? i want execute your code example of answer more near of how you made. — , Jan 02 '19 at 22:21

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

1 Answers1