|
Вопрос # 5 731/ вопрос решён / |
|
Здравствуйте, уважаемые эксперты!
Делаю компонент, наследник от TCustomControl, ведущий себя как PopupMenu, но с вертикальным скроллбаром, если элементов больше чем определенное число. В семерке всё нормально отображается, а в XP почему-то не прорисовываются у скроллбара стрелки вверх-вниз. Если по ним кликнуть мышкой, то они отрисовываются, но при следующем показе меню опять пропадают.
В приложении весь код, который относится к скроллбару и обработке прокрутки. В чем может быть дело, может кто-нить уже сталкивался с таким поведением? В аттаче лежит небольшой пример, на котором этот глюк проявляется. Если надо - могу скрины привести, как выглядит на XP.
Спасибо.
К вопросу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки вопроса)
Приложение: Переключить в обычный режим- <code>
- procedure TScrollPopupMenu.ShowScroll(Value: Boolean);
- begin
- if Value <> FScrollVisible then
- begin
- FScrollVisible := Value;
- FScrollOffset := 0;
- if not FLockRecreateWnd then
- begin
- RecreateWnd;
- FLockRecreateWnd := True;
- end;
- end;
- if Value then
- begin
- SetWindowLong(Handle, GWL_STYLE,
- GetWindowLong(Handle, GWL_STYLE) or WS_VSCROLL);
- UpdateScrollPos;
- end
- else
- SetWindowLong(Handle, GWL_STYLE,
- GetWindowLong(Handle, GWL_STYLE) and not WS_VSCROLL);
- end;
- procedure TScrollPopupMenu.UpdateScrollPos;
- var
- ScrollInfo : TScrollInfo;
- MaxOffset: Integer;
- begin
- MaxOffset := -1 * (FTotalHeight - ClientHeight);
- if FScrollOffset < MaxOffset then
- FScrollOffset := MaxOffset;
- if FScrollOffset > 0 then
- FScrollOffset := 0;
- ScrollInfo.cbSize := SizeOf(TScrollInfo);
- ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL or SIF_POS;
- ScrollInfo.nMin := 0;
- ScrollInfo.nPos := -FScrollOffset;
- ScrollInfo.nPage := ClientHeight;
- ScrollInfo.nMax := FTotalHeight;
- SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
- end;
- procedure TScrollPopupMenu.WMVScroll(var Msg: TWMVScroll);
- begin
- case Msg.ScrollCode of
- SB_LINEUP: Inc(FScrollOffset, FMenuItemHeight);
- SB_LINEDOWN: Dec(FScrollOffset, FMenuItemHeight);
- SB_PAGEUP: Inc(FScrollOffset, ClientWidth);
- SB_PAGEDOWN: Dec(FScrollOffset, ClientWidth);
- SB_THUMBPOSITION, SB_THUMBTRACK: FScrollOffset := Msg.Pos * -1;
- end;
- UpdateScrollPos;
- Repaint;
- end;
- </code>
 |
Вопрос задал: Lumen (статус: Посетитель)
Вопрос отправлен: 10 ноября 2011, 23:27
Состояние вопроса: решён, ответов: 0.
|
Мини-форум вопроса
Всего сообщений: 2; последнее сообщение — 13 ноября 2011, 02:30; участников в обсуждении: 1.
|
|
Lumen (статус: Посетитель), 12 ноября 2011, 10:19 [#1]:
Выглядит это как-то так:
Такое ощущение, будто сообщение отрисовки не приходит вовремя, может можно как-то самому перерисовать их?
http://dl.dropbox.com/u/31216763/Scroll.PNG
ЗЫ: а картинку можно как-нить к сообщению прикрепить?
|
|
|
Lumen (статус: Посетитель), 13 ноября 2011, 02:30 [#2]:
Решено.
Косяк был в обработчике WM_NCPAINT меню. Исправил следующим образом:procedure TSubPopupMenu.WMNCPaint(var Message: TMessage);
var
ADrawRect: TRect;
DC: HDC;
Details: TThemedElementDetails;
begin
inherited;
if not ThemeServices.ThemesEnabled then Exit;
with Self do
begin
GetWindowRect(Handle, ADrawRect);
OffsetRect(ADrawRect, -ADrawRect.Left, -ADrawRect.Top);
DC := GetWindowDC(Handle);
try
with ADrawRect do
ExcludeClipRect(DC, Left + 1, Top + 1, Right - 1, Bottom - 1);
Details := ThemeServices.GetElementDetails(teEditTextNormal);
ThemeServices.DrawElement(DC, Details, ADrawRect);
finally
ReleaseDC(Handle, DC);
end;
end;
end;
|
13 ноября 2011, 02:32: Статус вопроса изменён на решённый (изменил автор вопроса — Lumen)
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
