Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[13.59.218.147] |
|
Сообщ.
#1
,
|
|
|
Часть соображений позаимствована у 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. Заранее всем признателен. |
Сообщ.
#2
,
|
|
|
Вот тебе кусочек кода из моего старого компонента.
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 |
Сообщ.
#3
,
|
|
|
Цитата Maxon @ { Проблема здесь } function THSHintEdit.GetWndPropValue(Wnd: HWND; PropName: String): Boolean; .... Во-первых, все эти прибамбасы нужны только для работы с чужими приложениями, а для своего собственного есть штатная ф-я function FindControl(Handle: HWnd): TWinControl; Во-вторых, через WindowFromPoint ты можешь добраться только до оконных контролов, а если юзать ControlAtPos как у Rouse_ в #2, то можно выводить хинты и графических TLabel, TSpeedButton и т.п. |
Сообщ.
#4
,
|
|
|
Благодарю за быстрые ответы и Rouse_, и Leo.
Rouse_, Ваш компонент посмотрю, изучу. Спасибо. Leo, по поводу во-первых (FindControl) - это понятно. Хотелось, с одной стороны, более универсальный подход, с другой стороны - действие в рамках объявленного приложения. Попробую ее, главное - добраться до PropInfo. По поводу во-вторых - пока нужны оконные контролы, но спасибо, возможно понадобятся и TGraphicControl-ы. Чуть позже все изучу, перепишу и сообщу, как вышло. |
Сообщ.
#5
,
|
|
|
В общем, просмотрев Вашу реализацию, 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. Что не учел в этом коде или криво написал? |
Сообщ.
#6
,
|
|
|
Цитата Maxon @ Единственное хотел бы узнать, при таком подходе будут замечания к реализации? 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; |
Сообщ.
#7
,
|
|
|
Я проверку класса окна по GetClassName оставил только потому, что на TCustomEdit Delphi ругается -
Undeclared identifier 'TCustomEdit'. Почему и просил помочь (за что, естественно, огромная Вам благодарность). Что с (HControl is TCustomEdit) делать? |
Сообщ.
#8
,
|
|
|
Цитата Maxon @ Что с (HControl is TCustomEdit) делать? Добавить uses StdCtrls Добавлено PS: В общем сл. - если компилер ругается на Undeclared identifier, то находишь в справке соотв-й тип, смотришь в каком модуле он объявлен и добавляешь этот модуль в uses |
Сообщ.
#9
,
|
|
|
Понял, спасибо!
|