Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > как связать EmbeddedWB1NewWindow2 с Paramstr(2)


Автор: s2004 2.10.2012, 19:58
в embeddedwb имеется событие  EmbeddedWB1NewWindow2 необходимое для открытия нового окна при кликание сылки при этом подставляется урл открывается новое окно, но при закрытие родительской формы всё тоже закрывается решил о необходимости запускать копию программы с подстановкой урла тут в некоторых форумах были советы с испрользованием  Paramstrp и shellexecute. 
перепрообвал многие, но только получилось так, что запускается копия и плюс ещё iexplorer ...

Код вначале который был
Код

procedure TForm1.EmbeddedWB1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
 var Cancel: WordBool);
 var NewWindow:TForm1;
begin

NewWindow := TForm1.Create(parent);
SetWindowLong(NewWindow.Handle, GWL_EXSTYLE, GetWindowLong(NewWindow.Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
NewWindow.Show;
ppDisp:=NewWindow.EmbeddedWB1.DefaultDispatch; 



коды некоторые которые перепробовал меня смущает, что получается в них я не задействовал
парметр заданый в событие это var ppDisp: IDispatch;

Код

procedure TForm1.EmbeddedWB1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
  var
    url,ts: string;
   NewWindow:TForm1;

begin
  with TRegistry.Create do
      try
        rootkey := HKEY_CLASSES_ROOT;
        OpenKey('\htmlfile\shell\open\command', False);
        try
          ts := ReadString('');
        except
          ts := '';
        end;
        CloseKey;
      finally
        Free;
      end;
    if ts = '' then Exit;

//winexec (Pchar('C:\Program Files\Net\net.exe'), SW_SHOWNORMAL);
  
 ts := Copy(ts, Pos('"', ts) + 1, Length(ts));
    ts := Copy(ts, 1, Pos('"', ts) - 1);
    ShellExecute(3, 'open', PChar('ppDisp:=NewWindow.EmbeddedWB1.DefaultDispatch'), PChar(url), nil, SW_SHOW);
//  ShellExecute( handle, 'net', PChar('C:\Program Files\Net\net.exe'), PChar(url), nil, SW_SHOW);
    
//ppDisp := Self.EmbeddedWB1.Application;
  end;


одним словом запутался  smile 

Автор: s2004 5.10.2012, 22:40
Код


 var
  newwindow:tform1;
//  dir:string;
begin
//   dir:=extractFilePath(ParamStr(0));

NewWindow := TForm1.Create(parent);
//SetWindowLong(NewWindow.Handle, GWL_EXSTYLE, GetWindowLong(NewWindow.Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
NewWindow.Show;
// dir:=extractFilePath(ParamStr(0));
ShellExecute(form1.Handle, 'open', 'c:\netwin.exe', nil, nil, SW_SHOWNORMAL);


// ShellExecute(Form1.Handle, paramstr(0),nil, nil, SW_SHOWNORMAL);
ppDisp:=NewWindow.EmbeddedWB1.DefaultDispatch;


запускается копия программы, но урл неподстовляется

Автор: s2004 6.10.2012, 18:32
по порядку в DRKB идёт такой пример
OnNewWindow2 
Возникает при попытке открыть документ в новом окне. Если Вы хотите, чтобы документ был открыт в Вашем экземпляре броузера, то Вам нужно создать свой экземпляр броузера и параметру ppDisp присвоить интерфейсную ссылку на этот экземпляр:
Код

procedure TFormSimpleWB.WebBrowser1NewWindow2(Sender: TObject;   
  var ppDisp: IDispatch; var Cancel: WordBool);   
var    
  newForm:TFormSimpleWB;   
begin    
  newForm := TFormSimpleWB.Create(Application);   
  newForm.Show;   
  ppDisp := newForm.WebBrowser1.ControlInterface;   
end;  

как видите код, как у меня практически,  он запускает новое окно, НО ТОЛЬКО, КАК ДОЧЕРНЕЕ при этом при закрытие родительского закрывается и дочернее на форуме http://forum.sources.ru/index.php?showtopic=346017 посоветовали использовать winexec (shellexec) в связки с paramcount при этом рассуждаем так 
Код

var    
  newForm:TFormSimpleWB;   

 
не нужен? ведь с помощью shellexecute мы должны запустить копию программы с диска по умолчанию в c:\program files\net\net.exe пробовал разные варианты 
перечисляю 
Код

 ShellExecute(handle,'open','net.exe', Pchar(d), nil, SW_RESTORE);
ShellExecute(handle,'open',PChar(d),PChar(newwindow.EmbeddedWB1.DefaultDispatch),nil, SW_SHOWNORMAL);
 ShellExecute(NewWindow.EmbeddedWB1.LoadFrameFromStrings, 'open', PChar(newWindow), nil, nil, SW_NORMAL);
 ShellExecute(NewWindow.Handle, 'open', 'www.scip.be', nil, nil, SW_SHOW);
ShellExecute (Form1.Handle, nil, PChar (Application.ExeName), nil, nil, SW_RESTORE);


но это запустит только копию программы с установочной папки а как сотворить подстановку урла?
Куда прикрутить ppdisp? 

Автор: s2004 7.10.2012, 22:22
Код

var
  Form1: TForm1;
  S:string; //тут будем хранить сылку на новое окно

procedure TForm1.EmbeddedWB1StatusTextChange(ASender: TObject;
  const Text: WideString);
begin
 StatusBar1.SimpleText:=Text;
  if Copy(Text, 1, 4)='http' then S:=Text; //Если ссылка, то ее записать
                                    //(вдруг потом нужно будет по ней перейти)



procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
begin
  Cancel:=True; //Заприщаем запуск обозревателя IE
  ShellExecute(Handle, 'open', PChar(ParamStr(0)), PChar(S), nil, 0);
    //Запускаем себя еще раз, только указав в параметрах ссылку на новое окно
    // можно и вкладки создать, как в опере... но это уже другой разговор =))
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if Form1.Tag=1 then Exit;
  If ParamCount>0 then   //Если имеется параметр, то переходим по нему
  begin
    Edit1.Text:=ParamStr(1);
    WebBrowser1.Navigate(ParamStr(1));
  end;
  Form1.Tag:=1; //Если сново будет вызов onshow, то ничего не делать
end;




вот нашёл на одном форуме 

Автор: s2004 7.10.2012, 22:51
вот только теперь любой клик открывается в новом окне ... а как сделать чтобы выбор был открыть в новом или в старом

Автор: s2004 8.10.2012, 20:09
Код

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
   const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
   Headers: OleVariant; var Cancel: WordBool);
 var
   newURL: string;
 begin
   newURL := URL;
   // For local links, don't show a dialog but open the file directly 
  if (not FIsStartPage) and FileExists(newURL) then
   begin
     Cancel := True;
     ShellExecute(Application.Handle, 'open', PChar(newURL), nil, nil, SW_NORMAL);
   end;
 end;



всё работает и в новом окне и в текущем...

Автор: Чучмек 9.10.2012, 01:57
Открытие страницы в  новом окне, это нечто большее, чем запуск копии браузера с новым урл. Сохраняется связь между старой страницей и новой.
Поэтому в  OnNewWindow2 мы имеем ppDisp: IDispatch, а не URL:string.
Правильное решение с другой стороны (COM).
Аналогично использованию MS Office через CreateOleObject('Word.Application') 

Автор: Чучмек 9.10.2012, 17:32
Отмечаю все сообщения минусом, потому что в корне неверное решение.
Если правая нога не лезет в левый ботинок - примотаем ботнки к ногам изолентой.

Автор: s2004 9.10.2012, 19:48
чучмек прочитай своё , что написал.... твоё сообщение один минус 

Повторю кто в танке, событие onnewwindow при использование
 
Код

ppDisp:=NewWindow.EmbeddedWB1.DefaultDispatch; 


открывала новое окно но только как дочернее которое закрывалось при закрытие родительского 
окна а мне в моей пргги этого не нужно
 поэтому код был изменён на 
Код

 Cancel:=True; //Запрещаем запуск обозревателя IE
  ShellExecute(Handle, 'open', PChar(ParamStr(0)), PChar(S), nil, 0);


при этом и запускается копия проги с диска с подстановкой урла, что мне и надо было, а различные опусы не нужны, выложил тем кому возможно понадобится. 

p.s.Модераторы прошу заблокировать тему без возможности суда ещё что- то писать. 

Автор: Чучмек 9.10.2012, 19:59
Писать лень.
Вот посмотри.

Автор: MetalFan 9.10.2012, 20:10
Цитата(s2004 @  9.10.2012,  19:48 Найти цитируемый пост)
Модераторы прошу заблокировать тему без возможности суда ещё что- то писать. 

ну-ну, полегче. не вижу повода для санкций.

Автор: Чучмек 9.10.2012, 20:14
Цитата(s2004 @  9.10.2012,  19:48 Найти цитируемый пост)
p.s.Модераторы прошу заблокировать тему без возможности суда ещё что- то писать. 

Встречная просьба повременить. Тема, на самом деле, интересная. Мне еще есть что сказать, в смысле кода, а не рассуждений. Сейчас не очень много времени, а нужно проверить прежде чем выкладывать 

Автор: s2004 9.10.2012, 20:15
архив посмотрел спасибо. это ещё одно решение - правда неудобно то, что на панели задач отображается в виде одного значка.

так я понял код будет интересен зрителям поэтому выложу его: 

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,unit2;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  form_count:cardinal=0;

function NewForm:Idispatch;
procedure DecFormCount;
implementation

{$R *.dfm}

function NewForm:Idispatch;
begin
 with TForm2.Create(Application)do
  begin
  visible:=true;
  result:=WebBrowser1.DefaultDispatch;
  inc(form_count);
  end;
end;

procedure DecFormCount;
begin
dec(form_count);
if form_count=0 then application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
NewForm;
end;

end.
 
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls;

type
  TForm2 = class(TForm)
    Panel1: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    WebBrowser1: TWebBrowser;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation
 uses unit1;

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate(edit1.Text);
end;

procedure TForm2.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
begin
 ppDisp:=NewForm;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DecFormCount;
end;

end.

Автор: Чучмек 9.10.2012, 20:22
Цитата(s2004 @  9.10.2012,  20:15 Найти цитируемый пост)
правда неудобно то, что на панели задач отображается в виде одного значка

Это тоже легко решаеться.

Автор: Чучмек 12.10.2012, 11:34
Вот. Наконец таки добрался.
В глубь по интерфейсам...
Перехват навигации. Пока без описания.   

unit1.pas
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Unit_Obj, OleCtrls, SHDocVw, StdCtrls,shellapi;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    WebBrowser2: TWebBrowser;
    Button1: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure cbp(s:widestring);
var param:string;
begin
 param:=s;
 shellexecute(0,nil,pchar(application.ExeName),pchar(param),nil,0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CallbackProc:=cbp;
  if ParamCount>0 then WebBrowser1.Navigate(ParamStr(1));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate(edit1.Text);
end;

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
begin
 ppDisp:=TMyIC.Create(WebBrowser2.DefaultDispatch);
end;

end.


Unit_Obj.pas
Код

unit Unit_Obj;

interface

uses Unit_Interfaces,windows,urlmon,sysutils;


type
  TCallbackProc=procedure(url:widestring);

 TMyIC=class(TInterfacedObject,IDispatch)
  private
   FDisp:IDispatch;
  public
   constructor Create(Disp:IDispatch);
  protected
   function GetTypeInfoCount(out Count:integer):Hresult;stdcall;
   function GetTypeInfo(Index:Integer;LocaleId:Integer;out TypeInfo):Hresult;stdcall;
   function GetIDsOfNames(const IID:TGUID;Names:pointer;NameCount,LocaleID:integer;DispIDs:pointer):Hresult;stdcall;
   function Invoke(DispID:Integer;const IID:TGUID;LocaleID:Integer;Flags:Word;var Params;VarResult,ExcepInfo,ArgErr:pointer):Hresult;stdcall;
   function QueryInterface(const IID:TGUID;out Obj):Hresult;stdcall;
  end;

var CallbackProc:TCallbackProc=nil;

implementation

type

 TTargetFramePriv = class (TInterfacedObject,ITargetFramePriv)
  private
   FTargetFramePriv:ITargetFramePriv;
  public
   constructor create(TargetFramePriv:ITargetFramePriv);
  protected
   function  FindFrameDownwards(pszTargetName:LPCWSTR;dwFlags:DWORD;out ppunkTargetFrame:IUnknown ):HRESULT;stdcall;
   function  FindFrameInContext(pszTargetName:LPCWSTR;punkContextFrame: IUnknown;dwFlags:DWORD;out ppunkTargetFrame:IUnknown):HRESULT;stdcall;
   function  OnChildFrameActivate(pUnkChildFrame:IUnknown):HRESULT;stdcall;
   function  OnChildFrameDeactivate(pUnkChildFrame:IUnknown):HRESULT;stdcall;
   function  NavigateHack(grfHLNF:DWORD;pbc:cardinal{LPBC};pibsc: IBindStatusCallback;pszTargetName:LPCWSTR;pszUrl:LPCWSTR;pszLocation:LPCWSTR):HRESULT;stdcall;
   function  FindBrowserByIndex(dwID:DWORD;out ppunkBrowser: IUnknown):HRESULT;stdcall;
   function  QueryInterface(const IID:TGUID;out Obj):Hresult;stdcall;
  end;

 TTargetFramePriv2 = class(TTargetFramePriv,ITargetFramePriv2)
  public
    constructor Create(TargetFramePriv2:ITargetFramePriv2);
  protected
    function  AggregatedNavigation2(grfHLNF:DWORD;pbc:cardinal{LPBC;};pibsc:IBindStatusCallback;pszTargetName:LPCWSTR;pUri:IUri;pszLocation:LPCWSTR):HRESULT;stdcall;
  end;

 TUri_Property_Type=(PropertyNo,PropertyDWORD,PropertyStr);

 TUri_Property=record
  Property_Type : TUri_Property_Type;
  case  TUri_Property_Type of
   PropertyDWORD:   (vdw:dword);
   PropertyStr:     (vws:pwidechar);
 end;

 TPropertyTable = array [Uri_PROPERTY] of TUri_Property;

 TUri=class(TInterfacedObject,IUri)
  private
   FPropertyTable:TPropertyTable;
   FPropertyFlags:cardinal;
  public
   constructor create(PropertyTable:TPropertyTable);
  protected
   function GetPropertyBSTR(uriProp:Uri_PROPERTY;var pbstrProperty:BSTR;dwFlags:DWORD):HRESULT;stdcall;
   function GetPropertyLength(uriProp:Uri_PROPERTY;var pcchProperty:DWORD;dwFlags:DWORD):HRESULT;stdcall;
   function GetPropertyDWORD(uriProp:Uri_PROPERTY;var pdwProperty:DWORD;dwFlags:DWORD):HRESULT;stdcall;
   function HasProperty(uriProp:Uri_PROPERTY;var pfHasProperty:BOOL):HRESULT;stdcall;
   function GetAbsoluteUri(var pbstrAbsoluteUri:BSTR):HRESULT;stdcall;
   function GetAuthority(var pbstrAuthority:BSTR):HRESULT;stdcall;
   function GetDisplayUri(var pbstrDisplayString:BSTR):HRESULT;stdcall;
   function GetDomain(var pbstrDomain:BSTR):HRESULT;stdcall;
   function GetExtension(var pbstrExtension:BSTR):HRESULT;stdcall;
   function GetFragment(var pbstrFragment:BSTR):HRESULT;stdcall;
   function GetHost(var pbstrHost:BSTR):HRESULT;stdcall;
   function GetPassword(var pbstrPassword:BSTR):HRESULT;stdcall;
   function GetPath(var pbstrPath:BSTR):HRESULT;stdcall;
   function GetPathAndQuery(var pbstrPathAndQuery:BSTR):HRESULT;stdcall;
   function GetQuery(var pbstrQuery:BSTR):HRESULT;stdcall;
   function GetRawUri(var pbstrRawUri:BSTR):HRESULT;stdcall;
   function GetSchemeName(var pbstrSchemeName:BSTR):HRESULT;stdcall;
   function GetUserInfo(var pbstrUserInfo:BSTR):HRESULT;stdcall;
   function GetUserName(var pbstrUserName:BSTR):HRESULT;stdcall;
   function GetHostType(var pdwHostType:DWORD):HRESULT;stdcall;
   function GetPort(var pdwPort:DWORD):HRESULT;stdcall;
   function GetScheme(var pdwScheme:DWORD):HRESULT;stdcall;
   function GetZone(var pdwZone:DWORD):HRESULT;stdcall;
   function GetProperties(pdwFlags:LPDWORD):HRESULT;stdcall;
   function IsEqual(pUri:IUri;var pfEqual:BOOL):HRESULT;stdcall;
  end;

 { TMyIC }
constructor TMyIC.Create(Disp:IDispatch);
begin
FDisp:=Disp;
end;

function TMyIC.GetTypeInfoCount(out Count:integer):Hresult;stdcall;
begin
result:=FDisp.GetTypeInfoCount(Count);
end;

function TMyIC.GetTypeInfo(Index:Integer;LocaleId:Integer;out TypeInfo):Hresult;stdcall;
begin
result:=FDisp.GetTypeInfo(Index,LocaleId,TypeInfo);
end;

function TMyIC.GetIDsOfNames(const IID:TGUID;Names:pointer;NameCount,LocaleID:integer;DispIDs:pointer):Hresult;stdcall;
begin
result:=FDisp.GetIDsOfNames(IID,Names,NameCount,LocaleID,DispIDs);
end;

function TMyIC.Invoke(DispID:Integer;const IID:TGUID;LocaleID:Integer;Flags:Word;var Params;VarResult,ExcepInfo,ArgErr:pointer):Hresult;stdcall;
begin
result:=FDisp.Invoke(DispID,IID,LocaleID,Flags,Params,VarResult,ExcepInfo,ArgErr);
end;

function TMyIC.QueryInterface(const IID:TGUID;out Obj):Hresult;stdcall;
begin
result:=FDisp.QueryInterface(IID,Obj);
if result<>0 then exit;
if IsEqualGUID(IID,IID_TargetFramePriv)then
  ITargetFramePriv(obj):=TTargetFramePriv.create(ITargetFramePriv(obj))as ITargetFramePriv else
if IsEqualGUID(IID,IID_TargetFramePriv2)then
  ITargetFramePriv2(obj):=TTargetFramePriv2.create(ITargetFramePriv2(obj))as ITargetFramePriv2;
end;

{ TTargetFramePriv }

constructor TTargetFramePriv.create(TargetFramePriv: ITargetFramePriv);
begin
FTargetFramePriv:=TargetFramePriv;
end;

function TTargetFramePriv.FindBrowserByIndex(dwID: DWORD;
  out ppunkBrowser: IInterface): HRESULT;
begin
result:=FTargetFramePriv.FindBrowserByIndex(dwID,ppunkBrowser);
end;

function TTargetFramePriv.FindFrameDownwards(pszTargetName: LPCWSTR;
  dwFlags: DWORD; out ppunkTargetFrame: IInterface): HRESULT;
begin
result:=FTargetFramePriv.FindFrameDownwards(pszTargetName,dwFlags,ppunkTargetFrame);
end;

function TTargetFramePriv.FindFrameInContext(pszTargetName: LPCWSTR;
  punkContextFrame: IInterface; dwFlags: DWORD;
  out ppunkTargetFrame: IInterface): HRESULT;
begin
result:=FTargetFramePriv.FindFrameInContext(pszTargetName,punkContextFrame,dwFlags,ppunkTargetFrame);
end;

function TTargetFramePriv.NavigateHack(grfHLNF: DWORD; pbc: cardinal;
  pibsc: IBindStatusCallback; pszTargetName, pszUrl,
  pszLocation: LPCWSTR): HRESULT;
var i:IInterface;
begin
if (pbc<>0) and (pibsc<>nil)  then
 begin
 if Assigned(CallbackProc) then CallbackProc(pszUrl);
 pszUrl:='about:blank';
 end; 
result:=FTargetFramePriv.NavigateHack(grfHLNF,pbc,pibsc,pszTargetName,pszUrl,pszLocation);
end;

function TTargetFramePriv.OnChildFrameActivate(
  pUnkChildFrame: IInterface): HRESULT;
begin
result:=FTargetFramePriv.OnChildFrameActivate(pUnkChildFrame);
end;

function TTargetFramePriv.OnChildFrameDeactivate(
  pUnkChildFrame: IInterface): HRESULT;
begin
result:=FTargetFramePriv.OnChildFrameDeactivate(pUnkChildFrame);
end;

function TTargetFramePriv.QueryInterface(const IID: TGUID;
  out Obj): Hresult;
begin
result:=FTargetFramePriv.QueryInterface(IID,Obj);
end;



const PropertyTable:TPropertyTable=
 (
  (Property_Type:PropertyStr;  vws:'about:blank'),          //Uri_PROPERTY_ABSOLUTE_URI
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_AUTHORITY
  (Property_Type:PropertyStr;  vws:'about:blank'),          //Uri_PROPERTY_DISPLAY_URI
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_DOMAIN
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_EXTENSION
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_FRAGMENT
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_HOST
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_PASSWORD
  (Property_Type:PropertyStr;  vws:'blank'),                //Uri_PROPERTY_PATH
  (Property_Type:PropertyStr;  vws:'blank'),                //Uri_PROPERTY_PATH_AND_QUERY
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_QUERY
  (Property_Type:PropertyStr;  vws:'about:blank'),          //Uri_PROPERTY_RAW_URI
  (Property_Type:PropertyStr;  vws:'about'),                //Uri_PROPERTY_SCHEME_NAME
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_USER_INFO
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_USER_NAME
  (Property_Type:PropertyDWORD;vdw:DWORD(Uri_HOST_UNKNOWN)),//Uri_PROPERTY_HOST_TYPE
  (Property_Type:PropertyNo;   vdw:0),                      //Uri_PROPERTY_PORT
  (Property_Type:PropertyDWORD;vdw:DWORD(URL_SCHEME_ABOUT)),//Uri_PROPERTY_SCHEME
  (Property_Type:PropertyNo;   vdw:0)                       //Uri_PROPERTY_ZONE
 );




{ TTargetFramePriv2 }

function TTargetFramePriv2.AggregatedNavigation2(grfHLNF: DWORD;
  pbc: cardinal; pibsc: IBindStatusCallback; pszTargetName: LPCWSTR;
  pUri: IUri; pszLocation: LPCWSTR): HRESULT;
var
 url:WideString;
begin
if Assigned(CallbackProc) and (0=pUri.GetAbsoluteUri(url))then CallbackProc(url);
pUri:=TUri.Create(PropertyTable) as IUri;
result:=ITargetFramePriv2(FTargetFramePriv).AggregatedNavigation2(grfHLNF,pbc,pibsc,pszTargetName,pUri,pszLocation);
end;

constructor TTargetFramePriv2.Create(TargetFramePriv2: ITargetFramePriv2);
begin
  FTargetFramePriv:=ITargetFramePriv(TargetFramePriv2);
end;

{ TUri }

constructor TUri.Create(PropertyTable:TPropertyTable);
var
 i:Uri_PROPERTY;
 fr:dword;
begin
FPropertyTable:=PropertyTable;
FPropertyFlags:=0;
for i:=Uri_PROPERTY_ABSOLUTE_URI to Uri_PROPERTY_ZONE do
 if FPropertyTable[i].Property_Type<>PropertyNo then FPropertyFlags:=FPropertyFlags or(1 shl DWORD(i));
end;

function TUri.GetAbsoluteUri(var pbstrAbsoluteUri: BSTR): HRESULT;
begin
result:= GetPropertyBSTR(Uri_PROPERTY_ABSOLUTE_URI,pbstrAbsoluteUri,0);
end;

function TUri.GetAuthority(var pbstrAuthority: BSTR): HRESULT;
begin
result:= GetPropertyBSTR(Uri_PROPERTY_AUTHORITY,pbstrAuthority,0);
end;

function TUri.GetDisplayUri(var pbstrDisplayString: BSTR): HRESULT;
begin
result:= GetPropertyBSTR(Uri_PROPERTY_DISPLAY_URI,pbstrDisplayString,0);
end;

function TUri.GetDomain(var pbstrDomain: BSTR): HRESULT;
begin
result:= GetPropertyBSTR(Uri_PROPERTY_DOMAIN,pbstrDomain,0);
end;

function TUri.GetExtension(var pbstrExtension: BSTR): HRESULT;
begin
result:= GetPropertyBSTR(Uri_PROPERTY_EXTENSION,pbstrExtension,0);
end;

function TUri.GetFragment(var pbstrFragment: BSTR): HRESULT;
begin
result:= GetPropertyBSTR(Uri_PROPERTY_FRAGMENT,pbstrFragment,0);
end;

function TUri.GetHost(var pbstrHost: BSTR): HRESULT;
begin
result:= GetPropertyBSTR(Uri_PROPERTY_HOST,pbstrHost,0);
end;

function TUri.GetHostType(var pdwHostType: DWORD): HRESULT;
begin
result:= GetPropertyDWORD(Uri_PROPERTY_HOST_TYPE,pdwHostType,0);
end;

function TUri.GetPassword(var pbstrPassword: BSTR): HRESULT;
begin
Result:=GetPropertyBSTR(Uri_PROPERTY_PASSWORD,pbstrPassword,0);
end;

function TUri.GetPath(var pbstrPath: BSTR): HRESULT;
begin
Result:=GetPropertyBSTR(Uri_PROPERTY_PATH,pbstrPath,0);
end;

function TUri.GetPathAndQuery(var pbstrPathAndQuery: BSTR): HRESULT;
begin
Result:=GetPropertyBSTR(Uri_PROPERTY_PATH_AND_QUERY,pbstrPathAndQuery,0);
end;

function TUri.GetPort(var pdwPort: DWORD): HRESULT;
begin
Result:=GetPropertyDWORD(Uri_PROPERTY_PORT,pdwPort,0);
end;

function TUri.GetProperties(pdwFlags: LPDWORD): HRESULT;
begin
if pdwFlags=nil then result:=S_FALSE else
 begin
 pdwFlags^:=FPropertyFlags;
 result:=0;
 end;
end;

function TUri.GetPropertyBSTR(uriProp: Uri_PROPERTY;
  var pbstrProperty: BSTR; dwFlags: DWORD): HRESULT;
begin
if (dword(uriProp)>18) or (FPropertyTable[uriProp].Property_Type=PropertyNo) then result:=S_FALSE else
if FPropertyTable[uriProp].Property_Type<>PropertyStr then Result:=E_INVALIDARG else
 begin
 pbstrProperty:=FPropertyTable[uriProp].vws;
 result:=S_OK;
 end;
end;

function TUri.GetPropertyDWORD(uriProp: Uri_PROPERTY;
  var pdwProperty: DWORD; dwFlags: DWORD): HRESULT;
begin
if (dword(uriProp)>18) or (FPropertyTable[uriProp].Property_Type=PropertyNo) then result:=S_FALSE else
if FPropertyTable[uriProp].Property_Type<>PropertyDWORD then Result:=E_INVALIDARG else
 begin
 pdwProperty:=FPropertyTable[uriProp].vdw;
 result:=S_OK;
 end;
end;

function TUri.GetPropertyLength(uriProp: Uri_PROPERTY;
  var pcchProperty: DWORD; dwFlags: DWORD): HRESULT;
begin
if (dword(uriProp)>18) or (FPropertyTable[uriProp].Property_Type=PropertyNo) then result:=S_FALSE else
if FPropertyTable[uriProp].Property_Type<>PropertyStr then Result:=E_INVALIDARG else
 begin
 pcchProperty:=length(FPropertyTable[uriProp].vws);
 result:=S_OK;
 end;
end;

function TUri.GetQuery(var pbstrQuery: BSTR): HRESULT;
begin
Result:=GetPropertyBSTR(Uri_PROPERTY_QUERY,pbstrQuery,0);
end;

function TUri.GetRawUri(var pbstrRawUri: BSTR): HRESULT;
begin
Result:=GetPropertyBSTR(Uri_PROPERTY_RAW_URI,pbstrRawUri,0);
end;

function TUri.GetScheme(var pdwScheme: DWORD): HRESULT;
begin
Result:=GetPropertyDWORD(Uri_PROPERTY_SCHEME,pdwScheme,0);
end;

function TUri.GetSchemeName(var pbstrSchemeName: BSTR): HRESULT;
begin
Result:=GetPropertyBSTR(Uri_PROPERTY_SCHEME_NAME,pbstrSchemeName,0);
end;

function TUri.GetUserInfo(var pbstrUserInfo: BSTR): HRESULT;
begin
Result:=GetPropertyBSTR(Uri_PROPERTY_USER_INFO,pbstrUserInfo,0);
end;

function TUri.GetUserName(var pbstrUserName: BSTR): HRESULT;
begin
Result:=GetPropertyBSTR(Uri_PROPERTY_USER_NAME,pbstrUserName,0);
end;

function TUri.GetZone(var pdwZone: DWORD): HRESULT;
begin
Result:=GetPropertyDWORD(Uri_PROPERTY_ZONE,pdwZone,0);
end;

function TUri.HasProperty(uriProp: Uri_PROPERTY;
  var pfHasProperty: BOOL): HRESULT;
begin
result:=S_OK;
pfHasProperty:=(dword(uriProp)<18) and (FPropertyTable[uriProp].Property_Type<>PropertyNo);
end;

function TUri.IsEqual(pUri: IUri; var pfEqual: BOOL): HRESULT;
begin
result:=0;
pfEqual:=false;
//  Для правильной работы  IsEqual необходимо разкомментировать последующий код,
//  но, если pUri, также, является интерфейсом от TUri, получим  stack overflow !!!
{
if pUri=nil then pfEqual:=false else
 try
  if 0<>pUri.IsEqual(self as iuri,pfEqual)then pfEqual:=false;
 except
  pfEqual:=false;
 end;
}
end;


end.


Unit_Interfaces.pas
Код

unit Unit_Interfaces;

interface
uses windows,urlmon;

const
  IID_Uri = '{a39ee748-6a27-4817-a6f2-13914bef5890}';
  IID_TargetFramePriv:TGUID = '{9216E421-2BF5-11D0-82B4-00A0C90C29C5}';
  IID_TargetFramePriv2:TGUID = '{b2c867e6-69d6-46f2-a611-ded9a4bd7fef}';

type
BSTR=WideString;

Uri_PROPERTY =(
  Uri_PROPERTY_ABSOLUTE_URI = 0,
  Uri_PROPERTY_STRING_START = Uri_PROPERTY_ABSOLUTE_URI,
  Uri_PROPERTY_AUTHORITY = 1,
  Uri_PROPERTY_DISPLAY_URI = 2,
  Uri_PROPERTY_DOMAIN = 3,
  Uri_PROPERTY_EXTENSION = 4,
  Uri_PROPERTY_FRAGMENT = 5,
  Uri_PROPERTY_HOST = 6,
  Uri_PROPERTY_PASSWORD = 7,
  Uri_PROPERTY_PATH = 8,
  Uri_PROPERTY_PATH_AND_QUERY = 9,
  Uri_PROPERTY_QUERY = 10,
  Uri_PROPERTY_RAW_URI = 11,
  Uri_PROPERTY_SCHEME_NAME = 12,
  Uri_PROPERTY_USER_INFO = 13,
  Uri_PROPERTY_USER_NAME = 14,
  Uri_PROPERTY_STRING_LAST = Uri_PROPERTY_USER_NAME,
  Uri_PROPERTY_HOST_TYPE = 15,
  Uri_PROPERTY_DWORD_START = Uri_PROPERTY_HOST_TYPE,
  Uri_PROPERTY_PORT = 16,
  Uri_PROPERTY_SCHEME = 17,
  Uri_PROPERTY_ZONE = 18,
  Uri_PROPERTY_DWORD_LAST = Uri_PROPERTY_ZONE
 );

Uri_HOST_TYPE =(
  Uri_HOST_UNKNOWN = 0,
  Uri_HOST_DNS = 1,
  Uri_HOST_IPV4 = 2,
  Uri_HOST_IPV6 = 3,
  Uri_HOST_IDN = 4
  );

TURL_SCHEME = (
    URL_SCHEME_INVALID = -1,
    URL_SCHEME_UNKNOWN = 0,
    URL_SCHEME_FTP,
    URL_SCHEME_HTTP,
    URL_SCHEME_GOPHER,
    URL_SCHEME_MAILTO,
    URL_SCHEME_NEWS,
    URL_SCHEME_NNTP,
    URL_SCHEME_TELNET,
    URL_SCHEME_WAIS,
    URL_SCHEME_FILE,
    URL_SCHEME_MK,
    URL_SCHEME_HTTPS,
    URL_SCHEME_SHELL,
    URL_SCHEME_SNEWS,
    URL_SCHEME_LOCAL,
    URL_SCHEME_JAVASCRIPT,
    URL_SCHEME_VBSCRIPT,
    URL_SCHEME_ABOUT,
    URL_SCHEME_RES,
    URL_SCHEME_MSSHELLROOTED,
    URL_SCHEME_MSSHELLIDLIST,
    URL_SCHEME_MSHELP,
    URL_SCHEME_MSSHELLDEVICE,
    URL_SCHEME_WILDCARD,
    URL_SCHEME_SEARCH_MS,
    URL_SCHEME_SEARCH,
    URL_SCHEME_KNOWNFOLDER,
    URL_SCHEME_MAXVALUE);

 IUri =  interface(IUnknown)
  ['{a39ee748-6a27-4817-a6f2-13914bef5890}']
   function GetPropertyBSTR(uriProp:Uri_PROPERTY;var pbstrProperty:BSTR;dwFlags:DWORD):HRESULT;stdcall;
   function GetPropertyLength(uriProp:Uri_PROPERTY;var pcchProperty:DWORD;dwFlags:DWORD):HRESULT;stdcall;
   function GetPropertyDWORD(uriProp:Uri_PROPERTY;var pdwProperty:DWORD;dwFlags:DWORD):HRESULT;stdcall;
   function HasProperty(uriProp:Uri_PROPERTY;var pfHasProperty:BOOL):HRESULT;stdcall;
   function GetAbsoluteUri(var pbstrAbsoluteUri:BSTR):HRESULT;stdcall;
   function GetAuthority(var pbstrAuthority:BSTR):HRESULT;stdcall;
   function GetDisplayUri(var pbstrDisplayString:BSTR):HRESULT;stdcall;
   function GetDomain(var pbstrDomain:BSTR):HRESULT;stdcall;
   function GetExtension(var pbstrExtension:BSTR):HRESULT;stdcall;
   function GetFragment(var pbstrFragment:BSTR):HRESULT;stdcall;
   function GetHost(var pbstrHost:BSTR):HRESULT;stdcall;
   function GetPassword(var pbstrPassword:BSTR):HRESULT;stdcall;
   function GetPath(var pbstrPath:BSTR):HRESULT;stdcall;
   function GetPathAndQuery(var pbstrPathAndQuery:BSTR):HRESULT;stdcall;
   function GetQuery(var pbstrQuery:BSTR):HRESULT;stdcall;
   function GetRawUri(var pbstrRawUri:BSTR):HRESULT;stdcall;
   function GetSchemeName(var pbstrSchemeName:BSTR):HRESULT;stdcall;
   function GetUserInfo(var pbstrUserInfo:BSTR):HRESULT;stdcall;
   function GetUserName(var pbstrUserName:BSTR):HRESULT;stdcall;
   function GetHostType(var pdwHostType:DWORD):HRESULT;stdcall;
   function GetPort(var pdwPort:DWORD):HRESULT;stdcall;
   function GetScheme(var pdwScheme:DWORD):HRESULT;stdcall;
   function GetZone(var pdwZone:DWORD):HRESULT;stdcall;
   function GetProperties(pdwFlags:LPDWORD):HRESULT;stdcall;
   function IsEqual(pUri:IUri;var pfEqual:BOOL):HRESULT;stdcall;
 end;

 ITargetFramePriv = interface(IUnknown)
  ['{9216e421-2bf5-11d0-82b4-00a0c90c29c5}']
   function  FindFrameDownwards(pszTargetName:LPCWSTR;dwFlags:DWORD;out ppunkTargetFrame:IUnknown ):HRESULT;stdcall;
   function  FindFrameInContext(pszTargetName:LPCWSTR;punkContextFrame: IUnknown;dwFlags:DWORD;out ppunkTargetFrame:IUnknown):HRESULT;stdcall;
   function  OnChildFrameActivate(pUnkChildFrame:IUnknown):HRESULT;stdcall;
   function  OnChildFrameDeactivate(pUnkChildFrame:IUnknown):HRESULT;stdcall;
   function  NavigateHack(grfHLNF:DWORD;pbc:cardinal{LPBC;};pibsc: IBindStatusCallback;pszTargetName:LPCWSTR;pszUrl:LPCWSTR;pszLocation:LPCWSTR):HRESULT;stdcall;
   function  FindBrowserByIndex(dwID:DWORD;out ppunkBrowser: IUnknown):HRESULT;stdcall;
 end;

 ITargetFramePriv2 = interface(ITargetFramePriv)
  ['{b2c867e6-69d6-46f2-a611-ded9a4bd7fef}']
   function  AggregatedNavigation2(grfHLNF:DWORD;pbc:cardinal{LPBC;};pibsc:IBindStatusCallback;pszTargetName:LPCWSTR;pUri:IUri;pszLocation:LPCWSTR):HRESULT;stdcall;
 end;

implementation

end. 

Автор: Чучмек 12.10.2012, 12:11
Этот код не имеет практического значения. Поскольку требует второго (скрытого) WB.
С дополнительным WB все делается гораздо проще - через OnBeforeNavigate2.
Однако, код показывает, как происходит открытие новой страницы.
Через передаваемый в ppDisp, события OnNewWindow2, интерфес wb.DefaultDispatch, запрашивается ряд интерфейсов.
В том числе ITargetFramePriv/ITargetFramePriv2.
Для перехвата запроса интерфейсов  используем  TMyIC (метод  QueryInterface).
При запросе ITargetFramePriv/ITargetFramePriv2 передаем интерфейс от TTargetFramePriv/TTargetFramePriv2.
При запросе остальных интерфейсов, передаем оригинальные интерфейсы от WB2.
Через ITargetFramePriv/ITargetFramePriv2 происходит передача url в новую страницу.
ITargetFramePriv - в старых версиях IE (метод NavigateHack), ITargetFramePriv2 (метод AggregatedNavigation2) - в новых.
TTargetFramePriv/TTargetFramePriv2 - служат для перехвата передачи url.
В ITargetFramePriv.NavigateHack url передается в виде WideString.  (передаем в CallbackProc, и меняем на about:blank)
В ITargetFramePriv2.AggregatedNavigation2 url передается в виде интерфейса IUri (в CallbackProc передаем строку полученную через pUri.GetAbsoluteUri, а вместо pUri передаем интерфейс от TUri)  

При желании можно написать заглушки для необходимых интерфейсов. Тогда второй WB не понадобиться.  

 

Автор: Чучмек 12.10.2012, 23:22
Цитата(Чучмек @  9.10.2012,  20:22 Найти цитируемый пост)
Это тоже легко решается. 

Чтобы не быть голословным...

Автор: s2004 13.10.2012, 17:56
попробовал последний архив, но значки просто так же, как у меня в программе отражаются- без содержимого? а я вроде докуче спрашивал чтобы именно с отражением сылки, так выбрать нужное окно легче. скомпиллировалось без проблем ошибки нет?

Добавлено @ 18:00
коды привидённые в теме желательно поместить в FAQ или DRKB? а то там очень бедно по поводу брузера.

Чучмек? архивы одинаковые....

Автор: Чучмек 16.10.2012, 07:55
Цитата(s2004 @  13.10.2012,  17:56 Найти цитируемый пост)
Чучмек? архивы одинаковые....

Да нет, отличаются настолько, насколько 
Цитата
легко решается
.

Цитата(s2004 @  13.10.2012,  17:56 Найти цитируемый пост)
попробовал последний архив, но значки просто так же, как у меня в программе отражаются- без содержимого? а я вроде докуче спрашивал чтобы именно с отражением сылки, так выбрать нужное окно легче

Это ты в другой теме спрашивал.
...Ну хорошо.
Элементарно Уатсон. smile 
Я дурак, обещаю исправится smile  

Автор: s2004 16.10.2012, 20:27
запустил последний архив. значки, как отражались Form2 так и отражаются как и у меня. выбрать нужный значок нельзя -  не открыв его и содержимое заглавия страницы не отражено. 

Автор: Чучмек 16.10.2012, 20:56
user posted image
Разве ни это надо?

Автор: s2004 16.10.2012, 20:59
да надо так, но у меня всё скомпилировалось, а этого нет -только form2 и всё.
хорошо бы, если вместе form 2 отражалась и сылка страницы.

Автор: Чучмек 16.10.2012, 21:02
Aero в винде включено?

Автор: s2004 16.10.2012, 21:07
у меня виста basic, надо и чтобы в ХР работало.

Автор: Чучмек 16.10.2012, 21:29
Цитата(s2004 @  16.10.2012,  21:07 Найти цитируемый пост)
у меня виста basic, надо и чтобы в ХР работало.

Да не, это семерошный наворот.
Он и так, сам по себе работает. Завтычил.Исправлюсь.Посмотрю,что можно сделать.

Добавлено @ 21:36
Добавь обработчик OnTitleChange
Вот тебе еще вариант.

Автор: s2004 17.10.2012, 20:02
вот то, что практически нужно (правда  без миниатюр) Чучмек благодарю smile.
выложу код думаю всем будет интересно

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,unit2;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  form_count:cardinal=0;



function NewForm:Idispatch;
procedure DecFormCount;
implementation

{$R *.dfm}

function NewForm:Idispatch;
begin
 with TForm2.Create(nil)do
  begin
  caption:=FormCaption;
  visible:=true;
  result:=WebBrowser1.DefaultDispatch;
  inc(form_count);
  end;
end;

procedure DecFormCount;
begin
dec(form_count);
if form_count=0 then application.Terminate;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
NewForm;
end;

end.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls;

type
  TForm2 = class(TForm)
    Panel1: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    WebBrowser1: TWebBrowser;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WebBrowser1TitleChange(Sender: TObject;
      const Text: WideString);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

const FormCaption='Moй браузер';

implementation
 uses unit1;

{$R *.dfm}



procedure TForm2.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate(edit1.Text);
end;

procedure TForm2.WebBrowser1NewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
begin
 ppDisp:=NewForm;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DecFormCount;
end;

procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited;
Params.WndParent:=GetDesktopWindow;
end;

procedure TForm2.WebBrowser1TitleChange(Sender: TObject;
  const Text:WideString );
begin
Caption:=FormCaption+':'+Text;

end;

end.

Автор: s2004 17.10.2012, 20:55
у меня код
Код

program net;

uses
  Forms,windows,
  Unit1 in 'Unit1.pas' {Form1},
  adCpuUsage in 'adCpuUsage.pas',
  Unit3 in 'Unit3.pas' {Form3},
  MSHTML_TLB in 'c:\program files\borland\bds\4.0\Imports\MSHTML_TLB.pas',
  Unit16 in 'Unit16.pas' {Form16},
  Unit9 in 'Unit9.pas' {Form9},
  Unit23 in 'Unit23.pas' {Form23},
  Unit20 in 'Unit20.pas' {Form20},
  Unit10 in 'Unit10.pas' {Form10};

{$R *.res}

begin
//  Application.ShowMainForm:=false;
  Application.Initialize;
//  Application.Title := '';
//  Application.ShowMainForm:=false;
  Application.HelpFile := 'D:\2005\help.hlp';
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm3, Form3);
  Application.CreateForm(TForm3, Form3);
  Application.CreateForm(TForm23, Form23);
  Application.CreateForm(TForm20, Form20);
  Application.CreateForm(TForm9, Form9);
  Application.CreateForm(TForm16, Form16);
  Application.CreateForm(TForm10, Form10);
  ShowWindow(Application.Handle, SW_HIDE);
  Application.Run;
end.



если 

ввожу
Код


Application.ShowMainForm:=false;
ругается на разные типы boolen и integer


поэтому в твоём архиве компиляция без проблем и всё работает, но у меня пока не работает.

Автор: Чучмек 18.10.2012, 20:12
Значит у тебя, в каком то модуле, до implementation есть что-нибудь типа
Код

var false:integer;
или
Код

 const false=0;

Если не хочешь исправлять (а НАДО) - напиши
Код

Application.ShowMainForm:=1=0;

Автор: s2004 18.10.2012, 20:23
да это я нашёл убирал, подстовлял твой код в свою прогу, так она hidden получается в диспечере висит, а так не видно.

событие formcreate NewForm; сделала скрытым браузер при заремачивание начинает работать, но неполностью правильно. запускается прога- клик на сылку открывается новое окно при этом отображается название каждое своё в каждом окне, но вместо например двух значков проги на панели задач видны 3 значка.

Автор: Чучмек 18.10.2012, 20:54
А ты не понял зачем это?
Как в примере?
Основное окно приложения делаем не видимым 
Код

 ShowWindow(Application.Handle, SW_HIDE);

Из панели задач исчезает кнопка "Project1"
Главную форму приложения делаем невидимой / скрытой 
Код

Application.ShowMainForm:=false;

Главная форма у нас ничего не содержит.
В событии главной формы OnCreate, создаем (Через TFormN.Create) видимую форму - окно браузера.
При закрытии окна браузера, завершение приложения НЕ ПРОИСХОДИТ.
Этим решаем проблему, с которой ты начинал эту тему.
 

Автор: s2004 19.10.2012, 20:39
Чучмек, если заремачено
Код

Application.ShowMainForm:=false;
 ShowWindow(Application.Handle, SW_HIDE);
 NewForm; 

то браузер работает, но не совсем правильно 
http://www.radikal.ru
виден третий значок на панели задач (окон браузера только два),
если строки кода прописаны ТО БРАУЗЕРА НЕТ, НИ ГЛАВНОГО ОКНА, НИ ФОРМЫ  просто есть отражение в диспечере задач ну как "троян". весь остальной код, как у тебя.

Автор: Чучмек 20.10.2012, 07:46
Скинь. Я посмотрю.

Автор: s2004 20.10.2012, 20:30
вышлю через личку

Автор: Чучмек 20.10.2012, 22:00
Ты так ничего не понял. Читай мой пост через один вверх.
Давай заново.
Из юнита, из того, который ты мне скинул, -(Unit1)
Удаляй 
Код

var

  form_count:cardinal=0;

Код

function NewForm:Idispatch;
procedure DecFormCount;


Код

function NewForm:Idispatch;
begin
 with TForm2.Create(nil)do
  begin
  caption:=FormCaption;
  visible:=true;
  result:=WebBrowser1.DefaultDispatch;
  inc(form_count);
  end;
end;

procedure DecFormCount;
begin
dec(form_count);
if form_count=0 then application.Terminate;
end;


из TForm1.FormCreate удаляй NewForm;

Потом File->New->Form
Form.Name=FormXXX

Юнит новой формы сохрани как StartForm_Unit
в нем
Код

unit StartForm_Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,unit1;

type
  TFormXXX = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormXXX: TFormXXX;
  form_count:cardinal=0;



function NewForm:Idispatch;
procedure DecFormCount;
implementation

{$R *.dfm}

function NewForm:Idispatch;
begin
 with TForm1.Create(nil)do
  begin
  caption:=FormCaption;
  visible:=true;
  result:=WebBrowser1.DefaultDispatch;
  inc(form_count);
  end;
end;

procedure DecFormCount;
begin
dec(form_count);
if form_count=0 then application.Terminate;
end;



procedure TFormXXX.FormCreate(Sender: TObject);
begin
NewForm;
end;

end.


В dpr -  первая создаваемая форма FormXXX
Код

program Project1;

uses
  Forms,
  windows,
  StartForm_Unit in 'StartForm_Unit.pas' {FormXXX},
  Unit1 in 'Unit1.pas' {Form1},
  ...
  ...



{$R *.res}

begin
  Application.ShowMainForm:=false;
  Application.Initialize;
  Application.CreateForm(TFormXXX, FormXXX); //!!! эта строка первая из Application.CreateForm
//Application.CreateForm(TForm1, Form1); // !!! эту строку удаляешь или комментируешь ОБЯЗАТЕЛЬНО!!!  
  ShowWindow(Application.Handle, SW_HIDE);
  Application.Run;
end.


В uses Unit1 прописываешь  StartForm_Unit 

Автор: s2004 20.10.2012, 22:25
попробую завтра спасибо.

Автор: s2004 21.10.2012, 16:17
так сделал, заработало кроме одного - досадная ошибка в начале запуска. при закрытия окна грузится браузер нормально и все вкладки отражены на значке панели задач.
http://www.radikal.ru

Код


Application.ShowMainForm:=1=0; прописано
Application.ShowMainForm:=false; не получается вроде до implementation проверял наверно сбой ещё по другой причине

Автор: Чучмек 21.10.2012, 17:29
У тебя встречается код
Код

Form1.EmbeddedWb1.DownloadOptions:=Form1.EmbeddedWb1.DownloadOptions
- [DLCTL_DLIMAGES, DLCTL_BGSOUNDS, DLCTL_VIDEOS,DLCTL_NO_SCRIPTS]
+ [DLCTL_PRAGMA_NO_CACHE, DLCTL_NO_JAVA];
EmbeddedWB1.Refresh;

За комментируй в unit1 строку 
Код

var Form1:TForm;

И исправь все
Код

procedure TForm1.bu...
begin
 form1.Em...

На
Код

procedure TForm1.bu...
begin
 self.Em...


Добавлено через 2 минуты и 15 секунд
После того как ты убрал строку Application.CreateForm(TForm1, Form1)
Form1 у тебя больше не существует

Автор: s2004 21.10.2012, 21:45
покрутил в выходные несколько часов. чтение без запроса с диска не идёт. после того, как например ещё убираю form1 на self среда дельфи начинает упорно подставить unit1 в unit1, что ошибка отказываясь от этого там другое лезет.
я вот помню вроде на каком то этапе у меня давно работало отражение открытых cskjr в значках на панели задач. Возможно какое другое решение тут действительно начинаешь одно менять появляется куча другого.

Автор: Чучмек 21.10.2012, 22:09
Вот когда начинаешь понимать, что глобальные переменные это зло.
Вот что у тебя есть
Цитата

 var
 MyClpFormat: integer;

 iconindex : integer;

 PIInfo : PInternetProxyInfo;
 Links : TStringlist;
 ActiveDesigner: TEditDesigner;
 EditServices: IHTMLEditServices;
 FDocHostUIHandler: TDocHostUIHandler;
 CtxMenuAdded: Boolean;
 i:string;

 
Использовалось раньше одной формой - а теперь несколькими.
Перенеси внутрь TForm1

Автор: s2004 21.10.2012, 22:20
попробую наверно уже завтра

Автор: s2004 21.10.2012, 22:38
так вроде всё подправил, пока ошибок не пишет ....

нет есть. такая при открытие файла с диска пишет примерно тоже самое - ошибка по такому адресу и прочая, но повторю возникает при открытие файла с диска, если просто ввести адрес или из истории с вкладок, то нормально, как только с диска - сбой. потом открывается браузер, но файл неподгружает.

нет возможности регулировать показывать картинку или нет

менял на self 
Код


procedure TForm1.BitBtn2Click(Sender: TObject);
begin
if RadioButton1.checked then RadioButton2.checked := false
else RadioButton1.checked := true;
if True then
self.EmbeddedWb1.DownloadOptions:=self.EmbeddedWb1.DownloadOptions
+ [DLCTL_DLIMAGES,DLCTL_NO_JAVA]
- [DLCTL_PRAGMA_NO_CACHE,DLCTL_BGSOUNDS, DLCTL_VIDEOS, DLCTL_NO_SCRIPTS];
EmbeddedWB1.Refresh;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
if RadioButton1.checked then RadioButton2.checked := false
else RadioButton1.checked := true;
if True then
self.EmbeddedWb1.DownloadOptions:=self.EmbeddedWb1.DownloadOptions
+ [DLCTL_DLIMAGES, DLCTL_BGSOUNDS, DLCTL_VIDEOS]
- [DLCTL_PRAGMA_NO_CACHE, DLCTL_NO_JAVA, DLCTL_NO_SCRIPTS];
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
if RadioButton2.checked then RadioButton1.checked := false
else RadioButton2.Checked  := true;
if True then
self.EmbeddedWb1.DownloadOptions:=self.EmbeddedWb1.DownloadOptions
- [DLCTL_DLIMAGES, DLCTL_BGSOUNDS, DLCTL_VIDEOS,DLCTL_NO_SCRIPTS]
+ [DLCTL_PRAGMA_NO_CACHE, DLCTL_NO_JAVA];

end;

Автор: Чучмек 22.10.2012, 09:20
У тебя еще куча юнитов, проверяй где еще есть обращение к form1 

Автор: s2004 22.10.2012, 19:36
ещё 4 form1 нашёл теперь нет. но теперь программа при запуске ведёт так, как в начале темы - при открытие сылки из родительского окна и если это окно закрыть происходит и закрытие родительского и дочернего окна. вышлю unit1.pas. вопрос прописаны ini- файлы для сохранения параметров проги например включена возможность показа картинок? при закрытие проги и вновь открытии вновь приходится нажимать на соответсвующую кнопку чтобы отображались картинки прога несохраняет поему изменения. ну и нет докучи чтения с диска.

так нашёл почему прога стала закрываться при закрытие родительского окна
в form1 в onclose поставил
Код

Application.Terminate;


убрал выше названная ошибка прошла

вопрос как заставить программу удалять себя из памяти?

кстати по глобальным переменым в учебниках например расписывают, что это хорошо не надо прописовать к каждой процедуре, а тут действительно прав Чучмек - за них сбои. лучше прописать к каждой процедуре.

Автор: Чучмек 22.10.2012, 21:31
В TForm1.FormClose
Должно стоять (последней строкой) DecFormCount.
Посмотри внимательно: при вызове NewForm увеличивается на единицу form_count.
При вызове DecFormCount уменьшается. Если DecFormCount=0 ->application.Terminate

Автор: s2004 22.10.2012, 21:39
да сработало прога из памяти выгружается.
а вот чтение с диска почему не работает, ну и вопрос по несохранению параметров.

Автор: s2004 26.10.2012, 22:57
перебрал параметры ини файлов, но код не работает.
запись в ини файл идёт, а вот такое впечатление, что не читается.

Код


procedure TForm30.FormCreate(Sender: TObject);
var
  Ini:TIniFile;
begin
  with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'net.ini') do
  begin
    {Здесь мы считываем высоту (Top) и отступ от
     левого края экрана (Left) нашей формы}
    form30.Top := ReadInteger('FormPosition', 'Top', form30.Top);
    form30.Left := ReadInteger('FormPosition', 'Left', form30.Left);
    {Соответственно загружаем
     длину (Height) и ширину (Width)}
    form30.Height := ReadInteger('FormSize', 'Height', form30.Height);
    form30.Width := ReadInteger('FormSize', 'Width', form30.Width);
    {Уничтожаем экземпляр}
