鼠标拖动选择控件(200)

问题描述如下：比如多组checkbox，类似1 2 34 5 67 8 9这样排列鼠标拖动时，能出现个方框框中哪些checkbox时，其状态会checkbox.checked=not checkbox.checked跟开发时按住CTRL拖选控件一样的意思

顶一顶 就没人回答下吗

只知道拖动的代码：procedure TForm1.CheckBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin ReleaseCapture; CheckBox1.Perform(WM_SYSCOMMAND,$F012,0)end;

判断控件是否在所选方框之内虚线框unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;type TLineType = (ltHorz, ltVert); TForm1 = class(TForm) procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private { Private declarations } FDC: HDC; FStartPos: TPoint; FBoundRect: TRect; FBounding: Boolean; procedure InvertLongRect(ARect: TRect); public { Public declarations } end;var Form1: TForm1;implementation{$R *.dfm}procedure DotLine(ACanvas: TCanvas; X, Y, W, P, S, PW: integer; LineType: TLineType; LineColor: TColor);var I: integer;begin ACanvas.Pen.Color := LineColor; ACanvas.Pen.Width := PW; case LineType of ltHorz: begin I := 0; while I < W do begin if I + S > W then ACanvas.Polyline([Point(X + I, Y), Point(X + W, Y)]) else ACanvas.Polyline([Point(X + I, Y), Point(X + I + S, Y)]); Inc(I, S + P); end; end; ltVert: begin I := 0; while I < W do begin if I + S > W then ACanvas.Polyline([Point(X, Y + I), Point(X, Y + W)]) else ACanvas.Polyline([Point(X, Y + I), Point(X, Y + I + S)]); Inc(I, S + P); end; end; end;end;procedure DotRect(ACanvas: TCanvas; ARect: TRect; P, S, PW: integer; LineColor: TColor);begin DotLine(ACanvas, ARect.Left, ARect.Top, ARect.Bottom - ARect.Top - 1, P, S, PW, ltVert, LineColor); DotLine(ACanvas, ARect.Right - 1, ARect.Top, ARect.Bottom - ARect.Top, P, S, PW, ltVert, LineColor); DotLine(ACanvas, ARect.Left, ARect.Top, ARect.Right - ARect.Left - 1, P, S, PW, ltHorz, LineColor); DotLine(ACanvas, ARect.Left, ARect.Bottom - 1, ARect.Right - ARect.Left, P, S, PW, ltHorz, LineColor);end;procedure DotRightBottom(ACanvas: TCanvas; ARect: TRect; P, S, PW: integer; LineColor: TColor);begin DotLine(ACanvas, ARect.Right, ARect.Top, ARect.Bottom - ARect.Top, P, S, PW, ltVert, LineColor); DotLine(ACanvas, ARect.Left, ARect.Bottom, ARect.Right - ARect.Left, P, S, PW, ltHorz, LineColor);end;procedure InvertDotLine(FDC: HDC; X, Y, W, P, S, PW: integer; LineType: TLineType);var I: integer;begin case LineType of ltHorz: begin I := 0; while I < W do begin if I + S > W then PatBlt(FDC, X + I, Y, W - I, PW, PATINVERT) else PatBlt(FDC, X + I, Y, S, PW, PATINVERT); Inc(I, S + P); end; end; ltVert: begin I := 0; while I < W do begin if I + S > W then PatBlt(FDC, X, Y + I, PW, W - I, PATINVERT) else PatBlt(FDC, X, Y + I, PW, S, PATINVERT); Inc(I, S + P); end; end; end;end;procedure InvertDotRect(FDC: HDC; ARect: TRect; P, S, PW: integer);begin InvertDotLine(FDC, ARect.Left, ARect.Top, ARect.Bottom - ARect.Top - 1, P, S, PW, ltVert); InvertDotLine(FDC, ARect.Right - 1, ARect.Top, ARect.Bottom - ARect.Top, P, S, PW, ltVert); InvertDotLine(FDC, ARect.Left, ARect.Top, ARect.Right - ARect.Left - 1, P, S, PW, ltHorz); InvertDotLine(FDC, ARect.Left, ARect.Bottom - 1, ARect.Right - ARect.Left, P, S, PW, ltHorz);end;procedure InvertSolidRect(FDC: HDC; ARect: TRect; PW: integer);begin with ARect do begin PatBlt(FDC, Left, Top, Right - Left, PW, PATINVERT); PatBlt(FDC, Left, Top, PW, Bottom - Top, PATINVERT); PatBlt(FDC, Left, Bottom - PW, Right - Left, PW, PATINVERT); PatBlt(FDC, Right - PW, Top, PW, Bottom - Top, PATINVERT); end;end;function CtrlInRect(R: TRect; Ctrl: TWinControl): Boolean;var i: Integer;begin with Ctrl.BoundsRect do begin result := false; for i := Left to Right do begin if PtInRect(R, Point(i, Top)) then begin result := true; exit; end; if PtInRect(R, Point(i, Bottom)) then begin result := true; exit; end; end; for i := Top to Bottom do begin if PtInRect(r, Point(left, i)) then begin result := true; exit; end; if PtInRect(r, Point(Right, i)) then begin result := true; exit; end; end; end;end;procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);var ClipRect: TRect;begin FStartPos.X := X; FStartPos.Y := Y; ClipRect.TopLeft := ClientToScreen(ClientRect.TopLeft); ClipRect.BottomRight := ClientToScreen(ClientRect.BottomRight); ClipCursor(@ClipRect); with FBoundRect do begin Left := X; Top := Y; Right := X; Bottom := Y; end; FBounding := true; InVertLongRect(FBoundRect);end;procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);begin if FBounding then begin InVertLongRect(FBoundRect); with FBoundRect do begin if FStartPos.X < X then Right := X else begin Right := FStartPos.X; Left := X; end; if FStartPos.Y < Y then Bottom := Y else begin Bottom := FStartPos.Y; Top := Y; end; end; InVertLongRect(FBoundRect); end;end;procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin if FBounding then begin InVertLongRect(FBoundRect); FBounding := False; ClipCursor(nil); end;end;procedure TForm1.InvertLongRect(ARect: TRect);beginFDC := GetDCEx(Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_LOCKWINDOWUPDATE); InvertDotRect(FDC, ARect, 2, 4, 1); ReleaseDC(Handle, FDC);end;end.

