quinta-feira, 21 de junho de 2012

Identificar componente ao passar o mouse por cima do mesmo


> Crie um tipo [Record]


  TRectControles = record
    uRect: TRect;
    uControle: TControl;
  end;


> Em [private], crie um array dinâmico do tipo [TRectControles], um método, para pegar a posição inicial dos controles [AtualizaPosicaoControles], e um método para retornar informações sobre o controle [ConsultaControle]  


  private
    { Private declarations }
    vp_Rect: array of TRectControles;
    procedure AtualizaPosicaoControles;
    function  ConsultaControle: string;

 [implementation]


// AtualizaPosicaoControles
procedure TForm1.AtualizaPosicaoControles;
var
  vl_i, vl_TamVetor: Integer;
begin
  for vl_i := 0 to Self.ComponentCount - 1 do
    begin
      if Components[vl_i].InheritsFrom(TControl) and (Components[vl_i].ClassType <> TForm) then
        begin
          vl_TamVetor:= Length(vp_Rect);
          SetLength(vp_Rect, vl_TamVetor + 1);
          with vp_Rect[High(vp_Rect)] do
            begin
              uRect:= TControl(Components[vl_i]).BoundsRect;
              uControle:= TControl(Components[vl_i]);
            end;
        end;
    end;
end;


// ConsultaControle
function TForm1.ConsultaControle: string;
  function PosMouseForm: TPoint;
  var
   vl_ponto: Tpoint;
  begin
    vl_ponto:= Self.ClientOrigin;
    with vl_ponto do
      begin
        x:= Mouse.CursorPos.x - x;
        y:= Mouse.CursorPos.y - y;
        if (x < 0) or (x > Self.Width) or (y < 0) or (y > Self.Height) then
         begin
           y:= -1;
           x:= -1;
         end;
      end;
    Result:= vl_ponto;
  end;
Var
 vl_mp : TPoint;
 vl_i: Integer;
 vl_ClassRef: TClass;
begin
  vl_mp:= PosMouseForm;
  for vl_i := 0 to Length(vp_Rect) - 1 do
    begin
     If PtInRect(vp_Rect[vl_i].uRect, vl_mp) Then
      Begin
        if vp_Rect[vl_i].uControle <> nil then
          begin
            vl_ClassRef := vp_Rect[vl_i].uControle.ClassType;
            with vp_Rect[vl_i].uControle do
              begin
                while vl_ClassRef <> nil do
                  begin
                    Result:= Result + vl_ClassRef.ClassName + #13;
                    vl_ClassRef := vl_ClassRef.ClassParent;
                  end;
                ShowHint:= True;
                Hint:= Result;
              end;
            Exit;
          end;
      End;
    end;
end;


> No evento [onCreate] do Form;
procedure TForm1.FormCreate(Sender: TObject);
begin
  AtualizaPosicaoControles;
end;


> Coloque um componente TTime no Form com intervalo = 1 e Enable = True, no evento [onTimer];
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  ConsultaControle;
  AtualizaPosicaoControles;
end;




  

Nenhum comentário:

Postar um comentário