Web-браузери: поняття, особливості

Для відображення проектування програмного продукту використовувалися такі UML-діаграми:

1) UML-діаграма варіантів використання програмного продукту (Додаток Б)

2) Діаграма стану (Додаток В)

Діаграма прецедентів -- в UML, діаграма, на якій зображено відношення між акторами та прецедентами в системі. Суть даної діаграми полягає в наступному: проектована система представляється у вигляді безлічі сутностей чи акторів, взаємодіючих із системою за допомогою так званих варіантів використання. Варіант використання (use case) служить для опису сервісів, що система надає актору. Іншими словами, кожен варіант використання визначає деякий набір дій, чинений системою при діалозі з актором. При цьому нічого не говориться про те, яким чином буде реалізована взаємодія акторів із системою.

Діаграма класів -- статичне представлення структури моделі. Відображає статичні (декларативні) елементи, такі як: класи, типи даних, їх зміст та відношення. Діаграма класів, також, може містити позначення для пакетів та може містити позначення для вкладених пакетів.

3.2 Реалізація

Підбір засобів програмування.

Для створення програмного продукту використовується об'єктно-орієнтований язик програмування Borland Delphi.

Необхідні бібліотеки для роботи програми:

// Windows, Messages, SysUtils, {$IFDEF DELPHI6UP}Variants, {$ENDIF}AppEvnts, Dialogs, ExtDlgs, Graphics, Menus, ExtCtrls, ImgList, Controls, StdCtrls, ComCtrls, OleCtrls, SHDocVw, ToolWin, Buttons, WBFuncs, Classes, Forms, HistoryMenu, FavMenu, ActiveX, XPMan;

Створення графічного інтерфейсу користувача

Для створення інтерфейсу використовувалися стандартні об'єкти та компонент Delphi:

1) Було реалізовано горизонтальне меню з використанням компонента «MainMenu»;

2) Створено за допомогою компонента «ToolBar» панель керування програмою;

3) Для відображення веб-сторінок використовується компонент «Webbrowser»;

4) Було використані компоненти Tedit та Tlable;

5) Для підтримки діалогу з файлами комп'ютера було використано компонент «TOpenDialog».

Розробка стандартних функцій

На даному етапі було розроблено стандартні функції які зв'язані з браузером «internet explorer», а саме: елементи управління сайтами та елементи меню.

До складу елементів управління входять:

1) Вперед

\\ WB_GoForward(GetCurrentWB);

2) Назад

\\ WB_GoBack(GetCurrentWB);

3) Стоп

\\ WB_Stop(GetCurrentWB);

4) Оновити

\\ WB_Refresh(GetCurrentWB);

5) Домашня сторінка

\\ GetCurrentWB.GoHome;

6) Пошук

\\ WB_ShowFindDialog(GetCurrentWB);

Елементи управління меню:

1) Печать

\\ WB_ShowPrintDialog(GetCurrentWB);

2) Налаштування сторінки

\\ WB_ShowPageSetup(GetCurrentWB);

3) Режим перегляду коду

\\ WB_ShowSourceCode(GetCurrentWB);

4) Режим переглядача

\\ InvokeCMD(GetCurrentWB, HTMLID_OPTIONS)

5) Режим дизайну

\\ procedure TfrmMyBrowser.DesignMode1Click(Sender: TObject);

6) Режим редактора HTML-кода

\\ procedure TfrmMyBrowser.AddHTML1Click(Sender: TObject);

7) Открыть

\\ OpenDialog1.Execute thenCreateTabBrowser(OpenDialog1.FileName, ExtractFileName(OpenDialog1.FileName));

Розробка правої панелі

На даному етапі реалізовувалась додаткова панель за допомогою якої веб-програмісту допомагає визначіти наступні данні об'єкти на сторінці: «tegName», id, innerHTML, className, innertext, href. Крім цього в цій панелі реалізовано функцію пошуку на сторінці, та меню «опція» де можна задати наступні положення сторінки: без границь, без полоси прокрутки, та без випливающого меню.

Розробка класів

Для виконання поставленої задачі було реалізовані слідуючі класи:

1) TWebbrowser = class(TMyBrowser) - відповідає за роботу навігатора браузера в інтернеті;

2) TStatusBar = class(ComCtrls.TStatusBar) - відповідає за компонент статус бара.

Рисунок 3.2.1 Скріншот готової ігри

3.3 Тестування

