Форум на Исходниках.RU

Hint в ComboBox

POP — Wed, 13 Apr 2011 14:23:27 +0000

POP:

Цитата SourceUser @ 13.04.11, 13:09

В первом случае видать буфер маленький, юзай LB_GETTEXTLEN, а во втором случае у тебя же строка пустая.

Да я в итоге просто сам динамический массив Array of Char сделал и выделал под него память с использованием LB_GETTEXTLEN.

По-идее под строки Delphi сама память автоматом все выделяет, самому не надо ничего делать.. ан не работает в этом случае.

PS.
Дак почему CalcHintRect(1000,Text,nil) не работает?

В описании написано, что по достижении 1000 пикселов, Хинт должен переноситься на новую строку, но ничего не переноситься.

Hint в ComboBox

SourceUser — Wed, 13 Apr 2011 13:09:43 +0000

SourceUser: В первом случае видать буфер маленький, юзай LB_GETTEXTLEN, а во втором случае у тебя же строка пустая.
Делай как то так.

var

Buf: PChar;

begin

GetMem(Buf, SendMessage(Wnd, LB_GETTEXTLEN, 0,0));

var

Buf: String;

begin

SetLength(Buf, SendMessage(Wnd, LB_GETTEXTLEN, 0,0))

Hint в ComboBox

POP — Wed, 13 Apr 2011 12:41:54 +0000

POP: Не могу справиться с одной проблемой:

Если указать статический буфер для Хинта, то будет AccessViolation если Хинт вылезет за пределы статического массива, если указать много, то зря память расходоваться будет. Хочу массив заменить обычной строкой (она же типа динамический массив). Почему не работает вот так:

procedure TComboBoxPatch.AdjustHint(Wnd: HWND; Point: TPoint);

var

HintPt: TPoint;

ItemRect: TRect;

Item, TextWidth: Integer;

// buf: array[0..127] of Char; - Было.

buf: string; // Стало

begin

Windows.ScreenToClient(Wnd,Point);

Item:=SendMessage(Wnd,LB_ITEMFROMPOINT,0,lParam(PointToSmallPoint(Point)));

if (Item and {text}010000 <> {text}010000) and (Item <> FHintIndex) then

begin

FHintIndex:=Item;

// SendMessage(Wnd,LB_GETTEXT,Item,Integer(@buf)); - Было

SendMessage(Wnd,LB_GETTEXT,Item,Integer(PChar(buf))); // Стало

SendMessage(Wnd,LB_GETITEMRECT,Item,Integer(@ItemRect));

FCanvas.Handle:=GetDC(Wnd);

TextWidth:=FCanvas.TextWidth(buf);

ReleaseDC(Wnd,FCanvas.Handle);

FCanvas.Handle:=0;

if FAlwaysShowHint or ((not FAlwaysShowHint) and (ItemRect.Right < TextWidth)) then

begin

HintPt:=ItemRect.TopLeft;

Windows.ClientToScreen(Wnd,HintPt);

ShowHint(HintPt,buf);

end

else

begin

HideHint;

end;

end

else

begin

if Item < 0 then HideHint;

end;

Пометил как Было и как Стало, две строчки заменил.

Виснет при показе Хинта.

Hint в ComboBox

POP — Wed, 13 Apr 2011 06:53:04 +0000

POP:

Цитата SourceUser @ 12.04.11, 19:47

А эта строчка просто ложит нашу подсказку над системным ComboLBox, ибо он иногда побеждает и вылазин наверх.

Я знаю.. значит она просто не портит то что делается в ActivateHint, как это происходит в компоненте Шевченко и --Ins--

Hint в ComboBox

SourceUser — Tue, 12 Apr 2011 19:47:16 +0000

SourceUser: POP - Неа.
Глянь в исходниках метод

procedure THintWindow.ActivateHint(Rect: TRect; const AHint: string);

всё выравнивание делается там.

А эта строчка просто ложит нашу подсказку над системным ComboLBox, ибо он иногда побеждает и вылазин наверх.

Hint в ComboBox

POP — Tue, 12 Apr 2011 19:36:16 +0000

POP: SourceUser

Вот эта строка SetWindowPos(FHint.Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); , и есть решение проблемы с вырваниванием Хинта, если он вылез за пределы экрана.

Hint в ComboBox

SourceUser — Tue, 12 Apr 2011 16:14:09 +0000

SourceUser: Ну и я до кучи выложу вариант, что делал когдато. Очень компактный.

type

TComboBox = class(StdCtrls.TComboBox)

private

FListIndex: Integer;

FHint: THintWindow;

public

procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;

procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;

end;

TForm1 = class(TForm)

ComboBox1: TComboBox;

XPManifest1: TXPManifest;

private

{ Private declarations }

public

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

{ TComboBox }

procedure TComboBox.CNCommand(var Message: TWMCommand);

var Info: TComboBoxInfo;

begin

inherited;

case Message.NotifyCode of

CBN_DROPDOWN:

begin