// 类似于这样, 但这样在鼠标 Move 过程中会出现白线痕迹. 最好还是把屏幕拷贝到另一个画布上,进行操作,如QQ截图```unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) chk1: TCheckBox; chk2: TCheckBox; 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 FormCreate(Sender: TObject); private { Private declarations } FOrgPoint: TPoint; FLastPoint: TPoint; public { Public declarations } end;var Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin FOrgPoint := Point(X, Y);end;procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);var SelRect: TRect; I: Integer; Ctrl: TControl; OldPenMode: TPenMode; OldPenStyle: TPenStyle;begin if (FOrgPoint.X <> -1) and (FOrgPoint.Y <> -1) then begin SelRect.TopLeft := FOrgPoint; OldPenStyle := Self.Canvas.Pen.Style; Self.Canvas.Pen.Style := psDash; // 删除上一次的框框 if (FLastPoint.X <> -1) and (FLastPoint.Y <> -1) then begin SelRect.BottomRight := FLastPoint; OldPenMode := Self.Canvas.Pen.Mode; Self.Canvas.Pen.Mode := pmNotXor; Self.Canvas.MoveTo(SelRect.Left, SelRect.Top); Self.Canvas.LineTo(SelRect.Right, SelRect.Top); Self.Canvas.MoveTo(SelRect.Right, SelRect.Top); Self.Canvas.LineTo(SelRect.Right, SelRect.Bottom); Self.Canvas.MoveTo(SelRect.Right, SelRect.Bottom); Self.Canvas.LineTo(SelRect.Left, SelRect.Bottom); Self.Canvas.MoveTo(SelRect.Left, SelRect.Bottom); Self.Canvas.LineTo(SelRect.Left, SelRect.Top); Self.Canvas.Pen.Mode := OldPenMode; end; SelRect.BottomRight := Point(X, Y); // 绘制框框 Self.Canvas.MoveTo(SelRect.Left, SelRect.Top); Self.Canvas.LineTo(SelRect.Right, SelRect.Top); Self.Canvas.MoveTo(SelRect.Right, SelRect.Top); Self.Canvas.LineTo(SelRect.Right, SelRect.Bottom); Self.Canvas.MoveTo(SelRect.Right, SelRect.Bottom); Self.Canvas.LineTo(SelRect.Left, SelRect.Bottom); Self.Canvas.MoveTo(SelRect.Left, SelRect.Bottom); Self.Canvas.LineTo(SelRect.Left, SelRect.Top); Self.Canvas.Pen.Style := OldPenStyle; // 记录下 FLastPoint := Point(X, Y); // 遍历所有 TCheckBox for I := 0 to Self.ControlCount -1 do begin Ctrl := Self.Controls; if Self.Controls is TCheckBox then begin if PtInRect(SelRect, Point(Ctrl.Left, Ctrl.Top)) or PtInRect(SelRect, Point(Ctrl.Left + Ctrl.Width, Ctrl.Top + Ctrl.Height)) then begin if not TCheckBox(Ctrl).Checked then TCheckBox(Ctrl).Checked := True end else if TCheckBox(Ctrl).Checked then TCheckBox(Ctrl).Checked := False; end; ; end; end;end;procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);var SelRect: TRect; OldPenMode: TPenMode; OldColor: TColor; OldPenStyle: TPenStyle;begin if (FOrgPoint.X <> -1) and (FOrgPoint.Y <> -1) then begin SelRect.TopLeft := FOrgPoint; OldPenStyle := Self.Canvas.Pen.Style; Self.Canvas.Pen.Style := psDash; // 删除上一次的框框 if (FLastPoint.X <> -1) and (FLastPoint.Y <> -1) then begin SelRect.BottomRight := FLastPoint; OldPenMode := Self.Canvas.Pen.Mode; Self.Canvas.Pen.Mode := pmNotXor; OldColor := Self.Canvas.Pen.Color; Self.Canvas.Pen.Color := Self.Color; Self.Canvas.MoveTo(SelRect.Left, SelRect.Top); Self.Canvas.LineTo(SelRect.Right, SelRect.Top); Self.Canvas.MoveTo(SelRect.Right, SelRect.Top); Self.Canvas.LineTo(SelRect.Right, SelRect.Bottom); Self.Canvas.MoveTo(SelRect.Right, SelRect.Bottom); Self.Canvas.LineTo(SelRect.Left, SelRect.Bottom); Self.Canvas.MoveTo(SelRect.Left, SelRect.Bottom); Self.Canvas.LineTo(SelRect.Left, SelRect.Top); Self.Canvas.Pen.Color := OldColor; Self.Canvas.Pen.Mode := OldPenMode; end; Self.Canvas.Pen.Style := OldPenStyle; end; FOrgPoint := Point(-1, -1); FLastPoint := Point(-1, -1); // 容器组件刷新一下 Self.Invalidate;end;procedure TForm1.FormCreate(Sender: TObject);begin FOrgPoint := Point(-1, -1); FLastPoint := Point(-1, -1);end;end.