//    Free;
//  end;
//var
// Ini:TIniFile;
//begin
NewForm;
// Ini:=TiniFile.Create(extractfilepath(paramstr(0))+'net.ini');
//  self.Width:=Ini.ReadInteger('Size','Width',100);
  //последнее значение (100) это значение по умолчанию (default)
//  self.Height:=Ini.ReadInteger('Size','Height',100);
//  self.Left:=Ini.ReadInteger('Position','X',10);
//  self.Top:=Ini.ReadInteger('Position','Y',10);
/////////Ini := TIniFile.Create('netwin.ini');
//Ini:=TiniFile.Create(extractfilepath(paramstr(0))+'net.ini');
//  self.Width:=Ini.ReadInteger('Size','Width',1024);
//  self.Height:=Ini.ReadInteger('Size','Height',768);
//  self.Left:=Ini.ReadInteger('Position','X',0);
//  self.Top:=Ini.ReadInteger('Position','Y',0);
//  RadioButton1.Checked:=Ini.ReadBool('self','RadioButton1Checked',RadioButton1.Checked); // состояние CheckBox1
//  RadioButton2.Checked:=Ini.ReadBool('self','RadioButton2Checked',RadioButton2.Checked);
  s := Ini.ReadString('files', 'path', ''); // <--- Здесь задай дефолтное значение
