Примеры для пользователей

[SOURCE="pas"]program IWebBrowser_2;

uses
windows,CommCtrl,System;
{$R 'XPMan.res'}

const
ole32 = 'ole32.dll';
CLSID_InternetExplorer: TGUID = '{8856F961-340A-11D0-A96B-00C04FD705A2}';
IID_IWebBrowser2: TGUID = '{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}';

type
IWebBrowser2 = interface(IDispatch)
['{EAB22AC1-30C1-11CF-A7EB-0000C05BAE0B}']
procedure GoBack; safecall;
procedure GoForward; safecall;
procedure GoHome; safecall;
procedure GoSearch; safecall;
procedure Navigate(const URL: WideString; var Flags: OleVariant;
var TargetFrameName: OleVariant; var PostData: OleVariant;
var Headers: OleVariant); safecall;
procedure Refresh; safecall;
procedure Stop; safecall;
function Get_LocationURL: WideString; safecall;
property LocationURL: WideString read Get_LocationURL;
end;

function AtlAxAttachControl(const pControl: IUnknown; hWnd: HWND; ppUnkContainer: IUnknown): DWORD; stdcall; external 'ATL.DLL';
function CoInitializeEx(pvReserved: Pointer; coInit: Longint): HResult; stdcall;external ole32 name 'CoInitializeEx';
function CoCreateInstance(const clsid: TGUID; unkOuter: IUnknown; dwClsContext: Longint; const iid: TGUID; out pv): HResult; stdcall;external ole32 name 'CoCreateInstance';
procedure CoUninitialize; external ole32 name 'CoUninitialize';

var
WinClass : TWndClass; //переменная класса TWndClass для создания главного окна
hInst : HWND; //хандлер приложения
AddrEdit,WebWindow,ToolWnd,Handle : HWND; //локальный хандлер
Msg : TMSG; //сообщение
WB:IWebBrowser2; //Собственно наш браузер
EmptyParam: OleVariant;
WebFont:HFONT;
i, j: Integer;
ArrTTBButton: array [0..11] of TTBButton;
WRect:TRect;
Addres: PAnsiChar;
next,prew:Integer;
procedure ShutDown; //процедура завершения программы
begin
CoUninitialize;
UnRegisterClass('TAPIxForm', hInst); //удаление окна
ExitProcess(hInst); //закрытие программы
end;

function WindowProc(hwnd, msg, wparam, lparam: longint): longint; stdcall; //обработчик сообщений
begin
Result := DefWindowProc(hwnd, msg, wparam, lparam);
case Msg of
$0014:Result:=1;
$0019:Result:=1;
$0001:
begin
//Инициализируем библиотеку COM
CoInitializeEx(nil, 2);
//Создаем екземпляр браузера
CoCreateInstance(CLSID_InternetExplorer, nil, 1,IID_IWebBrowser2, WB);
//Прикрепляем к панельке на форме, а можно и не прикреплять =)
end;
$0005:
begin
GetClientRect(hwnd,WRect);
SetWindowPos(WebWindow,hwnd,0,30,WRect.Right,WRect.Bottom-30,$514);
end;
$0111:
if (lParam = AddrEdit) and (HiWord(wParam) = $0300) then
//OnChange компонента AddrEdit
begin
GetMem(Addres,GetWindowTextLength(lParam));
GetWindowText(lParam,Addres,GetWindowTextLength(lParam));
WB.Navigate(Addres, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
Next:=Next+1;
FreeMem(Addres);
end else
if (lParam = ToolWnd) then begin
if (HiWord(wParam) = 0) then
begin
if Next>0 then
begin
WB.GoBack;
prew:=prew+1;
Next:=Next-1;
end;
end else
if (HiWord(wParam) = 1) then
begin
if prew>=0 then begin
WB.GoForward;
Next:=Next+1;
if prew>0 then prew:=prew-1;
end;
end;
if (HiWord(wParam) = 1) then
begin
WB.Refresh;
end;
end;
$0002: ShutDown;
end;
end;

begin
hInst := GetModuleHandle(nil);
with WinClass do
begin
Style := CS_PARENTDC; //стиль класса главного окна
hIcon := LoadIcon(hInst, MAKEINTRESOURCE('APIXICON')); //иконка программы
lpfnWndProc := @WindowProc; //назначение обработчика сообщений
hInstance := hInst;
hbrBackground := COLOR_BTNFACE + 1; //цвет окна
lpszClassName := 'TAPIxForm'; //класс окна
hCursor := LoadCursor(0, IDC_ARROW); //активный курсор
end;
RegisterClass(WinClass); //регистрация класса в системе

Handle := CreateWindowEx(0, 'TAPIxForm', 'IWebBrowser2', WS_OVERLAPPEDWINDOW or WS_VISIBLE or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU, (GetSystemMetrics(16) div 2)-400, (GetSystemMetrics(17) div 2)-200, 800, 400, 0, 0, hInst, nil);

j:=0;
Next:=0;
prew:=0;
for i:=0 to 6 do
begin
if (i=3)or(i=6) then
begin
ArrTTBButton.iBitmap:=0;
ArrTTBButton.idCommand:=0;
ArrTTBButton.fsStyle:=tbstyle_sep;
end
else
begin
ArrTTBButton.iBitmap:=j;
ArrTTBButton.idCommand:=210+j;
ArrTTBButton.fsStyle:=tbstyle_button;
inc(j);
end;
ArrTTBButton.fsState:=tbstate_enabled;
ArrTTBButton.dwData:=0;
ArrTTBButton.iString:=0;
end;

WebFont:=CreateFont(-11, 0, 0, 0, 0, 0, 0, 0,DEFAULT_CHARSET,OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');


ToolWnd:=CreateToolBarEx(Handle, ccs_top or ws_child or TBSTYLE_TOOLTIPS or ws_visible, 0, 9, hInst, 0, @ArrTTBButton,
7, 40, 16, 40, 16, SizeOf(TTBButton));

GetClientRect(Handle,WRect);

WebWindow := CreateWindowEx(0, 'Static', '', WS_CHILD or WS_VISIBLE, 0, 30, WRect.Right, WRect.Bottom-30, Handle, 0, hInst, nil);

AddrEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', 'http://innoultra.ru/', WS_CHILD or ES_AUTOHSCROLL or WS_VISIBLE,
280, 0, 200, 21, ToolWnd, 0, hInst, nil);

SendMessage(AddrEdit, $0030, WebFont, 0);

AtlAxAttachControl(WB,WebWindow, nil);

GetMem(Addres,GetWindowTextLength(AddrEdit));

GetWindowText(AddrEdit,Addres,GetWindowTextLength(AddrEdit));

WB.Navigate(Addres, EmptyParam, EmptyParam, EmptyParam, EmptyParam);

FreeMem(Addres);
// Цикл сбора сообщений
while(GetMessage(Msg, 0, 0, 0)) do
begin
TranslateMessage(Msg); //прием сообщений
DispatchMessage(Msg); //удаление сообщений из очереди
end;
end.[/SOURCE]