How to create a "HOLE" in a form and align it to HOLE in another form (Hole by Hole)

[Guest]

here, my sample how to do it:

• RAD Studio 10.3.3 Arch (Rio)
• VCL project for test
• none any Windows API is used (at least directly) 
• the magic:
  • TransparentColor on Forms!
  • Calculate the position where is the first "Shape" and how use it in SecondForm position!

 

 

FormMain or any other:

unit uFormMain;
interface
uses
... all units necessary below
type
  TfrmFormMain = class(TForm)
    Shape1: TShape;   // ======== Color = YELLOW
    Button1: TButton;
    Shape2: TShape;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  public
  end;
var
  frmFormMain: TfrmFormMain;
  //
  X1frmFormMainShapeLeft: integer = 0;
  Y1frmFormMainShapeTop : integer = 0;
implementation
{$R *.dfm}
uses
  uFormSecond;
procedure TfrmFormMain.Button1Click(Sender: TObject);
var
  lMyOffsetTop : integer;
  lMyOffsetLeft: integer;
begin
  // here, my values arbitrary...
  lMyOffsetTop  := 8; // you need calculate the margin vertical values ( area-non-client )
  lMyOffsetLeft := 8; // calculate the margin horizontal values( area-non-client )
  //
  Y1frmFormMainShapeTop  := ClientToScreen(TPoint.Create(0, 0)).Y + Shape1.Top - (Self.Height - Self.ClientHeight) + lMyOffsetTop;
  X1frmFormMainShapeLeft := ClientToScreen(TPoint.Create(0, 0)).X + Shape1.Left - (Self.Width - Self.ClientWidth) + lMyOffsetLeft;
  //
  frmFormSecond := TfrmFormSecond.Create(nil);
  try
    frmFormSecond.ShowModal;
  finally
    frmFormSecond.Free;
  end;
end;

procedure TfrmFormMain.FormCreate(Sender: TObject);
begin
  // Self.AlphaBlendValue       := 180;  // 0 = total transparence ...  255 = non-transparence
  // Self.AlphaBlend            := true; // active transparence on form?
  Self.TransparentColorValue := clYellow;
  Self.TransparentColor      := true; //
end;

initialization
ReportMemoryLeaksOnShutdown := true;
finalization
end.

 

SecondForm or any other:

unit uFormSecond;
interface
uses
... // all units necessary below
type
  TfrmFormSecond = class(TForm)
    Shape1: TShape;  // ======= Color = Blue
    procedure FormCreate(Sender: TObject);
  private
  public
  end;
var
  frmFormSecond: TfrmFormSecond;
implementation
{$R *.dfm}
uses
  uFormMain;
procedure TfrmFormSecond.FormCreate(Sender: TObject);
begin
  // Self.AlphaBlendValue       := 180;  // 0 = total transparence ...  255 = non-transparence
  // Self.AlphaBlend            := true; // active transparence on form?
  Self.TransparentColorValue := clBlue;
  Self.TransparentColor      := true; //
  //
  Self.Left := X1frmFormMainShapeLeft - Shape1.Left;
  Self.Top  := Y1frmFormMainShapeTop - Shape1.Top;
end;
end.

 

hug

 

Edited February 16, 2021 by Guest

[Lars Fosdal 1793]

Would it not be nice if the whole thing was on GitHub, GitLab, BitBucket or similar where it could be easily shared and modified, instead of a wall of code on a forum?

 

[Guest]

1 hour ago, Lars Fosdal said:

Would it not be nice

yeah, Will!!!

but I really dont like use repository.

at end, it's so little code.

 

hug

 

[Lars Fosdal 1793]

You can have an example repository with several sub-projects in their own folders.

Each example would be a self contained project, ready to download, compile and run.

Doing fixes would be easy.

Adding features would be easy.

Taking contributions would be possible.

 

[victorlus 0]

Form2 : 

https://imgur.com/a/IfsTxeu

Form1: 

https://imgur.com/1mzTI66

I'm trying to align, form 2, together with form 1, with the same hole in the same size, without moving the shape of the form, only height and width

Obs : 

If I don't use the mouse event it works normally

 

 

Code: 

type
  TForm2 = class(TForm)
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private
    { Private declarations }
    var
    x1, y1, x2, y2: Integer;
    ptnd: Boolean;
    AnchorX, AnchorY, CurX, CurY: Integer;
  protected                      
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  X1frmFormMainShapeLeft: Integer;
  Y1frmFormMainShapeTop: Integer;

implementation

const
  vH: Byte = 10;
  vV: Byte = 30;


procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  x1 := x + vH;
  y1 := y + vV;
  ptnd := True;
  AnchorX := X;
  CurX := X;
  AnchorY := Y;
  CurY := Y;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Caption := 'x1: ' + IntToStr(x1) + '; y1 ' + IntToStr(y1) + '; x2 ' + IntToStr(x2) + '; y2 ' + IntToStr(y2) + ';';
  if ptnd then
  begin
    Canvas.Pen.Mode := pmNot;
    Canvas.Pen.Width := 8;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(AnchorX, AnchorY, CurX, CurY);
    CurX := X;
    CurY := Y;
    Canvas.Rectangle(AnchorX, AnchorY, CurX, CurY);
  end;
