Mouse - selecionado componentes com laco

Top  Previous  Next

============================ EXEMPLO 0 ==================================

 

var

  Form1: TForm1;

 

  AnchorX, AnchorY, CurX, CurY: Integer;

  Bounding: Boolean;

 

implementation

 

{$R *.dfm}

 

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

begin

  AnchorX  := X;

  CurX     := X;

  AnchorY  := Y;

  CurY     := Y;

  Bounding := True;

end;

 

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

begin

  if Bounding then

  begin

    Canvas.Pen.Mode    := pmNot;

    Canvas.Pen.Width   := 2;

    Canvas.Brush.Style := bsClear;

    Canvas.Rectangle(AnchorX, AnchorY, CurX, CurY);

    CurX := X;

    CurY := Y;

    Canvas.Rectangle(AnchorX, AnchorY, CurX, CurY);

  end;

end;

 

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

begin

  if Bounding then

  begin

    Bounding           := False;

    Canvas.Pen.Mode    := pmNot;

    Canvas.Brush.Style := bsClear;

    Canvas.Rectangle(AnchorX, AnchorY, CurX, CurY);

  end;

end;

 

============================ EXEMPLO 1 ==================================

 

type

  TForm1 = class(TForm)

    Edit1: TEdit;

    Button1: TButton;

    RadioButton1: TRadioButton;

    ListBox1: TListBox;

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  private

    Capturando : Boolean;

    Origem,Final : TPoint;

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  Capturando :=  True;

  Origem     := Point(X,Y);

  Final      := Point(X,Y);

  // seta penas, brushes e desenha o retângulo

  with Canvas do

  begin

    Pen.Color   := clBlack;

    Pen.Width   := 1;

    Pen.Style   := psDot;

    Brush.Style := bsClear;

    Pen.Mode    := pmNotXor;

    Rectangle(Origem.X,Origem.Y,Final.X,Final.Y);

  end;

end;

 

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  if Capturando then

  begin

    Canvas.Rectangle(Origem.X,Origem.Y,Final.X,Final.Y); // apaga quadro anterior

    Canvas.Rectangle(Origem.X,Origem.Y,X,Y); // desenha novo quadro

    Final := Point(X, Y); // seta quadro final

  end;

end;

 

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  R : TRect;

  i : Integer;

begin

  if Capturando then

  begin

    Capturando := False;

    Canvas.Rectangle(Origem.X,Origem.Y,X,Y);

    Listbox1.Clear;

    for i := 0 to ComponentCount-1 do

      if Components[i] is TControl then

        with TControl(Components[i]) do

        begin

          // verifica intesecção entre o quadro e o componente

          IntersectRect(R,Rect(Origem.X,Origem.Y,Final.X,Final.y), Rect(Left,Top,Left+Width,Top+Height));

          // se ha intersecção, adiciona na Listbox

          if not IsRectEmpty(R) then Listbox1.Items.Add(Name);

        end;

  end;

end;

 

end.

 

============================ EXEMPLO 2 ==================================

 

// Este exemplo foi tirado de um programa que tinha uma matriz de icones

// chamada "Icones"

 

var

  fDragging     : Boolean;

  fRect         : TRect;

  PontoX, PontoY: Integer;

 

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  // Enquando o botão estiver pressionado vai atualizando o fRect

  if Button = mbLeft then

  begin

    fDragging  := True;

    fRect.Left := X;

    fRect.Top  := Y;

    PontoX     := X;

    PontoY     := Y;

    fRect.BottomRight := fRect.TopLeft; // Zera o bottom e Right

    Canvas.DrawFocusRect(fRect);

  end;

end;

 

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  if fDragging then

  begin

    Canvas.DrawFocusRect(fRect); // Este apaga o foco anterior (quadrinho)

 

    if X < fRect.Left then // Esquerda do ponto 0

    begin

      fRect.Right  := PontoX;

      fRect.Left   := X;

    end

    else

    begin

      fRect.Left   := PontoX;

      fRect.Right  := X;

    end;

 

    if Y < fRect.Top then // Acima do ponto 0

    begin

      fRect.Bottom := PontoY;

      fRect.Top    := Y;

    end

    else

    begin

      fRect.Top    := PontoY;

      fRect.Bottom := Y;

    end;

    Canvas.DrawFocusRect(fRect);  // Desenha quadrinho

  end;

end;

 

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  I: Integer;

begin

  // Quando soltar o botão do mouse ... se estiver arrastando....

  if fDragging then

  begin

    fDragging := False;

    Invalidate; // Apaga o desenho do quadro de selecao

    // Todos os icones que estavam dentro do quadro ficam selecionados (ou seja ficam com painel sob branco)

    for I := 1 to MaxIco do

      if Icones[I] <> nil then

        if ((Icones[I].Left >= fRect.Leftand ( Icones[I].Left <= fRect.Right  )) and

           ((Icones[I].Top  >= fRect.Top ) and ( Icones[I].Top  <= fRect.Bottom )) then Paneis[I].Color := clWhite;

  end;

end;

 

 

=============================== OUTRO EXEMBLO (ULTIMO Q PEGUEI MAS NAO TESTEI =======

 

{

Here goes one approach of drawing a lasso

rectangle with Delphi

}

 

1.  In the OnMouseDown event for the form

that you are 'lasso-ing' controls on:

 

bMarquee :=  True;

ptOrigin := Point(X,Y);

ptMove  := Point(X,Y);

 

Pen.Color := clBlack;

Pen.Width := 1;

Pen.Style := psDash;

Brush.Style := bsClear;

 

DrawMarquee(ptOrigin, ptMove, pmNotXor );

 

2.  In the OnMouseMove event for the form...

 

if bMarquee = True then begin

 DrawMarquee(ptOrigin, ptMove, pmNotXor);

 DrawMarquee(ptOrigin, Point(X,Y), pmNotXor);

 ptMove := Point(X, Y);

 Canvas.Pen.Mode := pmCopy;

end;

 

3.  In the OnMouseUp event for the form...

 

if bMarquee = True then begin

 bMarquee := False;

 DrawMarquee(ptOrigin, Point(X,Y), pmNotXor);

 ptMove := Point(X,Y);

end;

 

4. The DrawMarquee procedure...

 

procedure myForm.DrawMarquee

  (mStart, mStop : TPoint; AMode : TPenMode);

begin

 Canvas.Pen.Mode := AMode;

 Canvas.Rectangle(mStart.X,mStart.Y,mStop.X,mStop.Y);

end;