Как сделать одно и то же отверстие в двух формах на удаленном экране (на стороне клиента), основываясь на области, нарисованной на стороне сервера?

Question

Как сделать одно и то же отверстие в двух формах на удаленном экране (на стороне клиента), основываясь на области, нарисованной на стороне сервера?

У меня есть следующий код и я хочу нарисовать одну и ту же дыру в двух формах на удаленном экране (на стороне клиента), основываясь на области, нарисованной на стороне сервера.

У меня одна и та же форма (Form3) с обеих сторон (сервер и клиент), которая является "зеркалом", где я рисую область, которая должна оставаться внутри этой же формы на стороне клиента.

У Form3 на стороне сервера 50% от макс. AlphaBlend значение, это необходимо, чтобы увидеть удаленный экран за Form3.

Прежде всего, я хочу сказать, что я получаю удаленный экран на стороне сервера, и положение щелчка мыши работает, как ожидалось.

Тогда это моя проблема:

Следующий код выдает результат, показанный на изображении выше. Я думаю, что этот код прав, но отсутствует, выровняйте эту дыру с Form3.

Кто-то может помочь с этим? извините, если это плохой вопрос, но это все мои настоящие проблемы, и я попытался выразить все в этом вопросе о лучшем способе, который я смог.

Это весь соответствующий код:

Сторона сервера:

Форма 2 (где я вижу удаленный экран):

unit Unit2;

interface

uses
 Unit1;

type
  TForm2 = class(TForm)
  Panel1: TPanel;
  CheckBox1: TCheckBox;
  ScrollBox1: TScrollBox;
  Image1: TImage;
  PaintBox1: TPaintBox;
  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
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

  if CheckBox1.Checked then
  begin
    FSelection.Left := X;
    FSelection.Top := Y;
    FSelecting := true;
  end;

end;

procedure TForm2.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin

  if FSelecting then
  begin
    FSelection.Right := X;
    FSelection.Bottom := Y;
    pbRec.Invalidate;
  end;

end;

procedure TForm2.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

  if CheckBox1.Checked then
  begin
    FSelecting := false;
    FSelection.Right := X;
    FSelection.Bottom := Y;
    PaintBox1.Invalidate;

    FSelection.NormalizeRect;
    if FSelection.IsEmpty then
    begin
      // None selection was made on PaintBox
    end
    else
    begin
      pos1 := FSelection.Left;
      pos2 := FSelection.Top;
      pos3 := X;
      pos4 := Y;
    end;
  end;

end;

procedure TForm2.PaintBox1Paint(Sender: TObject);
begin
  if CheckBox1.Checked then
  begin
    PaintBox1.Canvas.Brush.Style := bsClear;
    PaintBox1.Canvas.Pen.Style := psSolid;
    PaintBox1.Canvas.Pen.Color := clRed;
    PaintBox1.Canvas.Rectangle(FSelection);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  Socket: TCustomWinSocket;
begin
  Socket := TCustomWinSocket(Form1.LV1.Selected.SubItems.Objects[0]);
  if CheckBox1.Checked then
  begin
      Socket.SendText(intToStr(pos1) + ';' + intToStr(pos2) + ';' +
        intToStr(pos3) + ';' + intToStr(pos4));
  end;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Form3 := TForm3.Create(Self);
  Form3.Show;
end;

Форма 2.DFM:

object Panel1: TPanel
    Left = -1
    Top = 0
    Width = 773
    Height = 89
    Anchors = [akTop]
    BevelEdges = [beLeft, beRight]
    ParentDoubleBuffered = False
    TabOrder = 0
    end

object ScrollBox1: TScrollBox
    Left = 0
    Top = 0
    Width = 765
    Height = 472
    HorzScrollBar.Smooth = True
    HorzScrollBar.Tracking = True
    VertScrollBar.Smooth = True
    VertScrollBar.Tracking = True
    Align = alClient
    TabOrder = 1
    object Image1: TImage
      Left = 0
      Top = 0
      Width = 1362
      Height = 621
      AutoSize = True
    end

object PaintBox1: TPaintBox
      Left = 0
      Top = 0
      Width = 1362
      Height = 621
      Align = alClient
      OnMouseDown = PaintBox1MouseDown
      OnMouseMove = PaintBox1MouseMove
      OnMouseUp = PaintBox1MouseUp
      OnPaint = PaintBox1Paint
      ExplicitWidth = 1364
      ExplicitHeight = 622
    end