Кожен програмний продукт перед тим як вводити в експлуатацію проходить тестування, та мій програмний продукт не виключення. Для тестування мого браузера я розробив план:

1) Тестування сумісності;

2) Тестування на введення неправильних даних

3) Тестування з максимальним навантаженням роботи веб браузера;

4) Тестування під навантаженням процесора.

5) Тестування відповідно технічного завдання.

Таблица

Тестування відповідності технічного завдання

Відповідно очікуваним вимогам програма виконує: функції процесу завантаження веб-сторінок виконуе поушук в мережі інтернет

Рисунок 3.3.1 завантажена веб-сторінка, з параметром пошуку

Всі належні функції які дублюються від браузера «Internet explorer» прцюють успішно.

Що стосується власного редактора - HTML, то і у ній зауважень не виникнуло, результат роботи дивитись на рисунку 3.3.2 та 3.3.3.

Рисунок 3.3.2 редактор HTML

Рсунок 3.3.3 Результат

Під час тестування функції «режиму дизайну сторінки» то тут теж проблем не виникало, але спостерігається дуже не зручний конструктор, тобто дуже проблематично перетягнути той чи інший об'єкт в потрібне місце.

Рисунок 3.3.4 - результат роботи в режимі дизайнера

З тестуванням журналу подій особливих зауважень не було.

Рисунок 3.3.5 відображення результатів «Журналу подій»

3.4 Інструкція користувача

При запуску програми користувач бачить перед собою слідуюче вікно браузера який указаний на рисунку 3.4.1, за допмогою цієї программи кристувач може переглядати потрібні для себе сайти. Для того щоб почати роботу користувач повинен в строчку яка знаходиться під номером десть ввести потрібну назву сайта, після чого програма відобразить його.

Рисунок 3.4.1 головне меню браузера

1) Горизонтальне меню браузераж;

2) Назад по сторінкі;

3) Вперед по сторінкі;

4) Зупинити завантаження сторінки;

5) Оновити сторінку;

6) Перейти на домашню сторінку;

7) Пошук в пошуковій мережі

8) Відобразити праву панель елементів

9) Пошук слів на сторінці;

10) URL сточка для вводу сайтів;

11) Вікно браузера;

12) Відображення загруженості веб-сторіки;

13) Строчко стану.

Режим дизайну

Режим дизайну використовується проектувальниками для візуального моделювання поточних веб-сторінок, для того щоб перейти в режим дизайну треба відкрити в пункті горизонтального меню «Просмотр» «Режим дизайну»

Рисунок 3.4.2 відображення сторінки в режимі дизайнера

Для того щоб виконати ту чи іншу дію в режимі дизайнера, треба за допомогою миші, навести стрілку на потрібний об'єкт та виконати потрібну дію, наприклад збільшити чи перетягнути об'єкт, якщо це текст то його можна перейменувати або виконати попередні дії.

Редактор HTML

Для того щоб запустити редактор HTML треба обрати в горизонтальному меню «Дополнительно» «Редактор HTML»

Рисунок 3.4.3 вікно редактора HTML

Для того щоб запустити готовий проект треба натиснути кнопку «Запустить».

Журнал подій

Для того щоб запустити журнал подій треба, натиснути на кнопку «Правая панель» та активувати флажок «Журнал собітий». Після чого зявляються данні де буде відображатися інформація при наведенні миши на конкретний об'єкт, а саме:

1) tagName - виводить ім'я тегу;

2) id - відображає ідентифікатор;

3) innerHTML - всановлює або отримує всю розмітку і зміст у середині даного елемента

4) ClassName - показує ім'я атрибуту класу.

5) innerText - він є аналогом свойства innerHTML за винятком того, що вміст буде інтерпретуватися як звичайний текст.

6) Href - відображає посилання.

Рисунок 3.4.4 вікно журнала подій

Висновок

В результаті розробки, отриманий повноцінний браузер, за допомогою якого можна безперешкодно відвідувати різні Інтернет ресурси. Плюсом написання браузера на Delphi є те, що основний акцент робиться на максимальному використанні коду. Це дозволяє розробникам будувати програми досить швидко з заздалегідь підготовлених об'єктів, і так само дає їм можливість створювати свої власні об'єкти для середовища Delphi. Ніяких обмежень по типах об'єктів, які можуть створювати розробники, не існує. Я вважаю створення браузера дуже ефективним у освітньому плані, так як при його написанні виникав ряд труднощів, долаючи які розвиваються необхідні якості для програміста, такі як завзятість, логіка, вміння знаходити оптимальне рішення проблеми. Дизайн і зовнішній вигляд браузера і функціонал цілком і повністю залежить від розробника, тому реалізація даного проекту дозволяє розвивати творче мислення і підвищити мотивацію до навчання, опанувати методами наукового пізнання.