//  tform1.Image1.Picture.LoadFromFile(s);
  Ini.Free;
  end;
end;
procedure TForm30.FormDestroy(Sender: TObject);
//begin
var
Ini: Tinifile;
//////////begin
/////Ini := TIniFile.Create('netwin.ini');
//  Ini:=TiniFile.Create(extractfilepath(paramstr(0))+'net.ini');
 //////// Ini.WriteInteger('Size','Width',self.width);
/////  Ini.WriteInteger('Size','Height',self.height);
 //// Ini.WriteInteger('Position','X',self.left);
 /////// Ini.WriteInteger('Position','Y',self.top);
//  Ini.WriteBool('FORM1','CheckBox1Checked',n1.Checked);

//  Ini.WriteBool('FORM1','video1Checked',n2.Checked);
 // checkbox1.checked := ini.readbool('first section','edit key',false);
//////////  Ini.WriteString('files','path', s); // <--- Сохраняешь измененный путь
 /////////// Ini.Free;
//  Links.Free;
 // HistoryMenu.Free;
//  end;
///end;
//var
//  Ini: Tinifile; //необходимо создать объект, чтоб потом с ним работать
//begin
begin
  with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'net.ini') do
  begin
    {Здесь мы сохраняем высоту (Top) и отступ от
     левого края экрана (Left) нашей формы}
    WriteInteger('FormPosition', 'Top', form30.Top);
    WriteInteger('FormPosition', 'Left', form30.Left);
    {Следующие два метода хранят размеры формы,
     соответственно длину (Height) и ширину (Width)}
    WriteInteger('FormSize', 'Height', form30.Height);
    WriteInteger('FormSize', 'Width', form30.Width);
    {Ну и, конечно же, уничтожаем наш экземпляр}
