Здравствуйте, Sclex, Вы писали:
S>Есть программа на дельфи, которая использует полосу прокрутки. Но почему-то бегунок нельзя перетянуть мышью на новую позицию, он остается на месте. В чем ошибка?
Ошибка в том, что ты никак не обрабатываешь сообщение WM_VSCROLL, посылаемое твоей оконной процедуре. Хотя в MSDN ясно написано:
...
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.
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
It is always bad to give advices, but you will be never forgiven for a good one.
Oscar Wilde