Form3 ("зеркальная" форма, которая также одинакова на стороне клиента), эта форма централизована в соответствии с разрешением удаленного экрана:

unit Unit3;

interface

uses
 ...

type
  TForm3 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure CreateParams(var pr: TCreateParams); override;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses 
 Unit1;

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
var
  MyString: String;
  Splitted: TArray<String>;
begin
  MyString := Form1.LV1.Selected.SubItems[6]; // Resolution of remote screen
  Splitted := MyString.Split(['x']);

  Self.Left := (Integer(Splitted[0]) - Self.Width) div 2;
  Self.Top := (Integer(Splitted[1]) - Self.Height) div 2;
end;

procedure TForm3.CreateParams(var pr: TCreateParams);
begin
  inherited;
  pr.WndParent := Form2.Handle;
  pr.ExStyle := pr.ExStyle or WS_EX_TOPMOST or WS_EX_TRANSPARENT;
  pr.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
end;

Форма 3 .DFM:

object Form3: TForm3
  Left = 328
  Top = 143
  BorderStyle = bsNone
  ClientHeight = 567
  ClientWidth = 526
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 801
    Height = 569
    TabOrder = 0
    object Image1: TImage
      Left = 1
      Top = 1
      Width = 799
      Height = 567
      Align = alClient
      ExplicitLeft = 2
      ExplicitTop = 0
      ExplicitHeight = 447
    end

    object Label1: TLabel
      Left = 92
      Top = 69
      Width = 28
      Height = 13
      Caption = 'Nome'
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clBlack
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentColor = False
      ParentFont = False
    end

Сторона клиента:

Форма 2 (форма "шкафчик"):

unit Unit2;

private
    { Private declarations }
    procedure CreateParams(var Params: TCreateParams); override;

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WndParent := Application.Handle;
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST or WS_EX_TRANSPARENT;
  Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  windowstate := wsmaximized;
  Top := 0;
  Left := 0;
  Height := Screen.Height;
  Width := Screen.Width;
end;

{

Properties of Form2:

Align => alNone
AlphaBlend => True
BorderStyle => BsNone

}

end.

Форма 3 (то же самое со стороны сервера):

unit Unit3;

interface

uses
 ...

type
  TForm3 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure CreateParams(var pr: TCreateParams); override;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses 
 Unit2;

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  Self.Left := (GetSystemMetrics(SM_CXSCREEN) - Self.Width) div 2;
  Self.Top := (GetSystemMetrics(SM_CYSCREEN) - Self.Height) div 2;
end;

