Como desenhar retângulo igual no Desktop do Windows
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!
Agradeço a ajuda!
Lfernandos
Curtidas 0
Respostas
Dcport
21/05/2003
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
- 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
GOSTEI 0
Lfernandos
21/05/2003
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.
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.
GOSTEI 0