if (Style <> csSimple) then begin // хукаем список, предок хукает его только при стиле csSimple

Info.cbSize := SizeOf(Info);

if GetComboBoxInfo(Self.Handle, Info) and (Info.hwndList <> 0) then begin

FListHandle := Info.hwndList;

FDefListProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));

SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FListInstance));

FListIndex := -1;

FHint := nil;

end;

CBN_CLOSEUP: // убираем хук

if (Style <> csSimple) and (FListHandle <> 0) then begin

SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FDefListProc));

FreeAndNil(FHint);

end;

procedure TComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);

var J, NewIndex: Integer;

ItemRect, R: TRect;

Pt: TPoint;

DC: HDC;

Size: TSize;

OldFont: HFont;

begin

inherited;

if ComboWnd = FListHandle then

with Message do

case Msg of

WM_MOUSEMOVE:

begin

NewIndex := -1;

// получаем текущий индекс под мышкой

for J := 0 to SendMessage(FListHandle, LB_GETCOUNT , 0, 0)-1 do begin

SendMessage(FListHandle, LB_GETITEMRECT, J, Cardinal(@ItemRect));

Pt := Mouse.CursorPos;

MapWindowPoints(0, FListHandle, Pt, 1);

if PtInRect(ItemRect, Pt) then begin

NewIndex := J;

Break;

end;

if NewIndex < 0 then begin

FreeAndNil(FHint);

FListIndex := -1;

end

else // если индекс поменялся

if J <> FListIndex then begin

FreeAndNil(FHint);

FListIndex := NewIndex;

// проверяем вмещается ли текст

DC := GetDC(FListHandle);

OldFont := SelectObject(DC, Screen.HintFont.Handle);

GetTextExtentPoint32(DC, PChar(Items[J]), Length(Items[J]), Size);

SelectObject(DC, OldFont);

ReleaseDC(FListHandle, DC);

// показываем подсказку

if Size.cx > (ItemRect.Right-ItemRect.Left) then begin

FreeAndNil(FHint);

FHint := THintWindow.Create(Self);

R := FHint.CalcHintRect(Screen.Width, Items[J], nil);

MapWindowPoints(FListHandle, 0, ItemRect, 2);

ItemRect.Right := ItemRect.Left + (R.Right-R.Left);

ItemRect.Bottom := ItemRect.Top + (R.Bottom-R.Top);

FHint.ActivateHint(ItemRect, Items[J]);

SetWindowPos(FHint.Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);

end;

end; // WM_MOUSEMOVE

end;

Hint в ComboBox

POP — Mon, 11 Apr 2011 19:17:52 +0000

POP:

Цитата --Ins-- @ 27.02.08, 14:29

Для кучи, выложу свое решение, написанное некогда давно, также под влиянием кода Игоря Шевченко. Идея только несколько отличается - вместо потомка TComboBox - неоконный компонент, который нужно просто бросить на любую форму, и все ComboBox-ы начнут показывать Hint

Хотелось бы доработать этот компонент, исправить баги и разобраться в одной фишке. Хороший ведь компонент, полезный:

Во-первых, чтобы он реально не позволял себя многократно использовать и сек все попытки наложить больше одного компонента на форму, нужно удалить из Деструктора строку "GlobalPatch:=nil;"

Во-вторых он поддерживает только Хинты не более чем в 128 символов, а иначе валится нафиг в AccessViolation. Но это поправимо.

Самое главное, что в функции ShowHint вызовом SetWindowPos мочиться наглухо способность ActivateHint выравнивать влево длинные Хинты, если они вылазят за пределы экрана (правую часть). Если SetWindowPos не использовать, тогда первый всплывающий Хинт оказывается под списком (что собственно SetWindowPos и фиксит). Короче замкнтуый круг. В компоненте Шевченко, все тоже самое.

Предложения по фиксу принимаются. Хочется всего сразу.

PS.
И попутно вопрос: в той же функции ShowHint есть вызов CalcHintRect(1000,Text,nil), где "1000" это количество пикселей, и якобы если текст хинта в эти пиксели не влезает, он будет перенесен на вторую строку. Но на практике этого не происходит, почему?

Hint в ComboBox

TanoCariddi — Wed, 06 May 2009 20:26:09 +0000

TanoCariddi: Компонент очень хороший! Спасибо за него Игорю Шевченко.

Глюк, когда при первом наведении мышью на элемент list'а hint уходит на задний план, можно исправить, добавив (выделено жирным)

if NOT HideToolTip then
{ Если двигаться мышью в горизонтальном направлении на элементе, для которого
должен показываться Hint, то ActivateHint не стоит вызывать, если Hint уже
уже на экране }
if NOT (IsWindow(FListBoxTip.Handle) and
IsWindowVisible(FListBoxTip.Handle) and
(StrComp(PChar(FListBoxTip.Caption),PChar(ItemText)) = 0)) then begin
AdjustHintRect (ItemRect, ItemText);
FListBoxTip.ActivateHint(ItemRect, ItemText);
SetWindowPos(FListBoxTip.Handle,HWND_TOPMOST,ItemRect.Left,ItemRect.Top,FListBoxTip.Width,
FListBoxTip.Height,SWP_NOACTIVATE);
end;

