VPF::Некорректное отображение ScrollBar'a

Ne1tr1n0

Дата 8.11.2011, 16:54 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 2
Всего: 8

Привет!

Делаю компонент, ведущий себя как PopupMenu, но с вертикальным скроллбаром. В семерке всё нормально отображается, а в XP почему-то не прорисовываются стрелки вверх-вниз. Если по ним кликнуть мышкой, то они отрисовываются, но при следующем показе меню опять пропадают.

Код


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;

Собсна это весь код, который относится к скроллбару и обработке прокрутки. В чем может быть дело, может кто-нить уже сталкивался с таким поведением? Здесь лежит небольшой пример, на котором этот глюк проявляется. Если надо - могу скрины привести, как выглядит на XP.

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

Ne1tr1n0

Дата 12.11.2011, 09:07 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 2
Всего: 8

Неужели никто не знает?
Выглядит это всё вот так: ощущение будто этим стрелочкам (не знаю как они правильно называются) не приходит в нужный момент сообщение об отрисовке, как его самому можно послать?
user posted image

Ne1tr1n0

Дата 13.11.2011, 01:25 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 120
Регистрация: 1.3.2009

Репутация: 2
Всего: 8

Решено.
Косяк был в обработчике WM_NCPAINT.
Переделал следующим образом:

Код


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

Это сообщение отредактировал(а) Ne1tr1n0 - 13.11.2011, 01:27

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »