Assistência remota e função CreateRectRgn: Como ajustar retângulo na mesma posição na tela (com base na tela do servidor), em outro computador (tela cliente)?

17/12/2015

1

Boa noite,

Estou adicionando uma funcionalidade extra para o meu software de assistência remota para uma melhor interação com os meus usuários e quando vou criar um retângulo com um "buraco" no Client.exe, em meus testes deste rectângulo é criado com sucesso em outro computador, mas meu problema é que este retângulo nunca é criado na mesma posição que eu já tinha definido antes em server.exe.

[img:descricao=Exemplo]http://i.stack.imgur.com/fTQRm.png[/img]

Aqui está o meu código que eu tentei da última vez:


//Server.exe

    private
        { Private declarations }
        FSelecting: Boolean;
        FSelection: TRect;
        function ClientToWindow(const P: TPoint): TPoint;

    public
        Socket: TCustomWinSocket;


    function TForm1.ClientToWindow(const P: TPoint): TPoint;
    begin
      Result := pb1.ClientToScreen(P); // pb1 é um TPaintBox que fica acima de um TImage (onde são recebidos os prints atualizados do cliente) no Form1 
      Dec(Result.X, Left);
      Dec(Result.Y, Top);
    end;

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

      FSelection.Left := X;
      FSelection.Top := Y;
      FSelecting := True;

    end;

    procedure TForm1.pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    begin


    if FSelecting then

      begin

        FSelection.Right := X;
        FSelection.Bottom := Y;
        PB1.Invalidate;
      end;

    end;

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

    FSelecting := False;
        FSelection.Right := X;
        FSelection.Bottom := Y;
        PB1.Invalidate;

        FSelection.NormalizeRect;
        if FSelection.IsEmpty then  begin
          Socket.SendText('<|QUADRADO_FECHADO|>');
        end
        else
        begin
          Socket.SendText(

                          IntToStr(ClientToWindow(FSelection.TopLeft).X)
                          + '§' +
                          IntToStr(ClientToWindow(FSelection.TopLeft).Y)
                          + '§' +
                          IntToStr(ClientToWindow(FSelection.BottomRight).X)
                          + '§' +
                          IntToStr(ClientToWindow(FSelection.BottomRight).Y)
          )
        end;

    end;

procedure TForm1.pb1Paint(Sender: TObject);
begin
pb1.Canvas.Brush.Color := clRed;
pb1.Canvas.Rectangle(FSelection);
end;



//Client.exe

procedure TForm1.CS1Read(Sender: TObject; Socket: TCustomWinSocket);
var
StrCommand: string;
List: TStrings;
FormRegion, HoleRegion: HRGN;

begin
  StrCommand := Socket.ReceiveText;

if Pos('<|QUADRADO_FECHADO|>', StrCommand) > 0 then
  begin
    SetWindowRgn(Form2.Handle, 0, True)
  end;

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

     List := TStringList.Create;
     try

       FormRegion := CreateRectRgn(0, 0, Form2.Width, Form2.Height);
       ExtractStrings(['§'], [], PChar(StrCommand), List);
       HoleRegion := CreateRectRgn(StrToInt(List[0]), StrToInt(List[1]),    StrToInt(List[2]), StrToInt(List[3]));
       CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
       SetWindowRgn(Form2.Handle, FormRegion, True);

     finally
       List.Free;
     end;
  end;

end;


Deixo aqui também um exemplo prático (com o código fonte).

Qualquer sugestão será bem-vinda.
Responder

Posts

17/12/2015

Luiz Eduardo

Link para download do projeto de exemplo (com um código pouco modificado em relação ao anterior (entretanto, de nada adiantou e o problema persiste) => [url]http://tempsend.com/E5B3A8830F[/url]
Responder
×
+1 DevUP
Acesso diário, +1 DevUP
Parabéns, você está investindo na sua carreira