Есть программа на дельфи, которая использует полосу прокрутки. Но почему-то бегунок нельзя перетянуть мышью на новую позицию, он остается на месте. В чем ошибка?

program Dir;
uses
 Windows,
  Messages,
  shellapi;

const
  sClassName = 'sTaskBarHandlerWindow';  // Имя класса окна
var
  hWnd: THandle;                                       //индентификатор окна
  WndClass: TWndClass;                             //структура WndClass
  Msg: TMsg;                                             //структура для принятия сообщений

function WindowProc(hWnd: THandle; uMsg, wParam, lParam: Integer): Integer; {функция окна}
  stdcall; export;
var
  dc : hdc;
  ps : tPaintStruct;
  rect : TRect;
  si : ScrollInfo;
begin
  Result := 0;
    case uMsg of
      WM_CREATE:
        begin
          {ShowScrollBar(hWnd,SB_BOTH,true);}
          SetScrollRange(hWnd,SB_VERT,0,10000,false);
          SetScrollPos(hWnd,SB_VERT,8000,true);
          {EnableScrollBar(hWnd,SB_VERT,ESB_ENABLE_BOTH);
          with si do
          begin
            cbSize:=SizeOf(si);
            fMask := SIF_RANGE;
            nMin := 0;
            nMax := 10000;
          end;
          SetScrollInfo(hWnd,SB_VERT,si,true);}
        end;
      WM_VSCROLL:
        begin
          {MessageBox(hWnd,'text','text',mb_ok);}
        end;
      WM_DESTROY: //если uMsg равна WM_DESTROY(код закрытия окна) то закрываемся
        begin
          halt(0);
        end;
      WM_PAINT:
        begin
          dc := BeginPaint(hWnd,ps);
          rect.top := 0;
          rect.left := 0;
          rect.bottom := 100;
          rect.right := 100;
          DrawText(dc,'Sclex test 1234567890',-1,rect,dt_WordBreak);
          EndPaint(hWnd,ps);
      end;
  end;
  Result := DefWindowProc(hWnd, uMsg, wParam, lParam); //удалить остальные сообщения
end;

begin
  FillChar(WndClass, SizeOf(WndClass), 0); //заполняем структуру нулями
  with WndClass do begin
    hInstance      := SysInit.hInstance; //Обязательный параметр, индентификатор вашего приложения
    lpszClassName  := sClassName; //имя класса
    lpfnWndProc    := @WindowProc; //имя функции окна
    hbrBackground      := GetStockObject(LTGRAY_BRUSH); //способ заливки клиентской области (об этом позже)
    end;
  RegisterClass(WndClass); //регистрируем класс
  hWnd := CreateWindow(sClassName, '', WS_OVERLAPPEDWINDOW+WS_VSCROLL, 200, 200, 300, 300, 0, 0, hInstance, NIL); //создаем окно
  if hWnd = 0 then begin //если произошла ошибка, то выходим
    MessageBox(0, 'Initialisation failed', NIL, ID_OK);
    Exit;
  end;
  ShowWindow(hWnd, SW_normal); //показываем окно
   while GetMessage(Msg, HWnd, 0, 0) do begin //получаем сообщение
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
   Halt(Msg.wParam);
end.

Здравствуйте, Sclex, Вы писали:

S>Есть программа на дельфи, которая использует полосу прокрутки. Но почему-то бегунок нельзя перетянуть мышью на новую позицию, он остается на месте. В чем ошибка?

Ошибка в том, что ты никак не обрабатываешь сообщение WM_VSCROLL, посылаемое твоей оконной процедуре. Хотя в MSDN ясно написано:

WM_VSCROLL

...

Remarks

The SB_THUMBTRACK request code is typically used by applications that provide feedback as the user drags the scroll box.

If an application scrolls the content of the window, it must also reset the position of the scroll box by using the SetScrollPos function.

Т.е. ты должен явно вызывать SetScrollPos, чтобы установить новую позицию ползунка.

Вот так это должно примерно выглядеть:

program Dir;

{$APPTYPE CONSOLE}

uses
 Windows,
  Messages,
  shellapi;

function Min(A, B: Integer): Integer;
begin
    if A < B then
         Result := A
    else Result := B;
end;

function Max(A, B: Integer): Integer;
begin
    if A > B then
         Result := A
    else Result := B;
end;

function GetTrackPos(hWnd: THandle; nBar: Integer): Integer;
var
    ScrollInfo: TScrollInfo;
