HintEdit - неоконный компонент , Поиск свойства PasswordChar в наследнике TComponent

Часть соображений позаимствована у Leo темах 2009 года. Есть класс хинта для полей Edit
(на основе неоконного компонента):

unit HSHintEdit;
 
interface
 
uses Windows, Messages, SysUtils, Classes, Controls, Graphics, AppEvnts,
     TypInfo;
 
type
  EHSHintEditException = class(Exception);
 
  THSHintEdit = class(TComponent)
  private
    FHintWnd: THintWindow;        
    FCanvas: TCanvas;              
    FAppEvnts: TApplicationEvents;
    FActive: Boolean;              
    FAlwaysShowHint: Boolean;      
    FBufferArray: Array of Char;  
    procedure AdjustHint(Wnd: HWND; Point: TPoint);
    procedure DoIdle(Sender: TObject; var Done: Boolean);
    procedure SetActive(const Value: Boolean);
    procedure ShowHint(Origin: TPoint; Text: String);
    procedure HideHint;
  public
    function GetWndPropValue(Wnd: HWND; Propname: String): Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read FActive write SetActive default true;
    property AlwaysShowHint: Boolean read FAlwaysShowHint write FAlwaysShowHint default false;
  end;
 
const
  RSOnlyOneHSHintEdit = [COLOR=blue]'Подключается один раз в приложении'[/COLOR];
 
var
  GlobalHSHintEdit: THSHintEdit = nil;
 
procedure Register;
 
implementation
 
uses Forms;
 
procedure Register;
begin
  RegisterComponents('Samples',[THSHintEdit]);
end;
 
{ THSHintEdit }
 
constructor THSHintEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if Assigned(GlobalHSHintEdit) then                      
    raise EHSHintEditException.Create(RSOnlyOneHSHintEdit)
  else GlobalHSHintEdit := Self;                          
  SetLength(FBufferArray, 0);                  
  FHintWnd := THintWindow.Create(Self);        
  FHintWnd.Color := Application.HintColor;      
  FCanvas := TCanvas.Create;                    
  FAppEvnts := TApplicationEvents.Create(Self);
  FAlwaysShowHint := false;                    
  Active := true;                              
end;
 
[COLOR=gray]{ Сброс и уничтожение всех объектов, определенных в конструкторе класса }[/COLOR]
destructor THSHintEdit.Destroy;
begin
  GlobalHSHintEdit := nil;
  FCanvas.Free;
  FAppEvnts.Free;
  FHintWnd.Free;
  inherited Destroy;
end;
 
[COLOR=gray]{ Собственно вывод хинта }[/COLOR]
procedure THSHintEdit.AdjustHint(Wnd: HWND; Point: TPoint);
var
  HintPt: TPoint;                                  
  EditRect: TRect;                                  
  Len: Integer;                                    
  TextWidth: Integer;                              
  BuffArr: Array of Char;                          
begin
  Windows.ScreenToClient(Wnd, Point);              
  Len := GetWindowTextLength(Wnd);                  
  SetLength(BuffArr, Len + 1);                      
  GetWindowText(Wnd, PChar(BuffArr), Len + 1);      
  if (PChar(BuffArr) <> PChar(FBufferArray)) then  
  begin
    SetLength(FBufferArray, Len + 1);              
    PChar(FBufferArray) := PChar(BuffArr);          
    GetClientRect(Wnd, EditRect);                  
    FCanvas.Handle := GetDC(Wnd);                  
    TextWidth := FCanvas.TextWidth(PChar(BuffArr));
    ReleaseDC(Wnd, FCanvas.Handle);
    FCanvas.Handle := 0;
    if FAlwaysShowHint or ((not FAlwaysShowHint) and (EditRect.Right < TextWidth)) then
    begin
      HintPt := EditRect.TopLeft;                  
      Windows.ClientToScreen(Wnd, HintPt);          
      ShowHint(HintPt, PChar(BuffArr));            
    end
    else begin
      HideHint;
    end;
  end;
end;
 
procedure THSHintEdit.DoIdle(Sender: TObject; var Done: Boolean);
var
  Pt: TPoint;                    [COLOR=gray]{ Адрес структуры, принимающей экранные координаты }[/COLOR]
  Handle: HWND;                  [COLOR=gray]{ Дескриптор окна данного элемента }[/COLOR]
begin
  GetCursorPos(Pt);              [COLOR=gray]{ Извлечение позиции курсора в координатах экрана }[/COLOR]
  Handle := WindowFromPoint(Pt); [COLOR=gray]{ Дескриптор окна - адрес с координатами курсора }[/COLOR]
  if Handle <> 0 then
    if GetWndPropValue(Handle, [COLOR=blue]'PasswordChar'[/COLOR]) then
      AdjustHint(Handle, Pt)     [COLOR=gray]{ Переход к выводу подсказки }[/COLOR]
    else
      HideHint;                  [COLOR=gray]{ Погасить (не выводить) подсказку }[/COLOR]
end;
 
[COLOR=gray]{ Процедура записи свойства Active }[/COLOR]
procedure THSHintEdit.SetActive(const Value: Boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    if Value then
      FAppEvnts.OnIdle := DoIdle
    else
      FAppEvnts.OnIdle := nil;
  end;
end;
 
[COLOR=gray]{ Проблема здесь }[/COLOR]
function THSHintEdit.GetWndPropValue(Wnd: HWND; PropName: String): Boolean;
var
  Atom: TAtom;                   [COLOR=gray]{ Структурная единица данных в памяти }[/COLOR]
  AtomArr: Array[0..31] of Char; [COLOR=gray]{ Форматированный массив атома окна TEdit }[/COLOR]
  BuffArr: Array[Byte] of Char;  [COLOR=gray]{ Буфер, содержащий имя класса окна }[/COLOR]
  Buf: Array[0..31] of Byte;     [COLOR=gray]{ Указатель на данные свойства окна TEdit }[/COLOR]
  Cls: TClass;                   [COLOR=gray]{ Тип класса окна }[/COLOR]
  Len: Integer;                  [COLOR=gray]{ Длина адреса свойства окна в байтах }[/COLOR]
  Pid: Integer;                  [COLOR=gray]{ ProcessID }[/COLOR]
  PH: Integer;                   [COLOR=gray]{ ProcessHandle }[/COLOR]
  PA: PChar;                     [COLOR=gray]{ Указатель начала адреса окна TEdit }[/COLOR]
  PropInfo: PPropInfo;           [COLOR=gray]{ Данные свойства }[/COLOR]
  StrValue: String;              [COLOR=gray]{ Значение свойства элемента }[/COLOR]
  function ReadMem(Addr, Buf: Pointer; Size: Integer): Pointer;
  var
    W: Cardinal;
  begin
    Result := nil;
    if ReadProcessMemory(PH, Addr, Buf, Size, W) then
      Result := Buf;
  end;
begin
  Result := False;
  GetClassName(Wnd, @BuffArr[0], SizeOf(BuffArr));    
  if (BuffArr <> 'TEdit') then Exit;                    [COLOR=gray]{ Проверка имени класса. Пока оставлена }[/COLOR]
  //Cls := FindClass(StrPas(BuffArr));                  [COLOR=gray]{ ???Понятно, что исключение, поскольку TEdit не найден, }[/COLOR]
  //PropInfo := GetPropInfo(Cls, PropName);             [COLOR=gray]{ соответственно закомментированы строки с PropInfo }[/COLOR]
  GetWindowThreadProcessID(Wnd, @Pid);                  
  StrFmt(AtomArr, 'Delphi%.8X', [Pid]);                
  Atom := GlobalFindAtom(AtomArr);                      
  PA := Pointer(GetProp(Wnd, MakeIntAtom(Atom)));      
  if Pid = Integer(GetCurrentProcessID) then            
    PH := GetCurrentProcess                            
  else begin
    PH := OpenProcess(PROCESS_VM_READ, False, Pid);    
    if PH = 0 then Exit;                                
  end;
[COLOR=green](* Пока заремлено для решения???
  if LongRec(PropInfo.GetProc).Bytes[3] = $FF then      
    PA := PA + (Integer(PropInfo.GetProc) and $FFFFFF); { Рассмотрено смещение для поля }
 
  case PropInfo.PropType.Kind of
    tkInteger: Result := PInteger (ReadMem(PA, @Buf, SizeOf(Integer)))^;
    tkChar:    Result := PChar    (ReadMem(PA, @Buf, SizeOf(Char)))^;
    tkWChar:   Result := PWChar   (ReadMem(PA, @Buf, SizeOf(WChar)))^;
    tkInt64:   Result := PInt64   (ReadMem(PA, @Buf, SizeOf(Int64)))^;
    tkFloat:   Result := PExtended(ReadMem(PA, @Buf, SizeOf(Extended)))^;
    tkLString:
    begin
      PA := PPointer(ReadMem(PA, @Buf, SizeOf(Pointer)))^;
      Len := PInteger(ReadMem(PA - 4, @Buf, SizeOf(Integer)))^;
      SetLength(StrValue, Len);
      ReadMem(PA, Pointer(StrValue), Len);
      Result := StrValue;
    end;
    else
      raise Exception.Create('Исключение!');
  end;
*)[/COLOR]
  CloseHandle(PH);
  Result := True;
end;
 
[COLOR=gray]{ Процедура вывода подсказки Hint в экранную область }[/COLOR]
procedure THSHintEdit.ShowHint(Origin: TPoint; Text: String);
var
  R: TRect;
begin
  Application.CancelHint;
  R := FHintWnd.CalcHintRect(1000, Text, nil);
  OffsetRect(R, Origin.X, Origin.Y);
  FHintWnd.ActivateHint(R, Text);
  SetWindowPos(
    FHintWnd.Handle,  
    HWND_TOPMOST,      
    R.Left,            
    R.Top,            
    FHintWnd.Width,    
    FHintWnd.Height,  
    SWP_NOACTIVATE);  
end;
 
[COLOR=gray]{ Процедура сокрытия подсказки Hint }[/COLOR]
procedure THSHintEdit.HideHint;
begin
  FHintWnd.ReleaseHandle;
end;
 
end.

Работает нормально. Проблема в том, что я не хочу выводить его в полях с паролем. Т.е. мне надо
найти свойство PasswordChar и, если там не #0, на AdjustHint не идти.
Так как я наследуюсь от TComponent, естественно, у меня проблема с нахождением PasswordChar.
Могу я это обойти в рамках данного класса и WIN API (допустим, созданием наследника TEdit)?
Короче говоря, как получить с помощью WIN API доступ к свойству PasswordChar?
Приложение мое, но хочется именно на WIN API, возможно, потом понадобится вытягивать еще другие свойства.
С Delphi общаюсь месяц, поэтому прошу строго не судить и помочь по существу. На всякий случай, Delphi 2009.
Также хотелось бы узнать мнение Leo. Заранее всем признателен.

Вот тебе кусочек кода из моего старого компонента.
http://rouse.drkb.ru/components.php#fwhint

Здесь переходит переключение в юникод в случае если хинт у контрола юникодный (поддержка TMS контролов):

  FHint.FUnicodeHint := '';
  FHint.FUseUNICODE := False;
  GetCursorPos(P);
  HintControl := Screen.ActiveForm.ControlAtPos(
    Screen.ActiveForm.ScreenToClient(P), True, True);
  // Смотрим, какой тип у него имеет св-во Hint
  if HintControl <> nil then
  begin
    Info := GetPropInfo(HintControl, 'Hint');
    if Info <> nil then
      FHint.FUseUNICODE := Info^.PropType^.Kind = tkWString;
    if FHint.FUseUNICODE then
    begin
      FHint.Font.Assign(Screen.ActiveForm.Font);
      FHint.FUnicodeHint := VarToWideStr(GetPropValue(HintControl, 'Hint'));
    end;
  end;

Соответственно по аналогии смотри и PasswordChar

Цитата Maxon @ 06.01.11, 20:21

{ Проблема здесь }
function THSHintEdit.GetWndPropValue(Wnd: HWND; PropName: String): Boolean;
....

Во-первых, все эти прибамбасы нужны только для работы с чужими приложениями, а для своего собственного есть штатная ф-я

function FindControl(Handle: HWnd): TWinControl;

Получаешь по hWnd указатель на контрол и затем юзаешь GetPropInfo + GetOrdProp

Во-вторых, через WindowFromPoint ты можешь добраться только до оконных контролов, а если юзать ControlAtPos как у Rouse_ в #2, то можно выводить хинты и графических TLabel, TSpeedButton и т.п.

Благодарю за быстрые ответы и Rouse_, и Leo.

Rouse_, Ваш компонент посмотрю, изучу. Спасибо.
Leo, по поводу во-первых (FindControl) - это понятно. Хотелось, с одной стороны, более
универсальный подход, с другой стороны - действие в рамках объявленного приложения.
Попробую ее, главное - добраться до PropInfo.
По поводу во-вторых - пока нужны оконные контролы, но спасибо, возможно понадобятся и
TGraphicControl-ы. Чуть позже все изучу, перепишу и сообщу, как вышло.

В общем, просмотрев Вашу реализацию, Rouse_, в FWHint.pas, решил оставить пока оконные
контролы (дабы не переписывать procedure AdjustHint, хотя возможность оперировать с
помощью ControlAtPos так же и TGraphicControl взял на вооружение.), а также оставить
исключительно выбор свойства PasswordChar (пока не стал делать выбор всех свойств или
даже выборочно, чтобы уйти от общего CASE), получил такой вариант:

procedure THSHintEdit.DoIdle(Sender: TObject; var Done: Boolean);
var
  Pt: TPoint;                    
  Handle: HWND;                  
begin
  GetCursorPos(Pt);              
  Handle := WindowFromPoint(Pt);
  if Handle <> 0 then
    if GetWndPropValue(Handle, 'PasswordChar') then
      AdjustHint(Handle, Pt)    
    else
      HideHint;                  
end;
 
function THSHintEdit.GetWndPropValue(Wnd: HWND; PropName: String): Boolean;
var
  BuffArr: Array[Byte] of Char;                    
  HControl: TWinControl;                          
  PropInfo: PPropInfo;                            
  PropValue: String;                              
begin
  Result := False;
  PropValue := '';
  GetClassName(Wnd, @BuffArr[0], SizeOf(BuffArr));
  if (BuffArr <> 'TEdit') then Exit;              
  HControl := FindControl(Wnd);                    
  if Assigned(HControl) then                      
  begin
    PropInfo := GetPropInfo(HControl.ClassInfo, PropName);    
    if PropInfo^.PropType^.Kind = tkWChar then
      Result := IntToStr(GetOrdProp(HControl, PropName)) = '0';
  end;
end;

Понятно, что гораздо проще, чем для чужого приложения. Работает так, как надо.
Единственное хотел бы узнать, при таком подходе будут замечания к реализации?
Долго не мог понять использование самих GetPropInfo и GetOrdProp. Что не учел
в этом коде или криво написал?

Цитата Maxon @ 09.01.11, 21:00

Единственное хотел бы узнать, при таком подходе будут замечания к реализации?

1) Проверка класса окна по GetClassName выглядит излишней и прятянутой за уши. Проще и универсальнее юзать (HControl is TCustomEdit)
2) А вот для PropInfo наоборот не помешала бы проверка на nil, плюс для унивесальности проверка типа на tkChar
3) А конвертация GetOrdInfo в строку - "ваще без коментариев"
В итоге можно сделать так:

function THSHintEdit.HasPasswordChar(Wnd: HWND; const PropName: String): Boolean;
var
   ctl: TWinControl;                          
begin
   ctl:=FindControl(Wnd);
   Result:=Assigned(ctl) and (ctl is TCustomEdit) and
     (GetPropInfo(ctl,PropName,[tkChar,tkWChar]) <> nil) and
     (GetOrdProp(ctl,PropName) <> 0);
end;

Сообщение отредактировано: leo - 10.01.11, 14:34

Я проверку класса окна по GetClassName оставил только потому, что на TCustomEdit Delphi ругается -
Undeclared identifier 'TCustomEdit'. Почему и просил помочь (за что, естественно, огромная Вам
благодарность).
Что с (HControl is TCustomEdit) делать?

Цитата Maxon @ 10.01.11, 17:13

Что с (HControl is TCustomEdit) делать?

Добавить

uses StdCtrls

Добавлено 10.01.11, 17:54
PS: В общем сл. - если компилер ругается на Undeclared identifier, то находишь в справке соотв-й тип, смотришь в каком модуле он объявлен и добавляешь этот модуль в uses

Понял, спасибо!