Форум: "KOL";
Текущий архив: 2013.11.17;
Скачать: [xml.tar.bz2];
ВнизTKOLWebBrowser и OnBeforeNavigate2 Найти похожие ветки
← →
Artlav (2008-04-07 16:37) [0]Вопрос такой - как использовать событие OnBeforeNavigate2 в TKOLWebBrowser?
Конкретно, мне надо в нём прочитать адрес, сгенерировать новый и перенаправить.
Как бы я ни пытался сделать, всегда вылетает либо ошибка
---------------------------
Debugger Exception Notification
---------------------------
Project gcv.exe raised exception class EVariantBadVarTypeError with message "Invalid variant type". Process stopped. Use Step or Run to continue.
---------------------------
OK Help
---------------------------
Либо какая-то предсказуемая системная бяка.
Использую Delphi 7.
Вот буквально вся программа:program gcv;
uses strval,activex,strutils,sysutils,variants,Windows,Messages,ShellAPI,KOL,KOLWebBr owser,KOLSHDocVw;
{$R gcv.res}
{$R site.res}
const GOOGLE_CACHE="http://www.google.fr/search?q=%20cache:";
var
HTML:TKOLWebBrowser;
panelbtn,btngo,btnbck,btnfwd,btnref,plflb,pfnceb:pcontrol;
{
function oleGetStr(var value: oleVariant): string;
var
index,
lowVal,
highVal : integer;
oleArray: PSafeArray;
oleObj : oleVariant;
begin
result := "";
try
case VarType(value) of
varEmpty,
varNull: result := "";
varSmallint,
varInteger,
varByte,
varError: result := IntToStr(value);
varSingle,
varDouble,
varCurrency: result := FloatToStr(value);
varDate: result := DateTimeToStr(value);
varOleStr,
varStrArg,
varString: result := value;
varBoolean:
if value then
result := "True"
else result := "False";
varDispatch, // do not remove IDispatch!
varVariant,
varUnknown,
varTypeMask:
begin
VarAsType(value, varOleStr);
result := value;
end;
else
if VarIsArray(value) then
begin
//VarArrayLock(value);
index := VarArrayDimCount(value);
lowVal := VarArrayLowBound(value, index);
highVal := VarArrayHighBound(value, index);
oleArray := TVariantArg(value).pArray;
for index := lowVal to highVal do
begin
SafeArrayGetElement(oleArray, index, oleObj);
result := result + oleGetStr(oleObj) + #13#10;
end;
//VarArrayUnlock(value);
Delete(result, length(result) - 1, 2);
end
else
result := ""; //varAny, varByRef
end;
except
// do nothing, just capture
end;
end;
}
function hexic(s:string):string;
var i:integer;
begin
result:="";
for i:=1 to length(s) do result:=result+"%"+strhex2(ord(s[i]));
end;
function doaction(s:string):string;
begin
result:=GOOGLE_CACHE+hexic(s);
end;
procedure bnav(Sender:pobj;const pDisp:IDispatch;var url,Flags,TargetFrameName,PostData,Headers:OleVariant;var Cancel:WordBool);
begin
//Ни один вариант не работает
applet.Caption:=url; //Тут вылетает
//applet.Caption:=pchar(dword(@url)+8)^;
//applet.Caption:=oleGetStr(url);
if (not ansicontainsstr(URL,"%20cache:"))and(not ansicontainsstr(URL,"/stpg"))then HTML.Navigate(doaction(URL));
end;
procedure btngoClick(Sender:PObj);begin try if pfnceb.Text<>"" then HTML.Navigate(doaction(pfnceb.Text)); except end;end;
procedure btnbckClick(Sender:PObj);begin try HTML.GoBack;HTML.GoBack; except end;end;
procedure btnfwdClick(Sender:PObj);begin try HTML.GoForward; except end;end;
procedure btnrefClick(Sender:PObj);begin try HTML.Refresh; except end;end;
procedure resize(Sender:PObj);begin pfnceb.SetSize(Applet.Width-240,18);end;
procedure setall;
begin
Applet:=NewForm(Nil,"Google cache viewer").SetSize(800,600);
Applet.CenterOnParent;
Applet.CanResize:=true;
applet.WindowState:=wsMaximized;
applet.OnResize:=TOnEvent(MakeMethod(nil,@resize));
applet.Border:=0;
HTML:=NewKOLWebBrowser(Applet);
HTML.SetAlign(caClient);
HTML.Offline:=false;
HTML.Silent:=true;
HTML.RegisterAsBrowser:=true;
HTML.RegisterAsDropTarget:=false;
HTML.OnBeforeNavigate2:=TWebBrowserBeforeNavigate2(MakeMethod(HTML,@bnav));
panelbtn:=NewPanel(Applet,esRaised).SetAlign(caTop).SetSize(0,24).SetPosition(1, 1);
btnbck:=NewButton(panelbtn,"<<<").SetPosition(1,1).SetSize(30,17);btnbck.Font.Fo ntHeight:=8;
btnfwd:=NewButton(panelbtn,">>>").SetPosition(31,1).SetSize(30,17);btnfwd.Font.F ontHeight:=8;
btnref:=NewButton(panelbtn,"Refresh").SetPosition(61,1).SetSize(60,17);btnref.Fo nt.FontHeight:=8;
btngo :=NewButton(panelbtn,"Go To").SetPosition(121,1).SetSize(50,17);btngo.Font.FontHeight:=8;
btngo .OnClick:=TOnEvent(MakeMethod(nil,@btngoClick));
btnbck.OnClick:=TOnEvent(MakeMethod(nil,@btnbckClick));
btnfwd.OnClick:=TOnEvent(MakeMethod(nil,@btnfwdClick));
btnref.OnClick:=TOnEvent(MakeMethod(nil,@btnrefClick));
plflb:=NewLabel(panelbtn,"Address: ").SetPosition(175,2).SetSize(40,18);plflb.Font.FontHeight:=8;
pfnceb:=NewEditbox(panelbtn,[]).SetPosition(220,0).SetSize(Applet.Width-240,18);pfnceb.Font.FontHeight:=8;
pfnceb.Color:=clgreen;pfnceb.font.Color:=RGB(0,255,0);
HTML.Navigate("res://"+paramstr(0)+"/HTML/stpg");
Run(Applet);
end;
begin
setall;
end.
← →
Дмитрий К © (2008-04-07 17:50) [1]http://kolmck.net/r_faq.htm#how_to_assign_a_regular
← →
Artlav (2008-04-07 19:48) [2]
> http://kolmck.net/r_faq.htm#how_to_assign_a_regular
Странно, поменял заголовок наprocedure bnav(Dummy_Self:PObj;Sender:pobj;const pDisp:IDispatch;var url,Flags,TargetFrameName,PostData,Headers:OleVariant;var Cancel:WordBool);
И всё работает...
Мне казалось, что Sender:pobj; и был тот первый скрытый параметер.
Спасибо.
← →
gregory (2009-07-25 23:10) [3]CrqR9k jnT3bz8Qpgj62BaK3ldfTm
Страницы: 1 вся ветка
Форум: "KOL";
Текущий архив: 2013.11.17;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.002 c