如何创建一个与鼠标坐标相等的对齐矩形(TRect)?

时间:2016-07-08 22:26:32

标签: delphi canvas rectangles

我在这里了解如何为鼠标发送的相同坐标创建一个BitmapBitmap对齐,我已经尝试了几种方法,但{{1永远不等于鼠标发送的区域(图像),用于在Form上创建一个洞。

例如:

http://www.armorpayments.com/api/pages/integrationGuide/

以上是远程桌面,选择的区域是垂直菜单的一部分。

然后,客户端的TBitmap必须是相同的内容。

因此,客户端的TBitmap必须是同一个区域。

但遗憾的是,这完全不同,所产生的图像处于另一个位置。

enter image description here

所以,这是我的最后一次尝试:

这是鼠标坐标的方式: (服务器端)

type
  TForm2 = class(TForm)
  pbRec: TPaintBox;
  procedure pbRecMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbRecMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pbRecMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbRecPaint(Sender: TObject);

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

    .....

    function TForm2.ClientToWindow(const P: TPoint): TPoint;
    begin
      Result := PB1.ClientToScreen(P);
      Dec(Result.X, Left);
      Dec(Result.Y, Top);
    end;

    procedure TForm2.pb1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      FSelection.Left := X;
      FSelection.Top := Y;
      FSelecting := True;
    end;

    procedure TForm2.pb1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    begin
      if FSelecting then
      begin
        FSelection.Right := X;
        FSelection.Bottom := Y;
        PB1.Invalidate;
      end;
    end;

    procedure TForm2.pb1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      FSelecting := False;
      FSelection.Right := X;
      FSelection.Bottom := Y;
      PB1.Invalidate;

      FSelection.NormalizeRect;

       Socket.SendText(IntToStr(FSelection.Left) + '§' + IntToStr(FSelection.Top) + '§' + IntToStr(X) + '§' + IntToStr(Y));

    end;

    procedure TForm2.pb1Paint(Sender: TObject);
    begin
      PB1.Canvas.Brush.Color := clRed;
      PB1.Canvas.Rectangle(FSelection);
    end;
{ And here is how is received:* **( client side ) }

 type
      TForm1 = class(TForm)
      CS1: TClientSocket;
      procedure CS1Read(Sender: TObject; Socket: TCustomWinSocket);

     private
        { Private declarations }
      public
        { Public declarations }
      end;

        procedure TForm1.CS1Read(Sender: TObject; Socket: TCustomWinSocket);
         var
           X1, X2, Y1, Y2: Integer;
           List: TStrings;
           FormRegion, HoleRegion: HRGN;
           Bmp: TBitmap;
           R: TRect;
           StrCommand: String;

            begin
             StrCommand := Socket.ReceiveText;

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

                List := TStringList.Create;
                Bmp :=  TBitmap.Create;
                try

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

                 { Coordinates for area sent by mouse in server side }

                  X1 := StrToIntDef(List[0], 0);
                  Y1 := StrToIntDef(List[1], 0);
                  X2 := StrToIntDef(List[2], 0);
                  Y2 := StrToIntDef(List[3], 0);

             ////////////////////////// THIS IS MY CRITICAL REGION ///////////////////////////

                  R := Rect(X1, Y1, X2, Y2);

                  Bmp.SetSize(R.Width, R.Height);

                  Bmp.Canvas.CopyRect(Rect(0, 0, R.Width, R.Height), Canvas, R);

            ///////////////////////////// END OF CRITICAL REGION //////////////////////////////

                  Bmp.SaveToFile(GetPathToTestExe+'nil.bmp');

                finally
                  List.Free;
                  Bmp.Free;
                end;
              end;

        end;

欢迎提出任何建议。

0 个答案:

没有答案