Desenhar um quadro de seleção
Quero em tempo de runtime selecionar os componentes na tela para movê-los, para isso faço um ´quadro de seleção´ como na IDE do Delphi, porém meu quadro de seleção fica por baixo dos edits e buttons e dos labels fica por cima como quero que seja.
Alguém sabe como fazer para desenhar por cima dos TWinControl com o Canvas ou se tiver outro jeito.
Obs: Esta funcionando bem, apenas queria que quando desenhar a seleção, ela ficase sobre todos os controles.
Alguém sabe como fazer para desenhar por cima dos TWinControl com o Canvas ou se tiver outro jeito.
Obs: Esta funcionando bem, apenas queria que quando desenhar a seleção, ela ficase sobre todos os controles.
Mkoch
Curtidas 0
Respostas
Mkoch
30/07/2009
O código abaixo, faz um quadro de seleção com o mouse e seleciona os componentes onde a seleção passou por cima. Precionando Ctrl+setas, movimentas os controles. Tipo como na IDE do Delphi.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TSetaKind = (skNone, skLeft, skUp, skRight, skDown);
TForm1 = class(TForm)
Label1: TLabel;
ListBox1: TListBox;
Label2: TLabel;
Button1: TButton;
CheckBox1: TCheckBox;
ListBox2: TListBox;
Edit1: TEdit;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
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);
procedure Edit1Click(Sender: TObject);
private
{ Private declarations }
FSelectedControls: TList;
FSelecting : Boolean;
FStart: TPoint;
FEnd: TPoint;
FCanvas: TCanvas;
procedure ExibeSelecionados;
function MakeRect(Pt, Pt2: TPoint): TRect;
function GetHandle: HDC;
procedure MovimentSelectedControls(aWhatSeta: TSetaKind);
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
procedure MakeSelected(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
VK_LEFT_ = 500;
VK_RIGHT_ = 501;
VK_UP_ = 502;
VK_DOWN_ = 503;
procedure TForm1.ExibeSelecionados;
var
i: Integer;
xControl: TControl;
begin
ListBox1.Clear;
for i := 0 to FSelectedControls.Count - 1 do
begin
xControl := TControl(FSelectedControls[i]);
ListBox1.Items.Add(xControl.Name);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FSelectedControls := TList.Create;
FCanvas := TCanvas.Create;
FCanvas.Handle := GetDC(0);
RegisterHotKey(Handle, 500, MOD_CONTROL, VK_LEFT);
RegisterHotKey(Handle, 501, MOD_CONTROL, VK_RIGHT);
RegisterHotKey(Handle, 502, MOD_CONTROL, VK_UP);
RegisterHotKey(Handle, 503, MOD_CONTROL, VK_DOWN);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(Handle, 500);
UnRegisterHotKey(Handle, 501);
UnRegisterHotKey(Handle, 502);
UnRegisterHotKey(Handle, 503);
FSelectedControls.Free;
FCanvas.Free;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FSelecting := True;
FStart := Point(X, Y);
FEnd := Point(X, Y);
FStart := ClientToScreen(FStart);
FEnd := ClientToScreen(FEnd);
FCanvas.Pen.Color := clBlack;
FCanvas.Pen.Width := 1;
FCanvas.Pen.Style := psDot;
FCanvas.DrawFocusRect(MakeRect(FStart, FEnd));
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
xPoint: TPoint;
begin
if FSelecting then
begin
FCanvas.DrawFocusRect(MakeRect(FStart, FEnd));
xPoint := ClientToScreen(Point(X, Y));
FCanvas.DrawFocusRect(MakeRect(FStart, xPoint));
FEnd := xPoint;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
xRect: TRect;
i: Integer;
xControl: TControl;
xPoint, xPoint2: TPoint;
begin
if FSelecting then
begin
FSelecting := False;
xPoint := ClientToScreen(Point(X, Y));
FCanvas.DrawFocusRect(MakeRect(FStart, xPoint));
FSelectedControls.Clear;
for i := 0 to ComponentCount - 1 do
begin
if Components[i] is TControl then
begin
xControl := TControl(Components[i]);
xPoint := ClientToScreen(Point(xControl.Left, xControl.Top));
xPoint2 := ClientToScreen(Point(xControl.Left + xControl.Width, xControl.Top + xControl.Height));
IntersectRect(xRect, Rect(FStart.X, FStart.Y, FEnd.X, FEnd.Y),
Rect(xPoint.X, xPoint.Y, xPoint2.X, xPoint2.Y));
if not IsRectEmpty(xRect) then
begin
if xControl is TWinControl then
TWinControl(xControl).TabStop := False;
Self.SetFocus;
FSelectedControls.Add(xControl);
end;
end;
end;//for
ExibeSelecionados;
end;
end;
function TForm1.GetHandle: HDC;
begin
Result := Self.Canvas.Handle;
end;
function TForm1.MakeRect(Pt: TPoint; Pt2: TPoint): TRect;
begin
if pt .x < pt2.x then
begin
Result.Left := pt .x;
Result.Right := pt2.x;
end
else
begin
Result.Left := pt2.x;
Result.Right := pt .x;
end;
if pt .y < pt2.y then
begin
Result.Top := pt .y;
Result.Bottom := pt2.y;
end
else
begin
Result.Top := pt2.y;
Result.Bottom := pt .y;
end;
end;
procedure TForm1.MakeSelected(Sender: TObject);
var
xRect: TRect;
X1, Y1, X2, Y2: Integer;
xPoint: TPoint;
xCOntrol: TControl;
begin
xControl := TControl(Sender);
xPoint.X := xControl.Left;
xPoint.Y := xControl.Top;
xPoint := ClientToScreen(xPoint);
FCanvas.Brush.Color := clBlack;
xRect.Left := xPoint.X - 2;
xRect.Top := xPoint.Y - 2;
xRect.Right := xPoint.X + 2;
xRect.Bottom := xPoint.Y + 2;
FCanvas.Rectangle(xRect);
end;
procedure TForm1.MovimentSelectedControls(aWhatSeta: TSetaKind);
var
xControl: TControl;
i: Integer;
begin
for i := 0 to FSelectedControls.Count - 1 do
begin
xControl := TControl(FSelectedControls[i]);
case aWhatSeta of
skLeft: xControl.Left := xControl.Left - 1;
skUp: xControl.Top := xControl.Top - 1;
skRight: xControl.Left := xControl.Left + 1;
skDown: xControl.Top := xControl.Top + 1;
end;
end;
end;
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
var
xCtrl: Boolean;
xWhatSeta: TSetaKind;//TSetaKind = (skNone, skLeft, skUp, skRight, skDown);
begin
xCtrl := (GetKeyState(VK_CONTROL) and $1000000) <> 0;
xWhatSeta := skNone;
(*if (GetKeyState(VK_LEFT) and $1000000) <> 0 then
xWhatSeta := skLeft
else if (GetKeyState(VK_UP) and $1000000) <> 0 then
xWhatSeta := skUp
else if (GetKeyState(VK_RIGHT) and $1000000) <> 0 then
xWhatSeta := skRight
else if (GetKeyState(VK_DOWN) and $1000000) <> 0 then
xWhatSeta := skDown;
*)
case Msg.HotKey of
VK_LEFT_: xWhatSeta := skLeft;
VK_UP_: xWhatSeta := skUp;
VK_RIGHT_: xWhatSeta := skRight;
VK_DOWN_: xWhatSeta := skDown;
end;
if xCtrl and (xWhatSeta <> skNone) and (FSelectedControls.Count > 0) then
begin
Msg.Result := 0;
MovimentSelectedControls(xWhatSeta);
end;
end;
procedure TForm1.Edit1Click(Sender: TObject);
begin
MakeSelected(TControl(Sender));
end;
end.
GOSTEI 0
Mkoch
30/07/2009
Para denhar por cima dos controles, o segredo está em:
FCanvas := TCanvas.Create;
FCanvas.Handle := GetDC(0);
//GetDC(0) pega o canvas da Screen ou do desktop, algo assim. Como se tivesse feito uma camado invisível sobre a tela onde posso selecionar.
FCanvas := TCanvas.Create;
FCanvas.Handle := GetDC(0);
//GetDC(0) pega o canvas da Screen ou do desktop, algo assim. Como se tivesse feito uma camado invisível sobre a tela onde posso selecionar.
GOSTEI 0