//    Free;





  //создали файл в директории программы
//  Ini:=TiniFile.Create(extractfilepath(paramstr(0))+'net.ini');
//  Ini.WriteInteger('Size','Width',self.width);
//  Ini.WriteInteger('Size','Height',self.height);
//  Ini.WriteInteger('Position','X',self.left);
//  Ini.WriteInteger('Position','Y',self.top);
  Ini.WriteString('files','path', s);
  Ini.Free;
end;
end;

Автор: Чучмек 26.10.2012, 23:05
breakpoint в TForm30.FormCreate поставь. И через F7/F8 посмотри читается или нет.

Добавлено через 1 минуту и 56 секунд
Form30 - это что за зверь?

Автор: Чучмек 27.10.2012, 14:28
Код

unit StartForm_Unit;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,unit1;
type
  TFormXXX = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FormXXX: TFormXXX;
  form_count:cardinal=0;
//Здесь переменные для хранения настроек!!!
function NewForm:Idispatch;
procedure DecFormCount;
implementation
{$R *.dfm}
function NewForm:Idispatch;
begin
 with TForm1.Create(nil)do
  begin
  caption:=FormCaption;
  visible:=true;
  result:=WebBrowser1.DefaultDispatch;
  inc(form_count);
  //Здесь применяешь настройки к каждой вновь создаваемой форме 
  end;
