Fórum Desenhar um quadro de seleção #372921

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.