Como desenhar retângulo igual no Desktop do Windows
21/05/2003
0
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
Curtir tópico
+ 0
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
- 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.
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
Clique aqui para fazer login e interagir na Comunidade :)