获取邻近控件

(* //
  标题:获取邻近控件
  说明:示例光标键控制焦点
  设计: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[I] = mControl then
                    Continue;
                P1 := RectCenter(Controls[I].BoundsRect);
                case mAnchorKind of
                    akLeft:
                        begin
                            if P0.X <= P1.X then
                                Continue;
                            if Abs(P0.Y - P1.Y) > (Controls[I].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[I].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[I].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[I].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[I];
            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