На жаль, розробка браузера на основі Internet Explorer не перспективні в даний час, так як сам по собі браузер Internet Explorer має досить велику кількість мінусів (зокрема серйозні проблеми в системі безпеки, швидкості роботи, продуктивності, функціональності, наявності вразливостей), і поступається за багатьма параметрами аналогам (таким як Opera , Mozilla FireFox, Safari, Google Chrome та іншим). Написання ж браузера на власному, унікальному ядрі завдання дуже не просте і вимагає величезних розумових, матеріальних і тимчасових витрат.

Література

1.Г.В.Галісеев, «Програмування в середовищі Delphi 7. Самовчитель «, М., 2004 рік.

2.В.В.Фаронов, «Delphi 7. навчальний курс «, видавець С.В.Малгачева, 2001 рік.

3.В. В. Шупрута "Delphi 2006. Вчимося програмувати"

4.Довідкова система Delphi.

5.Офіційний сайт вільної всесвітньої енциклопедії «Вікіпедія» [Електронний ресурс] Режим доступу:

http://ru.wikipedia.org/wiki/%D0%91%D1%80%D0%B0%D1%83%D0

6.Неофіційний сайт присвячений програмування «Делфі» [Електронний ресурс] Режим доступу:

Додаток

procedure TfrmMyBrowser.Print1Click(Sender: TObject);

begin

WB_ShowPrintDialog(GetCurrentWB);

end;

procedure TfrmMyBrowser.PrintPreview1Click(Sender: TObject);

begin

WB_ShowPrintPreview(GetCurrentWB);

end;

procedure TfrmMyBrowser.PageSetup1Click(Sender: TObject);

begin

WB_ShowPageSetup(GetCurrentWB);

end;

procedure TfrmMyBrowser.Properties1Click(Sender: TObject);

begin

WB_ShowPropertiesDialog(GetCurrentWB);

end;

procedure TfrmMyBrowser.Copy1Click(Sender: TObject);

begin

WB_Copy(GetCurrentWB);

end;

procedure TfrmMyBrowser.Paste1Click(Sender: TObject);

begin

WB_Paste(GetCurrentWB);

end;

procedure TfrmMyBrowser.Cut1Click(Sender: TObject);

begin

WB_Cut(GetCurrentWB);

end;

procedure TfrmMyBrowser.SelectAll1Click(Sender: TObject);

begin

WB_SelectAll(GetCurrentWB);

end;

procedure TfrmMyBrowser.ToolBtnRefreshClick(Sender: TObject);

begin

WB_Refresh(GetCurrentWB);

ToolBtnStop.Enabled := True;

end;

procedure TfrmMyBrowser.ToolBtnSearchClick(Sender: TObject);

begin

WB_ShowFindDialog(GetCurrentWB);

end;

procedure TfrmMyBrowser.Search1Click(Sender: TObject);

begin

WB_ShowFindDialog(GetCurrentWB);

end;

procedure TfrmMyBrowser.ViewSource1Click(Sender: TObject);

begin

WB_ShowSourceCode(GetCurrentWB);

end;

procedure TfrmMyBrowser.InternetOptions1Click(Sender: TObject);

begin

InvokeCMD(GetCurrentWB, HTMLID_OPTIONS);

end;

procedure TfrmMyBrowser.ToolbtnBackClick(Sender: TObject);

begin

WB_GoBack(GetCurrentWB);

end;

procedure TfrmMyBrowser.ToolBtnForwardClick(Sender: TObject);

begin

WB_GoForward(GetCurrentWB);

end;

procedure TfrmMyBrowser.SpeedButtonScrollBottomClick(Sender: TObject);

begin

WB_ScrollToBottom(GetCurrentWB);

end;

procedure TfrmMyBrowser.SpeedButtonScrollTopClick(Sender: TObject);

begin

WB_ScrollToTop(GetCurrentWB);

end;

procedure TWebbrowser.WMClose(var Msg: TWMClose);

begin

Msg.Result := 0;

Navigate('about:blank');

end;

constructor TStatusBar.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

ControlStyle := ControlStyle + [csAcceptsControls];

end;

procedure TfrmMyBrowser.btnGoClick(Sender: TObject);

begin

