用屏幕绘图的方式在运行期选择界面上的控件
模拟在IDE状态下用画框的方式对界面上的控件进行选择.
实现的方式是:在屏幕上将原来界面绘制,然后在上面进行画虚框.选择结束后根据画框的大小来检查那些控件选中了.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, TypInfo, myPanel, Buttons;
Const
CO_POINT_SPACE=8;
type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Label3: TLabel;
ListBox1: TListBox;
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);
procedure FormPaint(Sender: TObject);
private
FSourceBmp:TBitmap; //保存最初始的图形
FBeginDraw:Boolean;
FBeginPoint:TPoint;
FSourceDC:TCanvas;
public
{ Public declarations }
end;
//给定两个点,返回组成的范围
function TwoPointToRect(Const APoint1,APoint2:TPoint):TRect;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TwoPointToRect(Const APoint1,APoint2:TPoint):TRect;
begin
if APoint1.X> APoint2.X then
begin
Result.Left:=APoint2.X;
Result.Right:=APoint1.X;
end
else
begin
Result.Left:=APoint1.X;
Result.Right:=APoint2.X;
end;
if APoint1.Y> APoint2.Y then
begin
Result.Top:=APoint2.Y;
Result.Bottom:=APoint1.Y;
end
else
begin
Result.Top:=APoint1.Y;
Result.Bottom:=APoint2.Y;
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ASRect:TRect;
begin
FBeginDraw:=True;
FBeginPoint:=ClientToScreen(Point(X,Y));
FSourceDC:=TCanvas.Create;
FSourceDC.Handle:=GetDC(0);
FSourceBmp:=TBitmap.Create;
FSourceBmp.Width:=Width;
FSourceBmp.Height:=Height;
ASRect:=Rect(0,0,Width,Height);
//得到最原始的基本图形
FSourceBmp.Canvas.CopyRect(ASRect,Self.Canvas,Rect(0,0,Width,Height));
//限制鼠标移动范围
ASRect.Right:=ClientWidth;
ASRect.Bottom:=ClientHeight;
ASRect.TopLeft:=ClientToScreen(ASRect.TopLeft);
ASRect.BottomRight:=ClientToScreen(ASRect.BottomRight);
windows.ClipCursor(@ASRect);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i,L:integer ;
ADRect:TRect;
begin
if FBeginDraw then
begin
//解除鼠标限制
windows.ClipCursor(0);
FBeginDraw:=False;
FreeAndNil(FSourceBmp);
ReleaseDC(0,FSourceDC.Handle);
FreeAndNil(FSourceDC);
//画的框的范围 注意检查起止点位置
FBeginPoint:=ScreenToClient(FBeginPoint);
ADRect:=TwoPointToRect(FBeginPoint,Point(X,Y));
ListBox1.Items.Clear;
//检查选中的控件 当前是仅全部框起来才算选中.也可以实现为只要有部分框起来就算选中.
L:=Self.ControlCount-1;
for i:=0 to L do
begin
Self.Controls[i].Refresh;
if (Controls[i].Left > =ADRect.Left)and(Controls[i].Top> =ADRect.Top)and
(Controls[i].Left+Controls[i].Width <=ADRect.Right)and(Controls[i].Top+Controls[i].Height <=ADRect.Bottom) then
ListBox1.Items.Add(Controls[i].Name);
end;
Self.Refresh;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
APoint:TPoint;
ADRect:TRect;
begin
//在图上画线,然后显示
if (FBeginDraw)and(X <Self.ClientWidth)and(Y <Self.ClientHeight) then
begin
ADRect.Left:=Left+4;
ADRect.Top:=Top+23;
ADRect.Right:=Width+Left+4;
ADRect.Bottom:=Height+Top+23;
//在屏幕上先绘制没有画线的窗体
FSourceDC.CopyRect(ADRect,FSourceBmp.Canvas ,Rect(0,0,Width,Height));
FSourceDC.Pen.Style:=psDot;
FSourceDC.Pen.Color:=clBlack;
FSourceDC.Brush.Style:=bsClear;
APoint:=Point(X,Y);
if APoint.X <0 then
APoint.X:=0;
if APoint.Y <0 then
APoint.Y:=0;
APoint:=ClientToScreen(APoint);
//在屏幕上画线
FSourceDC.Rectangle(FBeginPoint.x,FBeginPoint.Y,APoint.X,APoint.Y);
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
X,Y:Integer;
begin
X:=0;
Y:=0;
while X <=Width do
begin
Y:=0;
while Y <=Height do
begin
Canvas.Pixels[X,Y]:=clBlack;
Inc(Y,CO_POINT_SPACE);
end;
Inc(X,CO_POINT_SPACE);
end;
end;
end.
[解决办法]
学习了，1分也要接