end;
procedure DecFormCount;
begin
dec(form_count);
if form_count=0 then 
 begin
 //Здесь сохраняешь настройки при завершении приложения
 application.Terminate;
 end;
end;
procedure TFormXXX.FormCreate(Sender: TObject);
begin
//Здесь загружаешь настройки в переменные при запуске приложения 
NewForm;
end;
end.

Автор: s2004 27.10.2012, 23:05
Код

function NewForm:Idispatch;
var
  Ini:TIniFile;
begin
 with TForm1.Create(nil)do
  begin
  caption:=app_Caption;
  visible:=true;
  result:=embeddedwb1.DefaultDispatch;
  inc(form_count);
  Ini:=TiniFile.Create(extractfilepath(paramstr(0))+'net.ini');
  form30.Width:=Ini.ReadInteger('Size','Width',1024);
  form30.Height:=Ini.ReadInteger('Size','Height',768);
  form30.Left:=Ini.ReadInteger('Position','X',0);
  form30.Top:=Ini.ReadInteger('Position','Y',0);

  end;
end;

procedure DecFormCount;
var
Ini: Tinifile;
s: string;

begin
dec(form_count);
if form_count=0 then application.Terminate;
 Ini:=TiniFile.Create(extractfilepath(paramstr(0))+'net.ini');
  Ini.WriteInteger('Size','Width',form30.width);
  Ini.WriteInteger('Size','Height',form30.height);
  Ini.WriteInteger('Position','X',form30.left);
  Ini.WriteInteger('Position','Y',form30.top);