if edURL.Text <> '' then

begin

lvEventLog.Clear;

WB_Navigate(GetCurrentWB, edURL.Text);

WB_SetFocus(GetCurrentWB);

end;

end;

procedure TfrmMyBrowser.edURLDblClick(Sender: TObject);

begin

edURl.SelectAll;

end;

procedure TfrmMyBrowser.edURLKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

begin

Key := #0;

btnGoClick(self);

end;

end;

procedure TfrmMyBrowser.edSearchKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

begin

Key := #0;

btnSearchClick(self);

end;

end;

procedure TfrmMyBrowser.edSearchAndHighlightKeyPress(Sender: TObject;

var Key: Char);

begin

if Key = #13 then

begin

Key := #0;

btnSearchAndHighlightClick(self);

end;

end;

procedure TfrmMyBrowser.chk3DBorderStyleClick(Sender: TObject);

begin

WB_Set3DBorderStyle(GetCurrentWB, not chk3DBorderStyle.Checked);

end;

procedure TfrmMyBrowser.chkNoScrollBarsClick(Sender: TObject);

begin

WB_ShowScrollBar(GetCurrentWB, chkNoScrollBars.Checked);

end;

procedure TfrmMyBrowser.urkishWindows1Click(Sender: TObject);

begin

if WB_SetCharSet(GetCurrentWB, TMenuItem(Sender).Hint) then

TMenuItem(Sender).Checked := True;

end;

procedure TfrmMyBrowser.btnSearchAndHighlightClick(Sender: TObject);

begin

WB_SearchAndHighlightText(GetCurrentWB, edSearchAndHighlight.Text);

end;

function TfrmMyBrowser.GetCurrentWB: TWebbrowser;

begin

Result := nil;

with PageControl do

if ActivePage.ControlCount > 0 then

begin

if ActivePage.Controls[0] is TWebbrowser then

begin

Result := (TWebbrowser(ActivePage.Controls[0]));

end else

Result := FPrevBrowser;

end;

end;

procedure TfrmMyBrowser.NewTabBlankClick(Sender: TObject);

begin

CreateTabBrowser('about:blank', 'Новая страница');

end;

procedure TfrmMyBrowser.Open1Click(Sender: TObject);

begin

if OpenDialog1.Execute then

CreateTabBrowser(OpenDialog1.FileName, ExtractFileName(OpenDialog1.FileName));

end;

procedure TfrmMyBrowser.SaveAs1Click(Sender: TObject);

begin

WB_Save(GetCurrentWB);

end;

procedure TfrmMyBrowser.Cookie1Click(Sender: TObject);

var

sCookie: string;

begin

sCookie := WB_GetCookie(GetCurrentWB);

if Length(sCookie) = 0 then

ShowMessage('There are no cookies in this webpage.')

else

ShowMessage(sCookie);

end;

function GetElementAtPos(Doc: IHTMLDocument2; x, y: integer): IHTMLElement;

begin

Result := nil;

Result := Doc.elementFromPoint(x, y);

end;

procedure TfrmMyBrowser.HistoryMenuURLSelected(Sender: TObject; Url: string);

var

WB: TWebbrowser;

begin

WB := GetCurrentWB;

if Assigned(WB) then

WB.Navigate(URL);

end;

procedure TfrmMyBrowser.FavoritesMenuURLSelected(Sender: TObject; Url: string);

var

WB: TWebbrowser;

begin

WB := GetCurrentWB;

if Assigned(WB) then

WB.Navigate(URL);

end;

procedure TfrmMyBrowser.FormCreate(Sender: TObject);

begin

HistoryMenu := THistoryMenu.Create(self);

HistoryMenu.MainMenu := MainMenu1;

HistoryMenu.Menupos := 4;

HistoryMenu.CreateMenu;

HistoryMenu.OnURLSelected := HistoryMenuURLSelected;

MainMenu1.Items[3].Caption := 'История';

Webbrowser1.FNavForward := False;

Webbrowser1.FNavBack := False;

Webbrowser1.FTitle := '';

end;

procedure TfrmMyBrowser.FormShow(Sender: TObject);

begin

Webbrowser1.GoHome;

FormResize(nil);

end;

procedure TfrmMyBrowser.FormDestroy(Sender: TObject);

begin

HistoryMenu.Free;

end;

procedure TfrmMyBrowser.AddEventLog(s: string);

begin

lvEventLog.ItemIndex := lvEventLog.Items.Add(s);

end;

