Einzelnen Beitrag anzeigen

Benutzerbild von toms
toms
(CodeLib-Manager)

Registriert seit: 10. Jun 2002
4.648 Beiträge
 
Delphi XE Professional
 
#3

Re: Kompo um bei "disabled" Delphi-Kompos ein Hint

  Alt 27. Jan 2008, 16:04
Ich habe noch eine kürzere Möglichkeit gefunden bei experts-exchange.
Vorteil: Es ist keine Komponente. Unit kann eingebundenn werden und Hints werden bei
inaktiven Controls angezeigt.

Delphi-Quellcode:
unit ControlsHook;
////////////////////////////////////////////////////////////////////////////////
//
// Unit : ControlsHook
// Author : rllibby
// Date : 12.20.2005
// Description : Code for runtime hooking of the FindVCLWindow function in the
// controls unit.
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
// Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, Controls, Forms;

////////////////////////////////////////////////////////////////////////////////
// ASM block structure for installing hook
////////////////////////////////////////////////////////////////////////////////
type
  TJmpBlock = packed record
    Code: Byte;
    Offset: Integer;
  end;

////////////////////////////////////////////////////////////////////////////////
// Our replacement for the FindVCLWindow function
////////////////////////////////////////////////////////////////////////////////
function HookFindVCLWindow(const Pos: TPoint): TWinControl;

implementation

function HookFindVCLWindow(const Pos: TPoint): TWinControl;
var Form: TForm;
  Handle: HWND;
begin

  Result := nil;
  Form := Screen.ActiveForm;
  if Assigned(Form) then
  begin
    Handle := ChildWindowFromPoint(Form.Handle, Form.ScreenToClient(Pos));
    while (Handle <> 0) do
    begin
      Result := FindControl(Handle);
      if Assigned(Result) and Result.Visible then
        break
      else
        Result := nil;
      Handle := GetParent(Handle);
    end;
  end;

end;

procedure SetFunctionHook;
var jmpBlock: TJmpBlock;
  dwProtect: LongWord;
  lpFunc: Pointer;
begin

  // Get the address of the FindVCLWindow function
  lpFunc := @FindVCLWindow;

  // Calculate the jump offset
  jmpBlock.Code := $E9;
  jmpBlock.Offset := Integer(@HookFindVCLWindow) - (Integer(lpFunc) + SizeOf(TJmpBlock));

  // Unprotect the memory so we can add the new asm code
  VirtualProtect(lpFunc, SizeOf(TJmpBlock), PAGE_EXECUTE_READWRITE, dwProtect);

  // Update the FindVCLWindow with a jump to our hook
  Move(jmpBlock, lpFunc^, SizeOf(TJmpBlock));

end;

initialization

  // Set the function hook
  SetFunctionHook;

end.
Thomas
  Mit Zitat antworten Zitat