Текущий архив: 2005.03.06;
Скачать: CL | DM;

Вниз

Подсказка к CheckBox   Найти похожие ветки 

← →
Goorus ©   (2005-01-22 13:08) [0]

На сайте Королевство Делфи нашёл пример компонента, потомка от TCheckBox, у которого есть подсказка к выпадающему списку. Так вот у этого компонента есть один недостаток, когда первый раз открываешь выпадающий список, то подсказка может оказать за ним, и её будет не видно. Вот код:

...
FListBoxTip:THintWindow;
...

procedure THSComboBox.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;
 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);
         DoShowComboToolTip (ItemText, HideToolTip);
{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;
     end;
   end;
 end;
 if HideToolTip then FListBoxTip.ReleaseHandle;
                  { Не надо показывать Hint, если мышь за пределами
                                ListBox или строка видна целиком }
 { Если кому-то вздумается следить за перемещениями мыши в области ListBox.
   Я при отладке использовал это событие для отображения координат мыши }
 if Assigned(FOnListMouseMove) then FOnListMouseMove(Self, Shift, X, Y);
end;

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

end;

Пробывал BringToFront, но в этом случае список теряет фокус, а следовательно закрывается (.

---

← →
Unleashed   (2005-01-23 04:08) [1]

попробуйте вставить setforegroundwindow(FListBoxTip.Handle) после activatehint

---

← →
Goorus ©   (2005-01-23 04:47) [2]

Та же история, что и при BringToFront - выпадающий список закрывается (
Похоже прийдётся переписывать событие WM_KILLFOCUS.

---

← →
GrayFace ©   (2005-01-23 06:20) [3]

А если SetWindowPos(FListBoxTip.Handle,HWND_TOPMOST,0,0,0,0,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

---

← →
Goorus ©   (2005-01-24 03:44) [4]

Помогло. Спасибо :)

---

Страницы: 1 вся ветка

Текущий архив: 2005.03.06;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.042 c