procedure TfrmMyBrowser.WebBrowser1ProgressChange(Sender: TObject; Progress, ProgressMax: Integer);

var

Position: Integer;

begin

try

Position := (Progress * 100);

ProgressBar1.Position := Position;

StatusBar1.Panels[0].Text := Format('%d "loaded..."', [Position]);

except

end;

end;

procedure TfrmMyBrowser.WebBrowser1TitleChange(Sender: TObject;

const Text: WideString);

begin

Caption := APP_CAPTION + Text;

TWebbrowser(Sender).FTitle := Text;

end;

procedure TfrmMyBrowser.SetWBMenuEnabled(WB: TWebbrowser; Sender: TMenuItem);

begin

if Assigned(WB) then

Sender.Enabled := Assigned(WB.Document)

else

Sender.Enabled := False;

end;

procedure TfrmMyBrowser.File1Click(Sender: TObject);

var

CurrentWB: TWebbrowser;

begin

CurrentWB := GetCurrentWB;

SetWBMenuEnabled(CurrentWB, Print1);

SetWBMenuEnabled(CurrentWB, PrintPreview1);

SetWBMenuEnabled(CurrentWB, PageSetup1);

SetWBMenuEnabled(CurrentWB, Properties1);

SetWBMenuEnabled(CurrentWB, SaveAs1);

end;

procedure TfrmMyBrowser.Edit2Click(Sender: TObject);

var

CurrentWB: TWebbrowser;

begin

CurrentWB := GetCurrentWB;

Copy1.Enabled := WB_QueryCommandEnabled(CurrentWB, 'Copy');

Paste1.Enabled := WB_QueryCommandEnabled(CurrentWB, 'Paste');

Cut1.Enabled := WB_QueryCommandEnabled(CurrentWB, 'Cut');

SetWBMenuEnabled(CurrentWB, SelectAll1);

SetWBMenuEnabled(CurrentWB, Search1);

end;

procedure TfrmMyBrowser.Extras1Click(Sender: TObject);

var

CurrentWB: TWebbrowser;

begin

CurrentWB := GetCurrentWB;

SetWBMenuEnabled(CurrentWB, AddHTML1);

SetWBMenuEnabled(CurrentWB, InternetOptions1);

end;

procedure TfrmMyBrowser.ToolBtnStopClick(Sender: TObject);

begin

WB_Stop(GetCurrentWB);

end;

procedure TfrmMyBrowser.ToolBtnHomeClick(Sender: TObject);

begin

GetCurrentWB.GoHome;

end;

procedure TfrmMyBrowser.btnSearchClick(Sender: TObject);

const

GOOGLE_QUERY = 'http://www.google.com/search?ie=ISO-8859-1&hl=de&q=';

var

sQuery: string;

begin

sQuery := GOOGLE_QUERY + edSearch.Text;

WB_Navigate(GetCurrentWB, sQuery);

end;

procedure TfrmMyBrowser.Exit1Click(Sender: TObject);

begin

Close;

end;

procedure TfrmMyBrowser.WebBrowser1CommandStateChange(Sender: TObject;

Command: Integer; Enable: WordBool);

begin

case Command of

CSC_NAVIGATEBACK: begin

TWebbrowser(Sender).FNavBack := Enable;

ToolbtnBack.Enabled := Enable;

end;

CSC_NAVIGATEFORWARD: begin

TWebbrowser(Sender).FNavForward := Enable;

ToolBtnForward.Enabled := Enable;

end;

end;

end;

procedure TfrmMyBrowser.FormResize(Sender: TObject);

var

r: TRect;

const

SB_GETRECT = WM_USER + 10;

begin

Statusbar1.Perform(SB_GETRECT, 2, Integer(@R));

ProgressBar1.Parent := Statusbar1;

ProgressBar1.SetBounds(r.Left, r.Top, r.Right - r.Left - 5, r.Bottom - r.Top);

with Statusbar1 do

begin

Panels[1].Width := Width div 2 - 10;

Panels[0].Width := 80;

Panels[2].Width := 90;

Panels[3].Width := 25;

Panels[4].Width := 150;

Refresh;

end;

end;

function TfrmMyBrowser.DrawZoneIcon(WB: TWebbrowser): TIcon;

var

ZoneAttr: TZoneAttributes;

ZoneIcon: TIcon;

begin

ZoneAttr := GetZoneAttributes(WB.LocationURL);

ZoneIcon := TIcon.Create;

try

if GetZoneIcon(ZoneAttr.szIconPath, ZoneIcon) then

