VPF::WebBrowser, кустомизируем - Форум программистов

SilentRoach

Дата 3.6.2006, 02:24 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 20
Регистрация: 18.4.2006

Репутация: нет
Всего: нет

Хочу просто немного кустомизировать TWebBrowser.
Отрыл статейку где-то про то, как убрать рамку и добавить некоторые возможности.

Получился примерно такой код:

Код


unit RWebBrowser;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, StdCtrls, SHDocVw, Windows, OleCtrls, Forms,
  AxCtrls, ActiveX;

type
  TDocHostInfo = packed record
    cbSize: ULONG;
    dwFlags: DWORD;
    dwDoubleClick: DWORD;
  end;

  IDocHostUIHandler = interface(IUnknown)
    ['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
    function GetHostInfo(var pInfo: TDocHostInfo): HRESULT; stdcall;
  end;

  TCustomizedWebBrowser = class(TWebBrowser, IDocHostUIHandler)
    function GetHostInfo(var pInfo: TDocHostInfo): HRESULT; stdcall;
  end;

  TRWebBrowser = class(TPanel)
  private
    FWebBrowser: TCustomizedWebBrowser;

    procedure DeleteTempFile;
  protected
    { Protected declarations }
  public
    Document: TStrings;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ShowDocument;
    procedure SetBlank;
  published
  end;

const
  DOCHOSTUIFLAG_DIALOG = 1;
  DOCHOSTUIFLAG_DISABLE_HELP_MENU = 2;
  DOCHOSTUIFLAG_NO3DBORDER = 4;
  DOCHOSTUIFLAG_SCROLL_NO = 8;
  DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = 16;
  DOCHOSTUIFLAG_OPENNEWWIN = 32;
  DOCHOSTUIFLAG_DISABLE_OFFSCREEN = 64;
  DOCHOSTUIFLAG_FLAT_SCROLLBAR = 128;
  DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = 256;
  DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = 512;
  DOCHOSTUIDBLCLK_DEFAULT = 0;
  DOCHOSTUIDBLCLK_SHOWPROPERTIES = 1;
  DOCHOSTUIDBLCLK_SHOWCODE = 2;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Test', [TRWebBrowser]);
end;

{ TCustomizedWebBrowser }

function TCustomizedWebBrowser.GetHostInfo(var pInfo: TDocHostInfo): HRESULT;
begin
  with pInfo do
    dwFlags := dwFlags or DOCHOSTUIFLAG_NO3DBORDER or DOCHOSTUIFLAG_OPENNEWWIN;
    
  Result := S_OK;
end;

{ TRWebBrowser }

procedure TRWebBrowser.SetBlank;
begin
  Document.Clear;
  DeleteTempFile;

  FWebBrowser.Navigate('about:blank');
end;

constructor TRWebBrowser.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWebBrowser := TCustomizedWebBrowser.Create(Self);
  FWebBrowser.Align := alClient;
  TOleControl(FWebBrowser).Parent := Self;

  Document := TStringList.Create;
end;

procedure TRWebBrowser.DeleteTempFile;
var
  FileName: string;
begin
  FileName := ExtractFilePath(Application.ExeName) + 'temp.html';
  if FileExists(FileName) then
    DeleteFile(PChar(FileName));
end;

destructor TRWebBrowser.Destroy;
begin
  if Document <> nil then
  begin
    Document.Clear;
    Document.Free;

    DeleteTempFile;
  end;

  if FWebBrowser <> nil then
    FWebBrowser.Free;
  inherited;
end;

procedure TRWebBrowser.ShowDocument;
var
  FileName: string;
begin
  FWebBrowser.Stop;

  FileName := ExtractFilePath(Application.ExeName) + 'temp.html';
  if FileExists(FileName) then
    DeleteFile(PChar(FileName));

  Document.SaveToFile(FileName);

  FWebBrowser.Navigate('file://' + FileName);
end;

end.

И что же я получаю когда хочу отобразить страницу? получаю сообщение "Требуемый ресурс занят" и ноль результата.
В чем может быть трабла? Не тот гуид или я тупой безнадежно? smile

Это сообщение отредактировал(а) SilentRoach - 3.6.2006, 02:25

SilentRoach

Дата 3.6.2006, 21:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 20
Регистрация: 18.4.2006

Репутация: нет
Всего: нет

С этим так и не вышло разобраться, пришлось юзать другую библиотеку.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: ActiveX/СОМ/CORBA \| Следующая тема »