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.Left) and ( 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;
|