Statusbar1.Panels[4].Text := ZoneAttr.szDisplayName;

Result := ZoneIcon;

finally

//

end;

end;

procedure TfrmMyBrowser.StatusBar1DrawPanel(StatusBar: TStatusBar;

Panel: TStatusPanel; const Rect: TRect);

var

ZoneIcon: TIcon;

CurrentWB: TWebbrowser;

begin

if Panel = Statusbar1.Panels[3] then

begin

CurrentWB := GetCurrentWB;

if Assigned(CurrentWB) then

begin

ZoneIcon := DrawZoneIcon(CurrentWB);

if ZoneIcon.Handle <> 0 then

begin

Statusbar1.Canvas.Font.Color := clRed;

Statusbar1.Canvas.FillRect(Rect);

Statusbar1.Canvas.Draw(Rect.Left, Rect.Top, ZoneIcon);

end;

ZoneIcon.Free;

end else

Statusbar1.Panels[3].Text := '';

end;

end;

procedure TfrmMyBrowser.WebBrowser1StatusTextChange(Sender: TObject;

const Text: WideString);

var

CurrentWB: TWebbrowser;

begin

CurrentWB := GetCurrentWB;

if Assigned(CurrentWB) then

begin

if TControl(CurrentWB).Hint = TControl(Sender).Hint then

StatusBar1.Panels[1].Text := Text;

end;

end;

procedure TfrmMyBrowser.WebBrowser1DownloadComplete(Sender: TObject);

begin

WB_Set3DBorderStyle(GetCurrentWB, not chk3DBorderStyle.Checked);

WB_ShowScrollBar(GetCurrentWB, chkNoScrollBars.Checked);

StatusBar1.Repaint;

ToolBtnStop.Enabled := False;

end;

procedure TfrmMyBrowser.Zoom1Click(Sender: TObject);

var

CurrentWB: TWebbrowser;

ZoomIndex: TWBFontSize;

begin

CurrentWB := GetCurrentWB;

if WB_DocumentLoaded(CurrentWB) then

begin

ZoomIndex := WB_GetZoom(CurrentWB);

end;

end;

procedure TfrmMyBrowser.PageControlChanging(Sender: TObject;

var AllowChange: Boolean);

begin

with PageControl do

if ActivePage.ControlCount > 0 then

if ActivePage.Controls[0] is TWebbrowser then

FPrevBrowser := GetCurrentWB;

end;

procedure TfrmMyBrowser.PageControlChange(Sender: TObject);

var

CurrentWB: TWebbrowser;

begin

ToolbtnBack.Enabled := False;

ToolBtnForward.Enabled := False;

with PageControl do

if ActivePage.ControlCount > 0 then

if ActivePage.Controls[0] is TWebbrowser then

begin

CurrentWB := TWebbrowser(ActivePage.Controls[0]);

WB_SetFocus(CurrentWB);

ToolbtnBack.Enabled := CurrentWB.FNavBack;

ToolBtnForward.Enabled := CurrentWB.FNavForward;

edURL.Text := CurrentWB.LocationURL;

Self.Caption := TWebbrowser(CurrentWB).FTitle;

end;

end;

procedure TfrmMyBrowser.AddHTML1Click(Sender: TObject);

begin

frmAddHTML := TfrmAddHTML.Create(Self);

try

frmAddHTML.ShowModal;

finally

frmAddHTML.Free;

end;

end;

procedure TfrmMyBrowser.WebBrowser1NewWindow2(Sender: TObject;

var ppDisp: IDispatch; var Cancel: WordBool);

var

ts: TTabSheet;

begin

AddEventLog('OnNewWindow');

if TWebbrowser(Sender).ReadyState <> READYSTATE_COMPLETE then

begin

ppDisp := nil;

Cancel := True;

end else

begin

ts := CreateTabBrowser('', 'Новая страница');

WaitForBrowser(TWebbrowser(ts.Controls[0]));

ppdisp := (TWebbrowser(ts.Controls[0])).Application;

WaitForBrowser(TWebbrowser(ts.Controls[0]));

end;

end;

procedure TfrmMyBrowser.DesignMode1Click(Sender: TObject);

var

HTMLDocument2: IHTMLDocument2;

DesignMode: string;

CurrentWB: TWebbrowser;

begin

CurrentWB := GetCurrentWB;

if Assigned(CurrentWB) then

begin

DesignMode1.Checked := not DesignMode1.Checked;

