Сори что в закрытую тему стучу. Большое спаибо чуть модефицировал код даный Grider и получилось то что доктор прописал. Но возникла проблема. Сайт находится локально. Я убрал полосы прокрутки с браузера. При попытке скролинга страницы что загружается первой все работает как часы. при переходе на следующюю страницу не работает. В чем могут быть причины. | Код |
....
procedure HideWBScrolls;
var
lDocument: IHTMLDocument2;
lBody: IHTMLElement;
lStyle: IHTMLStyle2;
begin
if Assigned(Form1.WebBrowser1.Document) and
(Succeeded(Form1.WebBrowser1.Document.QueryInterface(IHTMLDocument2,
lDocument))) then
begin
lBody := lDocument.Body;
if Assigned(lBody) and Assigned(lBody.style) and
Succeeded(lBody.Style.QueryInterface(IID_IHTMLStyle2, lStyle)) then
begin
lStyle.overflowX := 'hidden'; //??????? ?????????????? ?????
lStyle.overflowY := 'hidden'; //??????? ???????????? ?????
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
y:=0;
nowstr:=0;
with TRegistry.Create do
try
rootkey := HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\UaKiosk', False);
StartURL:=Readstring('IndexHTML');
CloseKey;
finally
Free;
end;
WebBrowser1.Navigate(StartURL);
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_Hide);
Form1.WebBrowser1.BringToFront
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_Normal);
end;
...
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
HideWBScrolls;
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var i,MsT:Double;
j:Integer;
begin
if key='+' then WebBrowser1.ScrollBy(0, -1);
if key='-' then
begin
i:=Variant(WebBrowser1.Document).documentElement.scrollTop;
if i=0 then Variant(WebBrowser1.Document).documentElement.scrollTop:=1;
if (Variant(WebBrowser1.Document).documentElement.scrollTop=1)or(i>0) then //èëè ÷åðåç ïðîâåðêó Variant(WB.Document).compatMode
begin
//!DOCTYPE - Oê!
Variant(WebBrowser1.Document).documentElement.scrollTop:=i;
MsT:=Variant(WebBrowser1.Document).documentElement.scrollHeight-Variant(WebBrowser1.Document).documentElement.clientHeight;
Caption:='Max_scrollTop: '+FloatToStr(MsT);
Caption:=Caption+';'+'Cur_scrollTop: '+FloatToStr(Variant(WebBrowser1.Document).documentElement.scrollTop);
//Èçìåíèì íå ìíîãî scroll
Variant(WebBrowser1.Document).documentElement.style.setAttribute('scrollbar3dLightColor','red',0);
//Ïî ïåðåìåùàåì
for j:=0 to Round(Mst) do
begin
Variant(WebBrowser1.Document).documentElement.scrollTop:=j;
Application.ProcessMessages;
Sleep(5);
end;
end else
begin
//!DOCTYPE - Ôó!
MsT:=IHTMLDocument2(WebBrowser1.Document).body.getAttribute('scrollHeight',0)-IHTMLDocument2(WebBrowser1.Document).body.getAttribute('clientHeight',0);
Caption:='Max_scrollTop: '+FloatToStr(MsT);
Caption:=Caption+';'+'Cur_scrollTop: '+FloatToStr(IHTMLDocument2(WebBrowser1.Document).body.getAttribute('scrollTop',0));
//Èçìåíèì íå ìíîãî scroll
IHTMLDocument2(WebBrowser1.Document).body.setAttribute('scrollbar3dLightColor','red',0);
//Ïî ïåðåìåùàåì
for j:=0 to Round(Mst) do
begin
IHTMLDocument2(WebBrowser1.Document).body.setAttribute('scrollTop',j,0);
Application.ProcessMessages;
Sleep(5);
end;
end;
End;
end;
procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
begin
if assigned(WebBrowser1.Document) then
Caption:=IHTMLDocument2(WebBrowser1.Document).readyState;
end;
......
|
--------------------
Be not afraid of growing slowly, be afraid only of standing still! |
TWebBrowser нужно подменить скроллеры, или предложите свое решение проблемы! 
Загрузка ...
