Почему не работает ScrollBar?
От: Sclex  
Дата: 08.06.06 16:06
Оценка:
Есть программа на дельфи, которая использует полосу прокрутки. Но почему-то бегунок нельзя перетянуть мышью на новую позицию, он остается на месте. В чем ошибка?

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.
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.