Como desenhar retângulo igual no Desktop do Windows

21/05/2003

5

Pessoal será que alguém possui alguma rotina que serve para desenhar um retângulo na aplicação Delphi, como no Desktop do Windows, quando clicamos e arrastamos o mouse?

Agradeço a ajuda!


Responder

Posts

21/05/2003

Dcport

A rotina pronta eu não tenho (e provavelmente não mandaria :-), mas talvez isso te ajude a começar. Você precisa:

- Configurar o estilo da Pen para dashed (tracinhos)
- Configurar o modo de desenho da Pen para XOR
- Guardar os vértices dos retângulos (antigo e atual) a cada OnMouseMove
- Redesenhar o retângulo antigo por cima dele mesmo antes de desenhar o novo. Isso porque uma característica do modo XOR é que quando você desenha duas vezes a mesma coisa no mesmo lugar, o que estava por trás dela (o fundo do form) reaparece.

Veja um exemplo do operador XOR com números:

x := 0;
x := x xor 1; // Agora x := 1
x := x xor 1; // Repetindo o XOR, o x volta a ser 0. Pegou o espírito?


-- dcport


Responder

26/05/2003

Lfernandos

Aí vai a rotina:
Só não estou tratando a seleção dos componentes em Run-Time.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
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
{ Private declarations }
public
{ Public declarations }
end;

var
Form1 : TForm1;
StartX : Integer;
StartY : Integer;
OldStartX : Integer;
OldStartY : Integer;
OldEndX : Integer;
OldEndY : Integer;
IsDown : Boolean;

implementation

{$R *.DFM}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IsDown := True;
StartX := X;
StartY := Y;
OldStartX := X;
OldStartY := Y;
OldEndX := X;
OldEndY := Y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if IsDown then begin
Canvas.Pen.Style := psDot;
Canvas.Pen.Mode := pmNotXor;
Canvas.Rectangle(OldStartX, OldStartY, OldEndX, OldEndY);
OldEndX := X;
OldEndY := Y;
Canvas.Rectangle(StartX, StartY, X, Y);
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IsDown := False;
Canvas.Pen.Style := psDot;
Canvas.Pen.Mode := pmNotXor;
Canvas.Rectangle(OldStartX, OldStartY, OldEndX, OldEndY);
end;

end.


Responder