procedure TForm3.FormShow(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm3.CreateParams(var pr: TCreateParams);
begin
  inherited;
  pr.WndParent := Form2.Handle;
end;

{

Properties of Form3:

Align => alNone
BorderStyle => BsNone

}

end.

Получение зоны на стороне клиента:

procedure CS1_Read(Self: Pointer; Sender: TObject; Socket: TCustomWinSocket);
var
 X1, X2, Y1, Y2: Integer;
 List: TStrings;
 FormRegion, HoleRegion: HRGN;
 StrCommand: string;

begin

if Pos(';', StrCommand) > 0 then
begin

    List := TStringList.Create;
    try

      ExtractStrings([';'], [], PChar(StrCommand), List);

      Form3 := TForm3.Create(Form2); // The Form2 already was created and is showing

      X1 := Round(StrToIntDef(List[0], 0) - Form2.Left);
      Y1 := Round(StrToIntDef(List[1], 0) - Form2.Top);
      X2 := Round(StrToIntDef(List[2], 0) - Form2.Left);
      Y2 := Round(StrToIntDef(List[3], 0) - Form2.Top);


      FormRegion := CreateRectRgn(0, 0, Form3.Width, Form3.Height);
      HoleRegion := CreateRectRgn(X1, Y1, X2, Y2);
      CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
      SetWindowRgn(Form3.handle, FormRegion, true);

      FormRegion := CreateRectRgn(0, 0, Form2.Width, Form2.Height);
      HoleRegion := CreateRectRgn(X1, Y1, X2, Y2);
      CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
      SetWindowRgn(Form2.handle, FormRegion, true);

      Form3.ShowModal;
      Form3.Release;

    finally
      List.Free;
    end;
  end;
end;

2

delphi screen-resolution rect delphi-10-seattle paintbox

Источник

user10752826 21 дек '18 в 16:21

1 ответ

Решение

Другие вопросы по тегам delphi screen-resolution rect delphi-10-seattle paintbox

user2292722 22 дек '18 в 00:43 2018-12-22 00:43 · Accepted Answer · 2018-12-22 00:43

На стороне клиента у вас есть полупрозрачная серая форма (Form2), которая имеет размер экрана. Поверх этой формы у вас есть непрозрачная белая форма (Form3), центрированная на экране. В Form3 у вас есть прямоугольное отверстие в Top = Y а также Left = X в координатах Form3,

Я понимаю, что ваша проблема в том, что вы хотите нарисовать отверстие в Form2, которое выровнено с отверстием в Form3.

Вам необходимо преобразовать систему координат Form3 к тому из Form2 с простым дополнением:

Form2.Hole.Left := Form3.Left + Form3.Hole.Left;
Form2.Hole.Top  := Form3.Top  + Form3.Hole.Top;

Это бы выровнять отверстия. Кажется, вы пытаетесь сделать что-то подобное в своих расчетах, но вы ссылаетесь на Form2.Left а также Form2.Top что бесполезно, так как они оба равны 0.

Если я неправильно понял ваш вопрос, и вы на самом деле хотели бы Form3 отверстие для выравнивания с Form2 отверстие, то вам нужно будет двигаться Form3 вверху - слева от экрана и не центрировать его...

... Или, учитывая ваш комментарий: если я рисую на стороне сервера в области далеко Form3 (клиент), например, больше в левой части экрана, нарисуйте только отверстие Form2 и если я нарисую больше к середине экрана, то выровнять оба выровненных отверстия можно, просто поменяв местами термины:

Form3.Hole.Left := Form2.Hole.Left - Form3.Left
Form3.Hole.Top  := Form2.Hole.Top  - Form3.Top

Это преобразует Form2 координаты Form3 Координаты, которые могут стать отрицательными значениями (например, вне формы) в ситуациях, подобных вашему примеру.

Адаптируя вышеизложенное к своему коду, вам необходимо сначала разобраться с регионом формы 2 с Form2.Hole координаты, затем вычесть Form3 координаты (Left а также Top) из X1..Y2, а затем иметь дело с областью Form3 *.

  X1 := Round(StrToIntDef(List[0], 0) - Form2.Left); // Form2 props can be removed as hardcoded to 0
  Y1 := Round(StrToIntDef(List[1], 0) - Form2.Top);  // -"-
  X2 := Round(StrToIntDef(List[2], 0) - Form2.Left); // -"-
  Y2 := Round(StrToIntDef(List[3], 0) - Form2.Top);  // -"-

  FormRegion := CreateRectRgn(0, 0, Form2.Width, Form2.Height);
  HoleRegion := CreateRectRgn(X1, Y1, X2, Y2);
  CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
  SetWindowRgn(Form2.handle, FormRegion, true);

  X1 := X1 - Form3.Left;
  Y1 := Y1 - Form3.Top;
  X2 := X2 - Form3.Left;
  Y2 := Y2 - Form3.Top;

  FormRegion := CreateRectRgn(0, 0, Form3.Width, Form3.Height);
  HoleRegion := CreateRectRgn(X1, Y1, X2, Y2);
  CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
  SetWindowRgn(Form3.handle, FormRegion, true);

редактировать

Кажется нелогичным, что ваш Server.Form2 не такой же размер, как экран (и, следовательно, Client.Form2). Но, возможно, я так и не понял, для каких целей используется установка.

Во всяком случае, с одинаковым размером, по центру Form3, но с разными размерами экрана на сервере и на клиенте, вам нужно настроить Form3.Hole координаты на клиенте с половиной разницы между размерами экрана сервера и клиента, или, так как Form3 формы центрированы, вы можете рассчитать горизонтальную и вертикальную коррекцию как

ResolutionCorrectionX := Server.Form3.Left - Client.Form3.Left;
ResolutionCorrectionY := Server.Form3.Top - Client.Form3.Top;

что вы затем добавляете к X- и Y-координатам для HoleRegion формы 3.

X1 := X1 - Form3.Left + ResolutionCorrectionX; // and similar for X2, Y1 and Y2

Кстати, просто из любопытства, почему вы используете Round() для расчетов на основе целых чисел?