Бывалый
Профиль
Группа: Участник
Сообщений: 195
Регистрация: 12.1.2007
Репутация: нет
Всего: нет
|
Ув. Господа програмисты! Будте так любезны, подскажите, почему при вызове нового окна не открывается вторая форма и не грузит адрес который передаётся в JavaScript'e??? Вот код моей программы: form1 | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, Gauges, ComCtrls, StdCtrls, Menus, ActiveX, Commctrl,
Tabs;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
StatusBar1: TStatusBar;
Gauge1: TGauge;
MainMenu1: TMainMenu;
Side1: TMenuItem;
Manager1: TMenuItem;
Sysadmin1: TMenuItem;
Servershell1: TMenuItem;
Exit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure WebBrowser1ProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
procedure Servershell1Click(Sender: TObject);
procedure Manager1Click(Sender: TObject);
procedure Sysadmin1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
private
{ Private declarations }
FOleInPlaceActiveObject: IOleInPlaceActiveObject;
procedure MsgHandler(var Msg: TMsg; var Handled: Boolean);
procedure WMMouseActivate(var Msg: TMessage); message WM_MOUSEACTIVATE;
public
{ Public declarations }
end;
// end;
var
Form1: TForm1;
Flags: OLECMDF;
FOleInPlaceActiveObject: IOleInPlaceActiveObject;
SaveMessageHandler: TMessageEvent;
implementation
uses Unit2;
{$R *.dfm}
function GetPanelRect(index: integer): TRect;
begin
SendMessage(Form1.StatusBar1.Handle, SB_GETRECT, index,
integer(@result));
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Flags, TargetFrameName, PostData, Headers: OleVariant;
//Dispatch: IDispatch;
//IOIPAO: IOleInPlaceActiveObject;
begin
Application.OnMessage := MsgHandler;
WebBrowser1.Navigate('http://yandex.ru', Flags,
TargetFrameName, PostData, Headers);
Gauge1.Parent := StatusBar1;
Gauge1.BoundsRect :=GetPanelRect(3);
//Dispatch := WebBrowser1.Application;
//WebBrowser1.OnBeforeNavigate2 := TForm2.FormCreate(Sender: TObject);
// Dispatch := Form2.Application;
end;
procedure TForm1.Servershell1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://yandex.ru'); // Server shell
end;
procedure TForm1.Manager1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://yandex.ru');
end;
procedure TForm1.Sysadmin1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://yandex.ru'); // Sysadmin window
end;
procedure TForm1.WMMouseActivate(var Msg: TMessage);
begin
try
inherited;
//i?aaay eiiiea iuoee ?
if Msg.LParamHi = 516 then
Msg.Result:= MA_NOACTIVATEANDEAT;
// Ooo ii?ii anoaaeou eia aey iieacaiey naiaai iai?
except
end;
end;
//procenti zagruzki stranici
procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress, ProgressMax: Integer);
var xProgress:integer;
begin
// ProgressBar1.Max:=ProgressMax;
// ProgressBar1.Position:=Progress;
if ProgressMax = 0 then
begin
StatusBar1.Panels[0].Text := 'Redy for work';
Gauge1.Progress:=0;
Exit;
end;
try
if (Progress <> -1) and (Progress <= ProgressMax) then
begin
StatusBar1.Panels[0].Text:=IntToStr((Progress * 100) div ProgressMax) + '% loaded... ';
Gauge1.Progress:=(Progress * 100) div ProgressMax;
end
else
begin
StatusBar1.Panels[0].Text := '';
Gauge1.Progress:=0;
end;
except
on EDivByZero do Exit;
end;
end;
// nachalo Masiva dlja knopki "ENTER" (GOOD, work)...
procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
var
iOIPAO: IOleInPlaceActiveObject;
Dispatch: IDispatch;
begin
if not Assigned(WebBrowser1) then
begin
Handled := False;
Exit;
end;
Handled := (IsDialogMessage(WebBrowser1.Handle, Msg) = True);
if (Handled) and (not WebBrowser1.Busy) then
begin
if FOleInPlaceActiveObject = nil then
begin
Dispatch := WebBrowser1.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;
// konec Masiva dlja knopki "ENTER" (GOOD, work)...
procedure TForm1.Exit1Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
ppDisp := WebBrowser1.Application;
//Cancel := false;
Form2.WebBrowser2.Parent;
end;
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.
|
form2: | Код |
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, Gauges, ComCtrls, StdCtrls, Menus, ActiveX, Commctrl;
type
TForm2 = class(TForm)
WebBrowser2: TWebBrowser;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
WebBrowser2.Application;
end;
end.
|
Помогите пожалуйста раскидать всё по местам.... Ну никак не могу найти ошибку...  Зарание огромнейшее спасибо.... Это сообщение отредактировал(а) xoslv - 15.11.2007, 13:41 --------------------
Не всё то маздай, что синее! |
И снова окна... Проблема с WebBrowser1NewWindow2 
Загрузка ...