begin
    FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
    with ScrollInfo do begin
        cbSize := SizeOf(ScrollInfo);
        fMask := SIF_TRACKPOS;
    end;
    GetScrollInfo(hWnd, nBar, ScrollInfo);
    Result := ScrollInfo.nTrackPos;
end;

procedure UpdateScrollPos(hWnd: THandle; ScrollCode: Word);
var
    Delta, MinPos, MaxPos, NewPos: Integer;
begin
    case ScrollCode of
        SB_THUMBPOSITION, SB_THUMBTRACK:
            SetScrollPos(hWnd, SB_VERT, GetTrackPos(hWnd, SB_VERT), True);
        else begin
            Delta := 0;
            GetScrollRange(hWnd, SB_VERT, MinPos, MaxPos);
            case ScrollCode of
                SB_PAGEUP:        Delta := -100;
                SB_PAGEDOWN:  Delta := +100;
                SB_LINEUP:    Delta := -10;
                SB_LINEDOWN:  Delta := +10;
                SB_BOTTOM:    Delta := MaxPos;
                SB_TOP:       Delta := -MaxPos;
            end;
            NewPos := GetScrollPos(hWnd, SB_VERT) + Delta;
            NewPos := Min(NewPos, MaxPos);
            NewPos := Max(NewPos, MinPos);
            SetScrollPos(hWnd, SB_VERT, NewPos, True);
        end;
    end;
end;

const
  sClassName = 'sTaskBarHandlerWindow';  // Eiy eeanna ieia
var
  hWnd: THandle;                                       //eiaaioeoeeaoi? ieia
  WndClass: TWndClass;                             //no?oeoo?a WndClass
  Msg: TMsg;                                             //no?oeoo?a aey i?eiyoey niiauaiee

function WindowProc(hWnd: THandle; uMsg, wParam, lParam: Integer): Integer; {ooieoey ieia}
  stdcall; export;
var
  dc : hdc;
  ps : tPaintStruct;
  rect : TRect;
  si : ScrollInfo;
begin
  Result := 0;
    case uMsg of
      WM_CREATE:
        begin
          SetScrollRange(hWnd,SB_VERT,0,10000,false);
          SetScrollPos(hWnd,SB_VERT,8000,true);
        end;
      WM_VSCROLL:
        begin
          UpdateScrollPos(hWnd, wParam and $0000FFFF);
          Result := 0;
          Exit;
        end;
      WM_DESTROY: //anee uMsg ?aaia WM_DESTROY(eia cae?uoey ieia) oi cae?uaaainy
        begin
          halt(0);
        end;
      WM_PAINT:
        begin
          dc := BeginPaint(hWnd,ps);
          rect.top := 0;
          rect.left := 0;
          rect.bottom := 100;
          rect.right := 100;
          DrawText(dc,'Sclex test 1234567890',-1,rect,dt_WordBreak);
          EndPaint(hWnd,ps);
      end;
  end;
  Result := DefWindowProc(hWnd, uMsg, wParam, lParam); //oaaeeou inoaeuiua niiauaiey
end;

begin
  FillChar(WndClass, SizeOf(WndClass), 0); //caiieiyai no?oeoo?o ioeyie
  with WndClass do begin
    hInstance      := SysInit.hInstance; //Iaycaoaeuiue ia?aiao?, eiaaioeoeeaoi? aaoaai i?eei?aiey
    lpszClassName  := sClassName; //eiy eeanna
    lpfnWndProc    := @WindowProc; //eiy ooieoee ieia
    hbrBackground      := GetStockObject(LTGRAY_BRUSH); //niinia caeeaee eeeaioneie iaeanoe (ia yoii iic?a)
    end;
  RegisterClass(WndClass); //?aaeno?e?oai eeann
  hWnd := CreateWindow(sClassName, '', WS_OVERLAPPEDWINDOW+WS_VSCROLL, 200, 200, 300, 300, 0, 0, hInstance, NIL); //nicaaai ieii
  if hWnd = 0 then begin //anee i?iecioea ioeaea, oi auoiaei
    MessageBox(0, 'Initialisation failed', NIL, ID_OK);
    Exit;
  end;
  ShowWindow(hWnd, SW_normal); //iieacuaaai ieii
   while GetMessage(Msg, HWnd, 0, 0) do begin //iieo?aai niiauaiea
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
   Halt(Msg.wParam);
end.