Более того, данный компонент можно сделать визуальным, добавив (выделено жирным)

write SetHorizontalExtent default -1;
{/16.04.2002}
end;

procedure Register;

implementation
uses SysUtils;

procedure Register;
begin
RegisterComponents('Samples',[THSHintComboBox]);
end;

function RectWidth(R : TRect) : Integer;
begin
Result := R.Right - R.Left;
end;

Текст компонента полностью будет выглядеть так:

{
Наследник TComboBox, показывающий Hint для строки в ListBox'овой части,
не видимой целиком.

Автор: Игорь Шевченко
Дата создания: 13.04.2002

Ограничения:
Компонент проверялся при работе с значением Style: csDropDown, csDropDownList.
при остальных значениях работа не гарантируется :-)
Компонент не тестировался в режиме design-time.

История изменений:
16.04.2002 Исправлено поведение при закрытии, когда показан hint и ComboBox
закрывается по клавише Enter, Escape или F4. Теперь hint убирается.
Добавлено свойство HorizontalExtent, позволяющее устанавливать
горизонтальный Scrollbar в списке ComboBox'a. По умолчанию свойство
имеет значение -1, что запрещает установку горизонтального
ScrollBar'а.
}
unit HSHintComboBox;

interface
uses
Windows, Messages, Classes, Graphics, Controls, Forms, StdCtrls, AppEvnts;

type
TListBoxTip = class(THintWindow)
end;

TShowComboToolTipEvent = procedure (Sender : TObject;
const ToolTipText : String;
var HideToolTip : Boolean) of object;

THSHintComboBox = class(TComboBox)
// THSHintComboBox = class(TComponent)
private
FListBoxTip : TListBoxTip;
FListHandle : HWND;
FListWndProcInstance : TFarProc;
FOldListWndProc : TFarProc;
FOnListMouseMove: TMouseMoveEvent;
FOnShowComboToolTip: TShowComboToolTipEvent;
FShowToolTips: Boolean;
FHorizontalExtent: Integer;
procedure ListWndProc (var Message : TMessage);
function ListBoxItemAtPos (I : Integer) : String;
function ListBoxItemRectAtPos (I : Integer; AText : String) : TRect;
procedure SetShowToolTips(const Value: Boolean);
procedure SetHorizontalExtent(const Value: Integer);
protected
procedure DoListMouseMove (Shift: TShiftState; X, Y: Integer); dynamic;
procedure DoShowComboToolTip (const ToolTipText : String;
var HideToolTip : Boolean); dynamic;
procedure WndProc (var Message: TMessage); override;
{16.04.2002}
procedure CreateParams (var Params : TCreateParams); override;
procedure CreateWnd; override;
{/16.04.2002}
public
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
{ Handle окна ListBox'а, являющегося частью ComboBox'a }
property HSListHandle : HWND read FListHandle;
{ Показывать ли Hint для строк, не видимых целиком в ListBox'е }
property ShowToolTips : Boolean read FShowToolTips
write SetShowToolTips default true;
{ Событие при движении мыши по ListBox'у. Так как ListBox захватывает
(Captured) мышь, то координаты курсора в этом событии могут быть за
пределами клентской части ListBox'а }
property OnListMouseMove : TMouseMoveEvent read FOnListMouseMove
write FOnListMouseMove;
{ Событие при показе Hint'а для ListBox'а. Установив HideHint в True,
можно запретить показ конкретного Hint'а }
property OnShowComboToolTip : TShowComboToolTipEvent
read FOnShowComboToolTip write FOnShowComboToolTip;
{16.04.2002}
property HorizontalExtent : Integer read FHorizontalExtent
write SetHorizontalExtent default -1;
{/16.04.2002}
end;

procedure Register;

implementation
uses SysUtils;

procedure Register;
begin
RegisterComponents('Samples',[THSHintComboBox]);
end;

function RectWidth(R : TRect) : Integer;
begin
Result := R.Right - R.Left;
end;

function RectHeight(R : TRect) : Integer;
begin
Result := R.Bottom - R.Top;
end;

{ THSHintComboBox }

constructor THSHintComboBox.Create(AOwner: TComponent);
begin
inherited;
FListBoxTip := TListBoxTip.Create(Self);
FListBoxTip.Color := clInfoBk;
FListWndProcInstance := MakeObjectInstance(ListWndProc);
FShowToolTips := true;
FHorizontalExtent := -1;
end;

destructor THSHintComboBox.Destroy;
begin
if (FListHandle <> 0) AND IsWindow(FListHandle) then
SetWindowLong(FListHandle, GWL_WNDPROC, LongInt(FOldListWndProc));
FreeObjectInstance(FListWndProcInstance);
inherited;
end;

procedure THSHintComboBox.DoShowComboToolTip(const ToolTipText: String;
var HideToolTip : Boolean);
begin
if Assigned(FOnShowComboToolTip) then
FOnShowComboToolTip (Self, ToolTipText, HideToolTip);
end;

procedure THSHintComboBox.DoListMouseMove(Shift: TShiftState; X,
Y: Integer);

procedure AdjustHintRect (var R : TRect; const AHintStr : String);
var
DC : HDC;
OldFont : HFONT;
TextSize : SIZE;
begin
DC := GetDC (HWND_DESKTOP);
try
OldFont := SelectObject(DC, Screen.HintFont.Handle);
try
if (NOT GetTextExtentPoint32(DC, PChar(AHintStr), StrLen(PChar(AHintStr)), TextSize)) then
RaiseLastWin32Error;
Inc(TextSize.cx, 6);
Inc(TextSize.cy, 2);
R.Left := R.Left + 20;
R.Top := R.Top + 15;

if RectWidth® < TextSize.cx then
R.Right := R.Left + TextSize.cx;
if RectHeight® < TextSize.cy then
R.Bottom := R.Top + TextSize.cy;
finally
SelectObject(DC, OldFont);
end;
finally
ReleaseDC (HWND_DESKTOP, DC);
end;
end;

var R, ItemRect : TRect;
I : Integer;
ItemText : String;
HideToolTip : Boolean;
begin
HideToolTip := True; { По умолчанию выключать Hint }
if FShowToolTips then begin
Windows.GetClientRect(FListHandle, R);
{ X и Y являются координатами клиента (в данном случае, ListBox }
if PtInRect(R, Point(X,Y)) AND (Shift = []) then begin
{ Определим, помещается ли текущая строка целиком в область ListBox }
I := SendMessage(FListHandle, LB_ITEMFROMPOINT, 0, MakeLParam(X,Y));
if HiWord(I) <> 0 then
I := -1;
if I <> -1 then begin
ItemText := ListBoxItemAtPos(I);
ItemRect := ListBoxItemRectAtPos(I, ItemText);
if RectWidth(ItemRect) > RectWidth® then begin
{ Надо показывать Hint, так как строка не помещается целиком
в клиентскую область ListBox }
Windows.ClientToScreen(FListHandle, ItemRect.TopLeft);
Windows.ClientToScreen(FListHandle, ItemRect.BottomRight);
Dec(ItemRect.Left, 3);
Inc(ItemRect.Right, 6);
HideToolTip := false; { Не надо гасить hint }
DoShowComboToolTip (ItemText, HideToolTip); { Для возможности
отображения строки Hint дополнительно
в другом месте или запрета
конкретного Hint'а}
{16.04.2002}
if NOT HideToolTip then
{ Если двигаться мышью в горизонтальном направлении на элементе, для которого
должен показываться Hint, то ActivateHint не стоит вызывать, если Hint уже
уже на экране }
if NOT (IsWindow(FListBoxTip.Handle) and
IsWindowVisible(FListBoxTip.Handle) and
(StrComp(PChar(FListBoxTip.Caption),PChar(ItemText)) = 0)) then begin
AdjustHintRect (ItemRect, ItemText);
FListBoxTip.ActivateHint(ItemRect, ItemText);
SetWindowPos(FListBoxTip.Handle,HWND_TOPMOST,ItemRect.Left,ItemRect.Top,FListBoxTip.Width,
FListBoxTip.Height,SWP_NOACTIVATE);
end;
{/16.04.2002}
end;
end;
end;
end;
if HideToolTip then
FListBoxTip.ReleaseHandle; { Не надо показывать Hint, если мышь за пределами
ListBox или строка видна целиком }
{ Если кому-то вздумается следить за перемещениями мыши в области ListBox.
Я при отладке использовал это событие для отображения координат мыши }
if Assigned(FOnListMouseMove) then
FOnListMouseMove(Self, Shift, X, Y);
end;

function THSHintComboBox.ListBoxItemAtPos(I: Integer): String;
var
L : Integer;
begin
if I <> -1 then begin
L := SendMessage(FListHandle, LB_GETTEXTLEN, I, 0);
SetLength(Result, L+1); { +1 на нулевой символ в конце строки }
SendMessage(FListHandle, LB_GETTEXT, I, Integer(PChar(Result)));
end else
Result := '';
end;

function THSHintComboBox.ListBoxItemRectAtPos(I: Integer;
AText: String): TRect;
var
DC : HDC;
OldFont : HFONT;
begin
Result := Rect(0, 0, 0, 0);
if (I <> -1) AND (SendMessage(FListHandle, LB_GETITEMRECT, I,
Integer(@Result)) <> LB_ERR) then begin
DC := GetDC(FListHandle);
try
OldFont := SelectObject(DC, Font.Handle);
try
DrawText(DC, PChar(AText), -1, Result, DT_CALCRECT);
finally
SelectObject(DC, OldFont);
end;
finally
ReleaseDC(FListHandle, DC);
end;
end;
end;

procedure THSHintComboBox.ListWndProc(var Message: TMessage);
begin
case Message.Msg of
WM_MOUSEMOVE:
with TWMMouseMove(Message) do
DoListMouseMove(KeysToShiftState(Keys), XPos, YPos);
{16.04.2002}
{ Как выяснилось, при нажатии Esc или Enter на выбранном элементе, который
показывает Hint, ComboBox закрывается, а Hint остается. :-(
Сообщение SHOWWINDOW с WPARAM=0 гарантировано выдается, когда закрывается
окно, так что это место можно использовать для гашения Hint'a }
WM_SHOWWINDOW:
if Message.WParam = 0 then
FListBoxTip.ReleaseHandle();
{/16.04.2002}
end;
with Message do
Result := CallWindowProc(FOldListWndProc, FListHandle, Msg, WParam, LParam);
end;

procedure THSHintComboBox.SetShowToolTips(const Value: Boolean);
begin
FShowToolTips := Value;
end;

procedure THSHintComboBox.WndProc(var Message: TMessage);
begin
if (Message.Msg = WM_CTLCOLORLISTBOX) AND (FListHandle = 0) then begin
FListHandle := HWND(Message.LParam);
FOldListWndProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
SetWindowLong(FListHandle,
GWL_WNDPROC, LongInt(FListWndProcInstance));
end;
inherited;
end;

{16.04.2002}
procedure THSHintComboBox.CreateParams(var Params: TCreateParams);
begin
inherited;
if FHorizontalExtent <> -1 then
with Params do
Style := Style OR WS_HSCROLL;
end;

procedure THSHintComboBox.SetHorizontalExtent(const Value: Integer);
begin
if (FHorizontalExtent <> Value) then begin
FHorizontalExtent := Value;
if NOT (csLoading in ComponentState) then
RecreateWnd();
end;
end;

procedure THSHintComboBox.CreateWnd;
begin
inherited;
if FHorizontalExtent <> -1 then
Perform(CB_SETHORIZONTALEXTENT, FHorizontalExtent, 0);
end;
{/16.04.2002}

end.

Hint в ComboBox

--Ins-- — Wed, 27 Feb 2008 14:29:51 +0000

--Ins--: Для кучи, выложу свое решение, написанное некогда давно, также под влиянием кода Игоря Шевченко. Идея только несколько отличается - вместо потомка TComboBox - неоконный компонент, который нужно просто бросить на любую форму, и все ComboBox-ы начнут показывать Hint

unit ComboBoxPatch;

interface

uses Windows, Messages, SysUtils, Classes, Controls, Graphics, AppEvnts;

type

EComboBoxPatchException = class(Exception);

TComboBoxPatch = class(TComponent)

private

FHintWnd: THintWindow;

FCanvas: TCanvas;

FAppEvnts: TApplicationEvents;

FHintIndex: Integer;

FActive: Boolean;

FAlwaysShowHint: Boolean;

procedure AdjustHint(Wnd: HWND; Point: TPoint);

procedure DoIdle(Sender: TObject; var Done: Boolean);

procedure ShowHint(Origin: TPoint; Text: String);

procedure HideHint;

procedure SetActive(const Value: Boolean);

public

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

RSOnlyOneComboBoxPatch = 'Only one TComboBoxPatch can exist per application.';

var

GlobalPatch: TComboBoxPatch = nil;

procedure Register;

implementation

uses Forms;

procedure Register;

begin

RegisterComponents('Samples',[TComboBoxPatch]);

end;

{ TComboBoxPatch }

procedure TComboBoxPatch.AdjustHint(Wnd: HWND; Point: TPoint);

var

HintPt: TPoint;

ItemRect: TRect;

Item, TextWidth: Integer;

buf: array[0..127] of Char;

begin

Windows.ScreenToClient(Wnd,Point);

Item:=SendMessage(Wnd,LB_ITEMFROMPOINT,0,lParam(PointToSmallPoint(Point)));

if (Item and {text}010000 <> {text}010000) and (Item <> FHintIndex) then begin

FHintIndex:=Item;

SendMessage(Wnd,LB_GETTEXT,Item,Integer(@buf));

SendMessage(Wnd,LB_GETITEMRECT,Item,Integer(@ItemRect));

FCanvas.Handle:=GetDC(Wnd);

TextWidth:=FCanvas.TextWidth(buf);

ReleaseDC(Wnd,FCanvas.Handle);

FCanvas.Handle:=0;

if FAlwaysShowHint or ((not FAlwaysShowHint) and (ItemRect.Right < TextWidth)) then begin

HintPt:=ItemRect.TopLeft;

Windows.ClientToScreen(Wnd,HintPt);

ShowHint(HintPt,buf);

end

else begin

HideHint;

end;

end

else begin

if Item < 0 then HideHint;

end;

constructor TComboBoxPatch.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

if Assigned(GlobalPatch) then begin

raise EComboBoxPatchException.Create(RSOnlyOneComboBoxPatch);

end

else begin

GlobalPatch:=Self;

end;

FHintIndex:=-1;

FHintWnd:=THintWindow.Create(Self);

FHintWnd.Color:=Application.HintColor;

FCanvas:=TCanvas.Create;

FAppEvnts:=TApplicationEvents.Create(Self);

FAlwaysShowHint:=false;

Active:=true;

end;

destructor TComboBoxPatch.Destroy;

begin

GlobalPatch:=nil;

FCanvas.Free;

FAppEvnts.Free;

FHintWnd.Free;

inherited Destroy;

end;

procedure TComboBoxPatch.DoIdle(Sender: TObject; var Done: Boolean);

var

Pt: TPoint;

buf: array[0..127] of Char;

Wnd: HWND;

begin

GetCursorPos(Pt);

Wnd:=WindowFromPoint(Pt);

if Wnd <> 0 then begin

GetClassName(Wnd,buf,SizeOf(buf));

if buf = 'ComboLBox' then begin

AdjustHint(Wnd,Pt);

end

else begin

HideHint;

end;

procedure TComboBoxPatch.HideHint;

begin

FHintWnd.ReleaseHandle;

FHintIndex:=-1;

end;

procedure TComboBoxPatch.SetActive(const Value: Boolean);

begin

if Value <> FActive then begin

FActive:=Value;

if Value then FAppEvnts.OnIdle:=DoIdle else FAppEvnts.OnIdle:=nil;

end;

procedure TComboBoxPatch.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;

end.

Hint в ComboBox

Megatron — Wed, 27 Feb 2008 14:22:59 +0000

Megatron: Savek У меня тоже есть этот пример вот только, он почему то глючит когда наводишь курсор на первую длинную строку, то Hint выскакивает за выпадающимся меню ComboBox, а потом все нормально работает и этот пример работает только с Style: csDropDown, csDropDownList. :(

Hint в ComboBox

Rulikkk — Wed, 27 Feb 2008 12:09:58 +0000

Rulikkk: Savek, мне кажется правильнее было бы указать на сайт Delphikingdom, потому что впервые этот класс появился, кажется, там.

Hint в ComboBox

Savek — Wed, 27 Feb 2008 11:53:23 +0000

Savek: Посмотри в DW5000, там есть готовый проект

Добавлено 27.02.08, 11:56
Собственно вот он:

{

Наследник TComboBox, показывающий Hint для строки в ListBox'овой части,

не видимой целиком.

Автор: Игорь Шевченко

Дата создания: 13.04.2002

Ограничения:

Компонент проверялся при работе с значением Style: csDropDown, csDropDownList.

при остальных значениях работа не гарантируется :-)

Компонент не тестировался в режиме design-time.

История изменений:

16.04.2002 Исправлено поведение при закрытии, когда показан hint и ComboBox

закрывается по клавише Enter, Escape или F4. Теперь hint убирается.

Добавлено свойство HorizontalExtent, позволяющее устанавливать

горизонтальный Scrollbar в списке ComboBox'a. По умолчанию свойство

имеет значение -1, что запрещает установку горизонтального

ScrollBar'а.

}

unit HSHintComboBox;

interface

uses

Windows, Messages, Classes, Graphics, Controls, Forms, StdCtrls;

type

TListBoxTip = class(THintWindow)

end;

TShowComboToolTipEvent = procedure (Sender : TObject;

const ToolTipText : String;

var HideToolTip : Boolean) of object;

THSHintComboBox = class(TComboBox)

private

FListBoxTip : TListBoxTip;

FListHandle : HWND;

FListWndProcInstance : TFarProc;

FOldListWndProc : TFarProc;

FOnListMouseMove: TMouseMoveEvent;

FOnShowComboToolTip: TShowComboToolTipEvent;

FShowToolTips: Boolean;

FHorizontalExtent: Integer;

procedure ListWndProc (var Message : TMessage);

function ListBoxItemAtPos (I : Integer) : String;

function ListBoxItemRectAtPos (I : Integer; AText : String) : TRect;

procedure SetShowToolTips(const Value: Boolean);

procedure SetHorizontalExtent(const Value: Integer);

protected

procedure DoListMouseMove (Shift: TShiftState; X, Y: Integer); dynamic;

procedure DoShowComboToolTip (const ToolTipText : String;

var HideToolTip : Boolean); dynamic;

procedure WndProc (var Message: TMessage); override;

{16.04.2002}

procedure CreateParams (var Params : TCreateParams); override;

procedure CreateWnd; override;

{/16.04.2002}

public

constructor Create (AOwner : TComponent); override;

destructor Destroy; override;

{ Handle окна ListBox'а, являющегося частью ComboBox'a }

property HSListHandle : HWND read FListHandle;

{ Показывать ли Hint для строк, не видимых целиком в ListBox'е }

property ShowToolTips : Boolean read FShowToolTips

write SetShowToolTips default true;

{ Событие при движении мыши по ListBox'у. Так как ListBox захватывает

(Captured) мышь, то координаты курсора в этом событии могут быть за

пределами клентской части ListBox'а }

property OnListMouseMove : TMouseMoveEvent read FOnListMouseMove

write FOnListMouseMove;

{ Событие при показе Hint'а для ListBox'а. Установив HideHint в True,

можно запретить показ конкретного Hint'а }

property OnShowComboToolTip : TShowComboToolTipEvent

read FOnShowComboToolTip write FOnShowComboToolTip;

{16.04.2002}

property HorizontalExtent : Integer read FHorizontalExtent

write SetHorizontalExtent default -1;

{/16.04.2002}

end;

implementation

uses SysUtils;

function RectWidth(R : TRect) : Integer;

begin

Result := R.Right - R.Left;

end;

function RectHeight(R : TRect) : Integer;

begin

Result := R.Bottom - R.Top;

end;

{ THSHintComboBox }

constructor THSHintComboBox.Create(AOwner: TComponent);

begin

inherited;

FListBoxTip := TListBoxTip.Create(Self);

FListBoxTip.Color := clInfoBk;

FListWndProcInstance := MakeObjectInstance(ListWndProc);

FShowToolTips := true;

FHorizontalExtent := -1;

end;

destructor THSHintComboBox.Destroy;

begin

if (FListHandle <> 0) AND IsWindow(FListHandle) then

SetWindowLong(FListHandle, GWL_WNDPROC, LongInt(FOldListWndProc));

FreeObjectInstance(FListWndProcInstance);

inherited;

end;

procedure THSHintComboBox.DoShowComboToolTip(const ToolTipText: String;

var HideToolTip : Boolean);

begin

if Assigned(FOnShowComboToolTip) then

FOnShowComboToolTip (Self, ToolTipText, HideToolTip);

end;

procedure THSHintComboBox.DoListMouseMove(Shift: TShiftState; X,

Y: Integer);

procedure AdjustHintRect (var R : TRect; const AHintStr : String);

var

DC : HDC;

OldFont : HFONT;

TextSize : SIZE;

begin

DC := GetDC (HWND_DESKTOP);

try

OldFont := SelectObject(DC, Screen.HintFont.Handle);

try

if (NOT GetTextExtentPoint32(DC, PChar(AHintStr), StrLen(PChar(AHintStr)), TextSize)) then

RaiseLastWin32Error;

Inc(TextSize.cx, 6);

Inc(TextSize.cy, 2);

if RectWidth(R) < TextSize.cx then

R.Right := R.Left + TextSize.cx;

if RectHeight(R) < TextSize.cy then

R.Bottom := R.Top + TextSize.cy;

finally

SelectObject(DC, OldFont);

end;

finally

ReleaseDC (HWND_DESKTOP, DC);

end;

var R, ItemRect : TRect;

I : Integer;

ItemText : String;

HideToolTip : Boolean;

begin

HideToolTip := True; { По умолчанию выключать Hint }

if FShowToolTips then begin

Windows.GetClientRect(FListHandle, R);

{ X и Y являются координатами клиента (в данном случае, ListBox }

if PtInRect(R, Point(X,Y)) AND (Shift = []) then begin

{ Определим, помещается ли текущая строка целиком в область ListBox }

I := SendMessage(FListHandle, LB_ITEMFROMPOINT, 0, MakeLParam(X,Y));

if HiWord(I) <> 0 then

I := -1;

if I <> -1 then begin

ItemText := ListBoxItemAtPos(I);

ItemRect := ListBoxItemRectAtPos(I, ItemText);

if RectWidth(ItemRect) > RectWidth(R) then begin

{ Надо показывать Hint, так как строка не помещается целиком

в клиентскую область ListBox }

Windows.ClientToScreen(FListHandle, ItemRect.TopLeft);

Windows.ClientToScreen(FListHandle, ItemRect.BottomRight);

Dec(ItemRect.Left, 3);

Inc(ItemRect.Right, 6);

HideToolTip := false; { Не надо гасить hint }

DoShowComboToolTip (ItemText, HideToolTip); { Для возможности

отображения строки Hint дополнительно

в другом месте или запрета

конкретного Hint'а}

{16.04.2002}

if NOT HideToolTip then

{ Если двигаться мышью в горизонтальном направлении на элементе, для которого

должен показываться Hint, то ActivateHint не стоит вызывать, если Hint уже

уже на экране }

if NOT (IsWindow(FListBoxTip.Handle) and

IsWindowVisible(FListBoxTip.Handle) and

(StrComp(PChar(FListBoxTip.Caption),PChar(ItemText)) = 0)) then begin

AdjustHintRect (ItemRect, ItemText);

FListBoxTip.ActivateHint(ItemRect, ItemText);

end;

{/16.04.2002}

end;

if HideToolTip then

FListBoxTip.ReleaseHandle; { Не надо показывать Hint, если мышь за пределами

ListBox или строка видна целиком }

{ Если кому-то вздумается следить за перемещениями мыши в области ListBox.

Я при отладке использовал это событие для отображения координат мыши }

if Assigned(FOnListMouseMove) then

FOnListMouseMove(Self, Shift, X, Y);

end;

function THSHintComboBox.ListBoxItemAtPos(I: Integer): String;

var

L : Integer;

begin

if I <> -1 then begin

L := SendMessage(FListHandle, LB_GETTEXTLEN, I, 0);

SetLength(Result, L+1); { +1 на нулевой символ в конце строки }

SendMessage(FListHandle, LB_GETTEXT, I, Integer(PChar(Result)));

end else

Result := '';

end;

function THSHintComboBox.ListBoxItemRectAtPos(I: Integer;

AText: String): TRect;

var

DC : HDC;

OldFont : HFONT;

begin

Result := Rect(0, 0, 0, 0);

if (I <> -1) AND (SendMessage(FListHandle, LB_GETITEMRECT, I,

Integer(@Result)) <> LB_ERR) then begin

DC := GetDC(FListHandle);

try

OldFont := SelectObject(DC, Font.Handle);

try

DrawText(DC, PChar(AText), -1, Result, DT_CALCRECT);

finally

SelectObject(DC, OldFont);

end;

finally

ReleaseDC(FListHandle, DC);

end;

procedure THSHintComboBox.ListWndProc(var Message: TMessage);

begin

case Message.Msg of

WM_MOUSEMOVE:

with TWMMouseMove(Message) do

DoListMouseMove(KeysToShiftState(Keys), XPos, YPos);

{16.04.2002}

{ Как выяснилось, при нажатии Esc или Enter на выбранном элементе, который

показывает Hint, ComboBox закрывается, а Hint остается. :-(

Сообщение SHOWWINDOW с WPARAM=0 гарантировано выдается, когда закрывается

окно, так что это место можно использовать для гашения Hint'a }

WM_SHOWWINDOW:

if Message.WParam = 0 then

FListBoxTip.ReleaseHandle();

{/16.04.2002}

end;

with Message do

Result := CallWindowProc(FOldListWndProc, FListHandle, Msg, WParam, LParam);

end;

procedure THSHintComboBox.SetShowToolTips(const Value: Boolean);

begin

FShowToolTips := Value;

end;

procedure THSHintComboBox.WndProc(var Message: TMessage);

begin

if (Message.Msg = WM_CTLCOLORLISTBOX) AND (FListHandle = 0) then begin

FListHandle := HWND(Message.LParam);

FOldListWndProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));

SetWindowLong(FListHandle,

GWL_WNDPROC, LongInt(FListWndProcInstance));

end;

inherited;

end;

{16.04.2002}

procedure THSHintComboBox.CreateParams(var Params: TCreateParams);

begin

inherited;

if FHorizontalExtent <> -1 then

with Params do

Style := Style OR WS_HSCROLL;

end;

procedure THSHintComboBox.SetHorizontalExtent(const Value: Integer);

begin

if (FHorizontalExtent <> Value) then begin

FHorizontalExtent := Value;

if NOT (csLoading in ComponentState) then

RecreateWnd();

end;

procedure THSHintComboBox.CreateWnd;

begin

inherited;

if FHorizontalExtent <> -1 then

Perform(CB_SETHORIZONTALEXTENT, FHorizontalExtent, 0);

end;

{/16.04.2002}

end.

Hint в ComboBox

Megatron — Tue, 26 Feb 2008 17:31:42 +0000

Megatron: Вот вчера столкнулся с проблемой вывода подсказок для ComboBox если в него строка не влазит.
Почитав советы по Delphi понял что ничего непонял :no: Попробовал написать как описано ничего не получилось плюнул на все и забил.
Но всеже... вот пример с этих советов:

В своем компоненте объявите FTipHint:

type

TVSComboBox = class(TCustomComboBox)

…

private

FHint: THintWindow;

…

protected

procedure WMCTLCOLORLISTBOX(var Message: TMessage); message WM_CTLCOLORLISTBOX;

и не забудьте выполнить инициализацию в конструкторе вашего компонента:

begin

inherited Create(AOwner);

FHint := THintWindow.Create(Self);

Чтобы получить информацию об активной строке в выпадающем списке ComboBox перехватите сообщение WM_CTLCOLORLISTBOX. В процедуре сообщения анализируйте - если длина строки больше ширины выпадающего списка – передайте "длинную" строку в ваш Hint и активируйте его:

FHint.ActivateHint(TextRC, Items[ItemIndex]);

где
TextRC – прямоугольник для строки подсказки
Items[ItemIndex] – "длинная" строка из выпадающего списка

Если активная строка в выпадающем списке "короткая" – спрячьте Hint:

FHint.ReleaseHandle;

Если знаете то приведите пожалуйста небольшой пример как это все воплотить и как его правильно написать, а то я немогу въехать в слова автора "В своем компоненте объявите FTipHint:" а про компонент FTipHint: ни слова и вообще накидано по кусках а разобраться и сложить все в кучу не получается :wall:

Заранее спасибо.