end;

procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  lMyOffsetTop : integer;
  lMyOffsetLeft: integer;
begin
  x2 := x + vH;
  y2 := y + vV;
  lMyOffsetTop := 11; // você precisa calcular os valores verticais da margem (área não cliente)
  lMyOffsetLeft := 11; // calcula os valores horizontais da margem (área não cliente)
  begin



      Shape1.Top := Y;
      Shape1.Left := X;
      Shape1.Width := x1 - x2;
      Shape1.Height := y1 - y2;


      Form1.Shape1.Top := 40;
      Form1.Shape1.Left := 40;
      Form1.Shape1.Width :=  x1 - x2;
      Form1.Shape1.Height :=  y1 - y2;


      Y1frmFormMainShapeTop  := ClientToScreen(Point(0, 0)).Y + Shape1.Top - (Self.Height - Self.ClientHeight) + lMyOffsetTop;
      X1frmFormMainShapeLeft := ClientToScreen(Point(0, 0)).X + Shape1.Left - (Self.Width - Self.ClientWidth) + lMyOffsetLeft;


 	  Form1.Left := X1frmFormMainShapeLeft - form1.Shape1.Left;
   	  Form1.Top  := Y1frmFormMainShapeTop - form1.Shape1.Top;

     Form1.Show;
 if ptnd then
 begin
  end;
    ptnd := False;
    Canvas.Pen.Mode := pmNot;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(AnchorX, AnchorY, CurX, CurY);
  end;
end;

 

Edited February 16, 2021 by victorlus

[Guest]

I'll try... 

 

hug

[victorlus 0]

1 minute ago, emailx45 said:

I'll try... 

 

hug

 

Thank you very much my friend you will help me a lot, I am not able to do '-', 3 days ago

[Guest]

7 hours ago, victorlus said:

Thank you very much my friend you will help me a lot, I am not able to do '-', 3 days ago

Ok! But, when using "CreateRectRgn" and "CombineRgn", YOU NEED delete the old objects "regions" -- see the Microsoft Documentation! 

You cannot let the "old regions" in memory! Just the new region (the "combined")

 

My code for you propose it's the same!

• just change the SHAPE choice = if you need a "square", change it for "Shape = stSquare"

 

hug

Edited February 16, 2021 by Guest

[victorlus 0]

19 minutos atrás, emailx45 disse:

OK! Mas, ao usar "CreateRectRgn" e "CombineRgn", VOCÊ PRECISA excluir os objetos antigos "regiões" - consulte a Documentação da Microsoft! 

Você não pode deixar como "velhas regiões" na memória! Apenas a nova região (o "combinado")

 

Meu código para você necessariamente que é o mesmo!

• apenas mude a escolha de FORMA = se você precisar de um "quadrado", mude para "Forma = stSquare"

 

abraço

 

I'm having a little trouble using 

Edited February 16, 2021 by victorlus

[Guest]

How it is "Crooked"? How would be? ... some picture sample?

 

NOTE: dont QUOTE my posts... it's not necessary, and, stay very long this thread! ok?

 

hug

[victorlus 0]

I did not get a solution could show how it solved
I'm having trouble using CreateRectRgn 
sorry i'm using google translator

[Guest]

32 minutes ago, victorlus said:

sorry i'm using google translator...

not problem, me too!

Another tip: when "copy" and "paste" the text from "Google Translate", pay attention how stay your text here on post (in the memo)... because the text come with "formatation". for solve this, just copy the text, firstly, to "MS Notepad" (for example), then, the formatation is losted and your text stay like my (here) --- you see?  -- see the difference above and this text!!! 

 

About use of "CombineRGN()":

procedure TForm1.FormCreate(Sender: TObject);
  var
    LeftRgn : HRGN;
    RightRgn : HRGN;
    NewRgn : HRGN;
  begin
  	LeftRgn  := CreateEllipticRgn(10,10,width div 2, height-10);
  	RightRgn := CreateEllipticRgn(width div 2, 10, width-10, height-10);
  	NewRgn := CreateRectRgn(0,0,0,0);
	//
  	CombineRgn(NewRgn,LeftRgn,RightRgn,RGN_OR);
	//
  	DeleteObject(LeftRgn);
  	DeleteObject(RightRgn);
	//
  	SetWindowRgn(handle,NewRgn,false);
  end;

 

hug

Edited February 16, 2021 by Guest

[Attila Kovacs 631]

7 minutes ago, emailx45 said:

ust copy the text, firstly, to "MS Notepad" (for example), then, the formatation is losted

Just press ctrl+shift+v instead of ctrl+v.