Как нарисовать прямоугольник / отверстие в "Form3", используя координаты PaintBox, присутствующего в "Form2"?

У меня есть " 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

ИЗДАНИЕ:

Этот вопрос в основном является продолжением моего предыдущего вопроса

Источник

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 с парой кнопок и красным нарисованным контуром. Он может быть в форме буквы или полностью прозрачным. Устанавливается в альфа-значение со значением наложения 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, если вы предпочитаете это.

По запросу добавлено используемое фоновое изображение

Источник
Другие вопросы по тегам