//  Ini.WriteString('files','path', s);
  Ini.Free;
end;



а переменную s ставил в 
Код

s := Ini.ReadString('files', 'path', '');
NewForm;


но при запуске ошибку пишет и браузер не работает заремачил вначале надо добиться чтобы положение и размер сохранял и восстанавливал. по выше привидённому коду пишет инифайл
Код

[Size]
Width=1024
Height=768
[Position]
X=0
Y=0

и всё, его не меняет. размеры и положение не изменяет.

Автор: Чучмек 27.10.2012, 23:17
Что такое Form30???

Автор: s2004 28.10.2012, 16:50
form30 это StartForm_Unit

Автор: Чучмек 28.10.2012, 17:25
А зачем ты настройки невидимого окна сохраняешь???

Автор: s2004 28.10.2012, 19:17
так вот вначале сохранял form1, потом пробовал form30

Автор: Чучмек 28.10.2012, 19:36
Рановато ты за это взялся, по видимому :(

Автор: s2004 28.10.2012, 19:59
Цитата(Чучмек @ 28.10.2012,  19:36)
Рановато ты за это взялся, по видимому :(

нормально, это у меня хобби на 1-2 месяца в год для себя. и разумеется, если незаниматься языком то забываешь и по новой приходится вспоминать, но хочется себе любимому smile.

архив распаковал, посмотрел не работает. у меня ini работали пока я не начал менять по теме, вероятно где то какая- та ошибка. файл config.ini несоздаётся.

Автор: Чучмек 28.10.2012, 20:14
Цитата(s2004 @  28.10.2012,  19:59 Найти цитируемый пост)
архив распаковал, посмотрел не работает

В меню есть пункт "Запомнить позицию"

Автор: s2004 28.10.2012, 20:26
да моя не внимательность :( - работает.

Автор: s2004 30.10.2012, 20:14
Чучмек (благодарю за расширенные ответы с примерами) вопрос по чтению файла с диска без подтверждения - до модернизации код был в form1

Код


function get(FName:string): boolean;
var
form1: tform1;
//
begin
 form1.EmbeddedWB1.Navigate(FName);
end;
oncreate...
if ParamCount <> 0 then get(ParamStr(1));




теперь, как бы надо использовать form30. подстовлял различные параметры, но не работает
Код

form30
function get(fname:string): boolean;
var
self: tform1;
begin
 self.EmbeddedWB1.Navigate(FName);  
end;
end;

form30
oncreate
if ParamCount <> 0 then get(ParamStr(1));



программа запускается, но при попытки открыть файл с диска пишет ошибку и загрузка файла непроисходит

Автор: Чучмек 31.10.2012, 12:49
Посмотри соседнюю тему про несколько окон одного класса.
Если в функции/процедуре было обрашение   к форме/компонентам на форме
Возможны варианты 
а) сделать функцию методом класса TFormN (доступ к форме через self)
б) добавить параметр Form:TForm и передавать self 
Добавь в функцию NewForm параметр SelfForm:TForm (как в моем последнем примере)
И делай проверку SelfForm=nil (при первом вызове в  NewForm передавай nil, при открытии нового окна передавай текущее(self)) 
Код

function NewForm(SelfForm:TForm)...
begin
...
with TForm1.Create(Application)do
 begin
 ...
 ...
 if not Assigned(SelfForm) and (ParamCount > 0) then get(ParamStr(1));
 ...
 end;
...
end;

Функцию get сделай методом TForm1
Код

function TForm1.get(fname:string): boolean;
begin
EmbeddedWB1.Navigate(FName);  
end;

Автор: s2004 6.11.2012, 19:41
Чучмек при попытки в form30 исправить функции newform и tform.get вылетают ошибки, при исправление в form1 ошибки нет. но и не работает. ты уже объяснял нельзя ли подробней всё таки по поводу form30?

Автор: Чучмек 6.11.2012, 21:26
Исправляешь описание TForm1
Было
Код

  TForm1 = class(TForm)
  ...
  private
    { Private declarations }
  public
    { Public declarations }
  ...
  end;

Стало
Код

  TForm1 = class(TForm)
  ...
  private
    { Private declarations }
  public
    { Public declarations }
   function  get(fname:string): boolean;
   ...
  end;

Потом ставишь курсор внутрь блока  TForm1 =... end; и нажимаешь Ctrl+Shift+C получаешь заготовку метода Get

Автор: s2004 6.11.2012, 21:52
у меня было
Код

function get(FName:string): boolean;
var
self: tform1;
begin
 self.EmbeddedWB1.Navigate(FName);  
end;


... нажимаешь Ctrl+Shift+C получаешь заготовку метода Get - это не срабатывает.

Автор: Чучмек 7.11.2012, 09:55
Ну добавь ручками TForm1.
Код

function TForm1.get(FName:string): boolean;
//var
//self: tform1;
begin
 self.EmbeddedWB1.Navigate(FName);  
end;
 
Предварительно добавь в секцию public TForm1 строку
Код

function get(FName:string): boolean;

зы get должен быть в том же юните что и tform1

Автор: s2004 7.11.2012, 20:00
Код

procedure TForm1.EmbeddedWB1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
 var Cancel: WordBool);
  begin
  ppDisp:=NewForm;  - исправил теперь, ругается- нет других параметров.

