获取邻近控件

(*// 标题:获取邻近控件
说明:示例光标键控制焦点
设计:Zswang
日期:2002-02-22
支持:wjhu111@21cn.com
//*)
///////Begin Source
function RectCenter(mRect: TRect): TPoint; { 返回矩形的中心坐标 }
begin
Result.X := mRect.Left + (mRect.Right - mRect.Left) div 2;
Result.Y := mRect.Top + (mRect.Bottom - mRect.Top) div 2;
end; { RectCenter }
function Distance(mPointA, mPointB: TPoint): Real; { 返回两点间的距离 }
begin
Result := Sqrt(Sqr(mPointA.X - mPointB.X) + Sqr(mPointA.Y - mPointB.Y));
end; { Distance }
function NearControl(mControl: TControl; mAnchorKind: TAnchorKind): TControl;
{ 返回邻近控件 }
var
I: Integer;
P0, P1: TPoint;
W0, W1: Integer;
K1, KT: Real;
begin
Result := nil;
if not Assigned(mControl) then Exit;
if not Assigned(mControl.Parent) then Exit;
P0 := RectCenter(mControl.BoundsRect);
case mAnchorKind of
akLeft, akRight: W0 := mControl.Height;
else W0 := mControl.Width;
end;
KT := 0;
W1 := 0;
with mControl.Parent do try
for I := 0 to ControlCount - 1 do begin
if Controls = mControl then Continue;
P1 := RectCenter(Controls.BoundsRect);
case mAnchorKind of
akLeft: begin
if P0.X <= P1.X then Continue;
if Abs(P0.Y - P1.Y) > (Controls.Height + W0) div 2 then Continue;
W1 := P0.X - P1.X;
end;
akRight: begin
if P0.X >= P1.X then Continue;
if Abs(P0.Y - P1.Y) > (Controls.Height + W0) div 2 then Continue;
W1 := P1.X - P0.X;
end;
akTop: begin
if P0.Y <= P1.Y then Continue;
if Abs(P0.X - P1.X) > (Controls.Width + W0) div 2 then Continue;
W1 := P0.Y - P1.Y;
end;
akBottom: begin
if P0.Y >= P1.Y then Continue;
if Abs(P0.X - P1.X) > (Controls.Width + W0) div 2 then Continue;
W1 := P1.Y - P0.Y;
end;
end;
K1 := Distance(P0, P1) * W1;
if Assigned(Result) and (K1 > KT) then Continue;
KT := K1;
Result := Controls;
end;
except
Result := nil;
end;
end; { NearControl }
///////End Source
///////Begin Demo
procedure TForm1.FormCreate(Sender: TObject);
begin
KeyPreview := True;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
vAnchorKind: TAnchorKind;
vControl: TControl;
begin
case Key of
VK_UP: vAnchorKind := akTop;
VK_DOWN: vAnchorKind := akBottom;
VK_LEFT: vAnchorKind := akLeft;
VK_RIGHT: vAnchorKind := akRight;
else Exit;
end;
vControl := NearControl(ActiveControl, vAnchorKind);
if Assigned(vControl) and (vControl is TWinControl) then
ActiveControl := TWinControl(vControl);
end;
///////End Demo