HTMLDocument2 := (CurrentWB.Document as IHTMLDocument2);

if HTMLDocument2 <> nil then begin

DesignMode := HTMLDocument2.get_designMode;

if DesignMode = 'On' then

begin

HTMLDocument2.designMode := 'Off';

DesignMode1.Checked := False;

end

else

begin

HTMLDocument2.designMode := 'On';

DesignMode1.Checked := True;

end;

end;

end;

end;

procedure TfrmMyBrowser.Timer1Timer(Sender: TObject);

var

MausPos: TPoint;

Element: IHTMLElement;

imgElement: IHTMLIMGElement;

scrElement: IHTMLLinkElement;

x, y: Integer;

Doc: IHTMLDocument2;

CurrentWB: TWebbrowser;

begin

if chkShowElementInfo.Checked then

begin

begin

CurrentWB := GetCurrentWB;

if Assigned(CurrentWB) then

begin

Doc := CurrentWB.Document as IHTMLDocument2;

if Assigned(doc) then

begin

// Get Current Mouse Position

GetCursorPos(MausPos);

// Convert the screen coordinates to client coordinates

mauspos := CurrentWB.ScreenToClient(mauspos);

x := MausPos.x;

y := MausPos.y;

// Get the element under the mouse cursor

Element := GetElementAtPos(doc, x, y);

if Assigned(Element) then

begin

// element properties

edElementTag.Text := Element.tagName;

edElementId.Text := Element.id;

edElementinnerText.Text := Element.innerText;

edElementinnerHTML.Text := Element.innerHTML;

edElementclassName.Text := Element.className;

Element.QueryInterface(IHTMLIMGElement, imgElement);

if assigned(imgElement) then

edElementhref.Text := imgElement.href;

Element.QueryInterface(IHTMLLinkElement, scrElement);

if assigned(scrElement) then

edElementhref.Text := scrElement.href;

end;

end;

end;

end;

end;

end;

function TfrmMyBrowser.CreateTabBrowser(sURL, sCaption: string): TTabSheet;

var

ts: TTabSheet;

WB: TWebbrowser;

begin

ts := TTabSheet.Create(PageControl);

Result := ts;

try

ts.PageControl := PageControl;

ts.Parent := PageControl;

ts.Caption := sCaption;

ts.PageIndex := PageControl.ActivePageIndex + 1;

WB := TWebbrowser.Create(ts);

TControl(WB).Parent := ts;

WB.Align := alClient;

WB.Silent := True;

WB.Visible := True;

PageControl.ActivePage := ts;

WB.OnProgressChange := WebBrowser1ProgressChange;

WB.OnStatusTextChange := WebBrowser1StatusTextChange;

WB.OnTitleChange := WebBrowser1TitleChange;

WB.OnNewWindow2 := WebBrowser1NewWindow2;

WB.OnCommandStateChange := WebBrowser1CommandStateChange;

WB.OnDownloadComplete := WebBrowser1DownloadComplete;

WB.OnDocumentComplete := WebBrowser1DocumentComplete;

WB.OnDownloadBegin := WebBrowser1DownloadBegin;

WB.FNavForward := False;

WB.FNavBack := False;

if Trim(sURL) <> '' then

begin

WB.Navigate(sURL);

WaitForBrowser(WB);

end;

except

ts.Free;

end;

end;

procedure TfrmMyBrowser.PageControlMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

XHitTestInfo: TTCHitTestInfo;

HitIndex: Integer;

begin

XHitTestInfo.pt := Classes.POINT(X, Y);

HitIndex := TabCtrl_HitTest(PageControl.Handle, @XHitTestInfo);

if HitIndex <> -1 then

with PageControl do

begin

if Button = mbRight then

begin

ActivePageIndex := HitIndex;

CloseTab1.Enabled := (ActivePage.Tag <> 2) and (ActivePageIndex <> 0);

DuplicateTab1.Enabled := ActivePage.Controls[0] is TWebbrowser;

if ActivePage.Tag <> 2 then

PCPopup.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);

end;

end;

end;

procedure TfrmMyBrowser.CloseTab1Click(Sender: TObject);

begin

if PageControl.ActivePageIndex > 0 then

begin

if PageControl.ActivePage.Controls[0] is TWebbrowser then

begin

(TWebbrowser(PageControl.ActivePage.Controls[0])).Free;

FPrevBrowser := nil;

PageControl.ActivePage.Free;

end;

end;

end;

procedure TfrmMyBrowser.DuplicateTab1Click(Sender: TObject);