Код

procedure TForm30.FormCreate(Sender: TObject);
begin
NewForm;  тут тоже ругается если заремачить вверху и внизу то запускается, но без отображения формы. 
end;
end.

этот код для form1?
Код


function NewForm(SelfForm:TForm)...
begin
...
with TForm1.Create(Application)do
 begin
 ...
 ...
 if not Assigned(SelfForm) and (ParamCount > 0) then get(ParamStr(1));
 ...
 end;
...
end;

Автор: Чучмек 7.11.2012, 22:17
Ну посмотри последний пример. Там в NewForm уже добавлен параметр.
В EmbeddedWB1NewWindow2
Код

ppDisp:=NewForm(self);

В TForm30.FormCreate
Код

NewForm(nil);


Цитата(s2004 @  7.11.2012,  20:00 Найти цитируемый пост)
if not Assigned(SelfForm) and (ParamCount > 0) then get(ParamStr(1));

Если SelfForm=nil (если не Assigned(SelfForm)) вызвать метод get

параметр SelfForm (в NewForm ) - это форма, в  WB которой, открывается новое окно. При старте программы еще никакого окна НЕТ, поэтому передаем nil
Значит если SelfForm=nil программа только запустилась. 

Автор: s2004 8.11.2012, 19:39
Код

ppDisp:=NewForm(self); пишет разные типы dispath и boolean



