Замена WebBrowser (Delphi 5)
Аллоха, ALL!
В этот знаменательный день 18 июня 2004 г.
пиво ударило мне в голову, и я наскреб:
Собственно subj ищу. Но что-бы по функциональности не уступал -
картинки, прогресс бар, статус бар и т.д.
Глючит, однако, WebBrowser. Может кто видел прогу - DelphiHiTech - там
при долгом ее юзаньи начинаются страшенные глюки сбиваются цвета,
размеры окон и выдаются всякие тупые собщеньица типа "Canvas does no allow drawing"
У меня тоже глючит, один раз прога стала выдавать такую фигню
"A Win32 API function" и кнопка OK.
Источник глюков - стопудово WebBrowser т.к. после его удаления с формы
и сопутствующих unit-ов глюки пропали.
Хотя может All мне подскажет - может я не так WebBrowser юзаю, вот код
процедурок которые я использую:
HistoryList: TStringList;
//WebBrowser
procedure TMainForm.FindAddress;
begin
WebBrowser.Stop;
UpdateCombo := True;
WebBrowser.Navigate(WideString(cbURLs.Text));
end;
procedure TMainForm.HomePageRequest(var Message: TMessage);
begin
cbURLs.Text := ExtractFilePath(Application.ExeName) + 'Blank.htm';
FindAddress;
Application.ProcessMessages;
cbURLs.Text := ExtractFilePath(Application.ExeName) + 'HomeProgram.htm';
FindAddress;
end;
procedure TMainForm.WebBrowserBeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var NewIndex: Integer;
begin
NewIndex := HistoryList.IndexOf(URL);
if NewIndex= - 1 then
begin
if (HistoryIndex >= 0) and (HistoryIndex < HistoryList.Count - 1) then
while HistoryList.Count > HistoryIndex do
HistoryList.Delete(HistoryIndex);
HistoryIndex := HistoryList.Add(URL);
end
else HistoryIndex := NewIndex;
if UpdateCombo then
begin
UpdateCombo := False;
NewIndex := cbURLs.Items.IndexOf(URL);
if NewIndex= - 1 then cbURLs.Items.Insert(0, URL)
else cbURLs.Items.Move(NewIndex, 0);
end;
if HistoryList.Count > 0 then btnPrevious.Enabled := HistoryIndex > 0
else btnPrevious.Enabled := False;
if btnPrevious.Enabled then btnPrevious.Hint := HistoryList[HistoryIndex -
1]
else btnPrevious.Hint := BackString;
if HistoryList.Count > 0 then btnNext.Enabled := HistoryIndex < HistoryList.Count
- 1
else btnNext.Enabled := False;
if btnNext.Enabled then btnNext.Hint := HistoryList[HistoryIndex + 1]
else btnNext.Hint := ForwardString;
cbURLs.Text := URL;
end;
procedure TMainForm.WebBrowserDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
{var Doc: IHTMLDocument2;
Element: IHTMLElement; }
begin
{Doc := IHTMLDocument2(TWebBrowser(Sender).Document);
if Doc = nil then Exit;
Element := Doc.body;
if Element = nil then Exit;
{case random(2) of
0:Element.style.borderStyle := 'none';
1:Element.style.borderStyle := '';
end;}
end;
procedure TMainForm.WebBrowserProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
var flag: boolean;
begin
if WebBrowser.Document <> nil then
begin
flag := (WebBrowser.Document as IHTMLDocument2).designMode = WideString('On');
if flag then btnDesign.Down := true
else btnDesign.Down := false;
end;
if Progress > 0 then
begin
ProgressBar.Visible := true;
StatusBar.Panels[0].Width := MainForm.Width - 300;
StatusBar.Panels[1].Width := 150;
end
else
begin
ProgressBar.Visible := false;
StatusBar.Panels[0].Width := MainForm.Width - 150;
StatusBar.Panels[1].Width := 0;
end;
ProgressBar.Max := ProgressMax;
ProgressBar.Position := Progress;
end;
procedure TMainForm.WebBrowserStatusTextChange(Sender: TObject;
const Text: WideString);
begin
Mainform.Statusbar.Panels[0].Text := Text;
end;
procedure TMainForm.MyMessageHandler(var Msg: TMsg; var Handled: Boolean);
var IOIPAO: IOleInPlaceActiveObject;
Dispatch: IDispatch;
begin
if WebBrowser = nil then
begin
Handled := False;
Exit;
end;
Handled := (IsDialogMessage(WebBrowser.Handle, Msg)=True);
if (Handled) and (not WebBrowser.Busy) then
begin
if FOleInPlaceActiveObject = nil then
begin
Dispatch := WebBrowser.Application;
if Dispatch <> nil then
begin
Dispatch.QueryInterface(IOleInPlaceActiveObject, IOIPAO);
if IOIPAO <> nil then FOleInPlaceActiveObject := IOIPAO;
end;
end;
if FOleInPlaceActiveObject <> nil then
if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
((Msg.wParam = VK_BACK) or (Msg.wParam = VK_LEFT) or (Msg.wParam =
VK_RIGHT)) then
//nothing - do not pass on Backspace, Left or Right arrows
else FOleInPlaceActiveObject.TranslateAccelerator(Msg);
end;
end;