var

iCurrTabIndex: Integer;

ts: TTabSheet;

CurrentWB, NewWB: TWebbrowser;

sCurrURL: string;

begin

CurrentWB := GetCurrentWB;

if CurrentWB <> nil then

begin

iCurrTabIndex := PageControl.ActivePage.TabIndex;

sCurrURL := TWebbrowser(CurrentWB).LocationURL;

ts := CreateTabBrowser(sCurrURL, 'Новая страница');

NewWB := TWebbrowser(ts.Controls[0]);

WaitForBrowser(NewWB);

if NewWB.Document <> nil then

(NewWB.Document as IHTMLDocument2).body.innerHTML := (CurrentWB.Document as IHTMLDocument2).body.innerHTML;

ts.PageIndex := iCurrTabIndex + 1;

PageControl.ActivePageIndex := ts.PageIndex;

end;

end;

procedure TfrmMyBrowser.WebBrowser1DocumentComplete(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

var

CurWebBrowser: IWebBrowser;

TopWebBrowser: IWebBrowser;

Document: OleVariant;

WindowName: string;

begin

CurWebBrowser := pDisp as IWebBrowser;

TopWebBrowser := TWebBrowser(Sender).DefaultInterface;

if CurWebBrowser = TopWebBrowser then

begin

AddEventLog('OnDocumentComplete ' + URL);

ProgressBar1.Position := 0;

StatusBar1.Panels[0].Text := '';

ToolBtnStop.Enabled := False;

end else

begin

Document := CurWebBrowser.Document;

WindowName := Document.ParentWindow.Name;

AddEventLog(Format('Frame "%s" loaded', [WindowName]));

end;

end;

procedure TfrmMyBrowser.chkShowElementInfoClick(Sender: TObject);

begin

PnlElementInfo1.Visible := chkShowElementInfo.Checked;

end;

procedure TfrmMyBrowser.WebBrowser1DownloadBegin(Sender: TObject);

begin

AddEventLog('OnDownloadBegin');

end;

procedure TfrmMyBrowser.WebBrowser1BeforeNavigate2(Sender: TObject;

const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,

Headers: OleVariant; var Cancel: WordBool);

begin

lvEventLog.Clear;

AddEventLog('OnBeforeNavigate2 ' + URL);

ToolBtnStop.Enabled := True;

end;

procedure TfrmMyBrowser.WebBrowser1NavigateComplete2(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

begin

AddEventLog('OnNavigateComplete2 ' + URL);

edURL.Text := TWebbrowser(Sender).LocationURL;

end;

procedure TfrmMyBrowser.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

const

StdKeys = [VK_TAB, VK_RETURN];

ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT];

fExtended = $01000000;

var

CurrentWB: TWebbrowser;

begin

CurrentWB := GetCurrentWB;

try

if (CurrentWB = nil) or (CurrentWB.Document = nil) then

begin

Handled := False;

Exit;

end;

except

end;

if chkDisablePopupMenu.Checked then

if (Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONDBLCLK) then

begin

if IsChild(CurrentWB.Handle, Msg.hwnd) then

begin

Handled := True;

Exit;

end;

end;

if (GetKeyState(VK_CONTROL) < 0) and (Msg.Message = WM_KEYDOWN) and

(Msg.wParam = Ord('N')) then

begin

Handled := True;

DuplicateTab1Click(nil);

Exit;

end;

if IsChild(CurrentWB.Handle, Msg.Hwnd) then

begin

if (Msg.Message = WM_CLOSE) then

msg.message := 0

else

if ((Msg.Message >= WM_KEYFIRST) and (Msg.Message <= WM_KEYLAST)) and

((Msg.wParam in StdKeys) or (GetKeyState(VK_CONTROL) < 0) or

(Msg.wParam in ExtKeys) and ((Msg.lParam and fExtended) = fExtended)) then

begin

Handled := (CurrentWB.Application as IOleInPlaceActiveObject).TranslateAccelerator(Msg) = S_OK;

if not Handled then

begin

Handled := True;

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

end;

end;

end;

procedure TfrmMyBrowser.ToolButton1Click(Sender: TObject);

begin

PageControl1.Visible:=True;

end;

procedure TfrmMyBrowser.btn1Click(Sender: TObject);

begin

PageControl1.Visible:=False;

end;

initialization

OleInitialize(nil);

Set8087CW($133F);

finalization

OleUninitialize

end.

Размещено на Allbest.ru