когда подставил nil

Код

NewForm(nil); too many actual parametrs

Автор: Чучмек 8.11.2012, 20:55
Вот посмотри.
... и еще. Чтобы при закрытии форма уничтожалась а не скрывалась,необходимо в OnClose перед вызовом DecFormCount вызвать Free
Код

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
...
Free;//!!!Предпоследняя!!! строка
DecFormCount;//!!!Последняя!!! строка
end;

Автор: s2004 8.11.2012, 21:58
Код

CaFree; 
self := nil;
DecFormCount;


у меня вот так было

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

Автор: Чучмек 8.11.2012, 22:20
Можно и так.
тогда DecFormCount лучше вызывать в OnDestroy

Автор: s2004 9.11.2012, 18:51
user posted image
user posted image

ошибка при закрытии

не стал кнопкой фиксировать нужную позицию, через

Код

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin
MIntSettings[sTop].Curr:=Top;
MIntSettings[sLeft].Curr:=Left;
MIntSettings[sWidth].Curr:=Width;
MIntSettings[sHeight].Curr:=Height;


end;

Автор: Чучмек 9.11.2012, 20:10
Форма должна уничтожатся до вызова Application.Terminate

Автор: s2004 10.11.2012, 18:07
Код

procedure DecFormCount;
var ind:TIntSettings;
begin
dec(form_count);
if form_count=0 then
 begin
 for ind:=low(MIntSettings) to  high(MIntSettings) do
  if MIntSettings[ind].Curr<>MIntSettings[ind].Load then IniF.WriteInteger('BrowserWindow',IntSettingsName[ind],MIntSettings[ind].Curr);
 IniF.Free;
 application.Terminate;
 end;
end;


если в form1 ставлю
Код

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin

free;
DecFormCount;
Application.Terminate;
end;



то ошибка сохраняется плюс закрывается все окна при закрытие любого окна браузера,
а так  Application.Terminate вызывается только в form30. как у тебя в примере.
а так уменя в form1 стоит 
Код

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin

free;
DecFormCount;

end;


Добавлено через 11 минут и 32 секунды
а вот получилось при таком коде
Код

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin

CaFree; 
self := nil;

DecFormCount;

end;

Автор: Чучмек 10.11.2012, 18:21
Ошибка всегда, или только когда открываешь файл с диска?

Добавлено через 13 минут и 24 секунды
Перенеси вызов DecFormCount в OnDestroy. Так правильнее более правильно будет.

Автор: s2004 10.11.2012, 20:12
так я же написал, что исправил в предыдущем посте. ошибки теперь нет. благодарю за ответы и помощь.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)