I am using TWebBrowser as HTML editor in Delphi7, by setting it's designMode to 'on' in OnDocumentComplete.
I know how to change font properties like bold, italic, font, color, justify, etc. I am using exeCommand with parameters
var
htmlDoc: HTMLDocument;
parameter: OleVariant;
begin
(wbEditor.Document as IHTMLDocument2).ParentWindow.Focus;
htmlDoc := wbEditor.document as HTMLDocument;
htmlDoc.execCommand('bold', false, parameter);
(wbEditor.Document as IHTMLDocument2).ParentWindow.Focus;
end;
Question is how to read 'Bold' and other properties when I change cursor position inside the text.
Let's asume my text is like 'foo bar'. I want to have a 'Bold button' checked when I position my cursor at FOO, but unchecked when I position it at BAR.
???
Hej I found a walkaround on my own, used TEmbeddedWB instead TWebBrowser, and code below on it's OnClock and OnKeyDown events
var
doc: IHTMLDocument2;
sel: IHTMLSelectionObject;
range: IHTMLTxtRange;
begin
doc := wb1.Doc2;
if Assigned(Doc) then
begin
Sel := Doc.selection;
if Assigned(Sel) then
begin
if (Sel.type_ = 'None') or (Sel.type_ = 'Text') then
begin
Range := Sel.createRange as IHTMLTxtRange;
Caption := Range.queryCommandValue('justifyCenter');
end;
end;
end;
end;
thanks myself !!
Related
I want to detect on which HTML tag (more exactly hyperlink) is the caret.
procedure THTMLEdit.ShowTag;
var
CursorPos: TPoint;
HtmlElement: IHTMLElement;
iHTMLDoc: IHtmlDocument2;
begin
if Supports(wbBrowser.Document, IHtmlDocument2, iHTMLDoc) then
begin
if GetcaretPos(CursorPos) then
begin
CursorPos := wbBrowser.screentoclient(CursorPos);
HtmlElement := iHTMLDoc.ElementFromPoint(CursorPos.X, CursorPos.Y); // I NEED KEYBOARD CARET HERE, NOT MOUSE CURSOR
if HtmlElement <> NIL
then label1.Caption:= HtmlElement.tagName;
end;
end;
end;
Notes:
TWebBrowser is in DesignMode ( DesignMode := 'On' ).
TWebBrowser is in its own form at design time but at runtime is re-parented in another form (in a panel).
UPDATE:
The thing that I need is IHTMLTxtRange (I think). It works when I double click a link/word. But I don't know how to get the tag under caret when no text/link is selected.
GetcaretPos(CursorPos) returns client (relative) coordinates (See GetCaretPos function)
Remove wbBrowser.screentoclient(CursorPos) and it should work fine. I have tested with your code sample above
I am using TWebBrowser as editor GUI for users. I want to be able to insert web controls into the document. A simple example would be a check box. (I can elaborate why if needed). I have all this working when I first assemble the HTML document (with its STYLE and SCRIPTS sections) and then pass it en-block to the TWebBrowser. But now I want to be able to insert my elements into an existing document.
I have this code, below, but it is causing and OLE error (see in comments in code):
procedure THTMLTemplateDocument.EnsureStylesInWebDOM;
var StyleBlock : IHTMLElement;
StyleText: string;
begin
StyleBlock := FWebBrowser.GetDocStyle;
if not assigned(StyleBlock) then
raise Exception.Create('Unable to access <STYLE> block in web document');
StyleText := FCumulativeStyleCodes.Text;
StyleBlock.InnerText := StyleText; <--- generates "OLE ERROR 800A0258"
end;
The called functions from the above code are as follows:
function THtmlObj.GetDocStyle: IHTMLElement;
//Return pointer to <STYLE> block, creating this if it was not already present.
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Elements: IHTMLElementCollection; // all tags in document body
AElement: IHTMLElement; // a tag in document body
Style, Head: IHTMLElement;
I: Integer; // loops thru Elements in document body
begin
Result := nil;
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document');
Elements := Document.all;
for I := 0 to Pred(Elements.length) do begin
AElement := Elements.item(I, EmptyParam) as IHTMLElement;
if UpperCase(AElement.tagName) <> 'STYLE' then continue;
result := AElement;
break;
end;
if not assigned(Result) then begin
Head := GetDocHead;
if assigned(Head) then begin
Style := Document.CreateElement('STYLE');
(Head as IHTMLDOMNode).AppendChild(Style as IHTMLDOMNode);
Result := Style;
end;
end;
end;
and
function THtmlObj.GetDocHead: IHTMLElement;
//Return pointer to <HEAD> block, creating this if it was not already present.
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Elements: IHTMLElementCollection; // all tags in document body
AElement: IHTMLElement; // a tag in document body
Body: IHTMLElement2; // document body element
Head: IHTMLElement;
I: Integer; // loops thru Elements in document body
begin
Result := nil;
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document');
if not Supports(Document.body, IHTMLElement2, Body) then
raise Exception.Create('Can''t find <body> element');
Elements := Document.all;
for I := 0 to Pred(Elements.length) do begin
AElement := Elements.item(I, EmptyParam) as IHTMLElement;
if UpperCase(AElement.tagName) <> 'HEAD' then continue;
Result := AElement;
break;
end;
if not assigned(Result) then begin
Head := Document.CreateElement('HEAD');
(Body as IHTMLDOMNode).insertBefore(Head as IHTMLDOMNode, Body as IHTMLDOMNode);
//now look for it again
Elements := Document.all;
for I := 0 to Pred(Elements.length) do begin
AElement := Elements.item(I, EmptyParam) as IHTMLElement;
if UpperCase(AElement.tagName) <> 'HEAD' then continue;
Result := AElement;
break;
end;
end;
end;
When I run this, StyleText =
'.selected {'#$D#$A' font-weight : bold;'#$D#$A' //background-color : yellow;'#$D#$A'}'#$D#$A'.unselected {'#$D#$A' font-weight : normal;'#$D#$A' //background-color : white;'#$D#$A'}'#$D#$A#$D#$A
But I tried making StyleText to be something simple like 'hello', and it still crashed.
A Google search for "OLE ERROR 800A0258" reveals several other people who have had similar problems, such as here and here -- this later user seems to indicate he fixed the problem by using .OuterHTML, but I tried this with similar error generated. This thread seems to indicate the .InnerText is read only. But in the interface declaration (see below), it seems to have a method for setting (i.e. not read-only).
// *********************************************************************//
// Interface: IHTMLElement
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}
// *********************************************************************//
IHTMLElement = interface(IDispatch)
['{3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}']
...
procedure Set_innerHTML(const p: WideString); safecall;
function Get_innerHTML: WideString; safecall;
procedure Set_innerText(const p: WideString); safecall;
function Get_innerText: WideString; safecall;
procedure Set_outerHTML(const p: WideString); safecall;
function Get_outerHTML: WideString; safecall;
procedure Set_outerText(const p: WideString); safecall;
function Get_outerText: WideString; safecall;
...
property innerHTML: WideString read Get_innerHTML write Set_innerHTML;
property innerText: WideString read Get_innerText write Set_innerText;
property outerHTML: WideString read Get_outerHTML write Set_outerHTML;
property outerText: WideString read Get_outerText write Set_outerText;
...
end;
Can anyone help be figure out how to set up STYLES in the <STYLE> section of an existing HTML document in a TWebBrowser?
If you have valid IHTMLDocument2, then you can call its createStyleSheet(). It will return IHTMLStyleSheet instance. You can use its cssText property to set style.
Make sure you take account of document's character encoding.
Based on guidance from #Zamrony P. Juhara, I came up with the following code. I am posting in case it can help anyone else in the future.
procedure THtmlObj.AddStylesToExistingStyleSheet(StyleSheet: IHTMLStyleSheet; SelectorSL, CSSLineSL : TStringList);
//NOTE: There must be a 1:1 correlation between SelectorSL and CSSLineSL
// The first SL will contain the selector text
// the second SL will contain all the CSS in one line (divided by ";"'s)
var
SLIdx, RuleIdx, p: integer;
SelectorText, CSSText, OneCSSEntry : string;
begin
if not assigned(StyleSheet) then begin
raise Exception.Create('Invalid StyleSheet');
end;
for SLIdx := 0 to SelectorSL.Count - 1 do begin
SelectorText := SelectorSL.Strings[SLIdx];
if SlIdx > (CSSLineSL.Count - 1) then break;
CSSText := CSSLineSL.Strings[SLIdx];
while CSSText <> '' do begin
p := Pos(';', CSSText);
if p > 0 then begin
OneCSSEntry := MidStr(CSSText, 1, p);
CSSText := MidStr(CSSText, p+1, Length(CSSText));
end else begin
OneCSSEntry := CSSText;
CSSText := '';
end;
RuleIdx := StyleSheet.Rules.length;
StyleSheet.addRule(SelectorText, OneCSSEntry, RuleIdx);
end;
end;
end;
function THtmlObj.AddStyles(SelectorSL, CSSLineSL : TStringList) : IHTMLStyleSheet;
//NOTE: There must be a 1:1 correlation between SelectorSL and CSSLineSL
// The first SL will contain the selector text
// the second SL will contain all the CSS in one line (divided by ";"'s)
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
StyleSheets: IHTMLStyleSheetsCollection; // document's style sheets
StyleSheet: IHTMLStyleSheet; // reference to a style sheet
OVStyleSheet: OleVariant; // variant ref to style sheet
Idx: integer;
begin
Result := nil;
if not Supports(Doc, IHTMLDocument2, Document) then begin
raise Exception.Create('Invalid HTML document');
end;
StyleSheets := Document.styleSheets;
Idx := Document.StyleSheets.length;
OVStyleSheet := Document.createStyleSheet('',Idx);
if not VarSupports(OVStyleSheet, IHTMLStyleSheet, StyleSheet) then begin
raise Exception.Create('Unable to create valid style sheet');
end;
Result := StyleSheet;
AddStylesToExistingStyleSheet(StyleSheet, SelectorSL, CSSLineSL);
end; //AddStyles
I have a Delphi XE2 application with a TEmbeddedWB that I use to simulate user actions. The application navigates to a URL, populates the relevant form fields with data and submits the data. The problem is that there is an <input type=file /> field which accepts files that are uploaded.
Having done a lot of reading on the matter I understand there is a security issue doing this programmatically but also found someone making a suggestion that the files could be ‘dragged’ from the clipboard and ‘dropped’ in place. I have since been successful in loading the relevant files (jpeg images) into the clipboard (thanks to CCR.Clipboard) and drop them onto my EmbeddedWB. However, as you are most likely aware, dropping an image on a TWebBrowser resorts to the image being displayed.
My issue is that the web page I’m accessing has a specific DIV element that accepts files to be dropped. Although I have successfully obtained the coordinates of that DIV as an IHTMLElement and even moved the mouse cursor into position (for visual confirmation), dropping an image there still opens it for display instead of uploading it. It’s as though the drop area doesn’t detect the drop, only the web browser does.
Any guidance on this matter will be greatly appreciated. Following is the relevant code.
Methods:
type
TElementsArray = array of IHTMLElement;
...
function TSiteRobot.FindElementByTagAttributeValue(const Document: IHTMLDocument2; TagName, Attribute, AttributeValue: String; out Info: String): IHTMLElement;
var i: integer;
HTMLElem: IHTMLElement;
ElementCount: integer;
OleElem: OleVariant;
ElementsArray: TElementsArray;
begin
Result := nil; //initialise
ElementsArray := GetElementsByTagName(Document, TagName);
if Length(ElementsArray) = 0 then
begin
Info := 'No elements with "'+TagName+'" tag found.';
Exit
end;
Info := 'No element found for tag "'+TagName+'" and attribute "'+Attribute+'" with Value "'+AttributeValue+'"';
for i := Low(ElementsArray) to High(ElementsArray) do
begin
HTMLElem := ElementsArray[i];
try
OleElem := HTMLElem.getAttribute(Attribute,0);
if (not varIsClear(OleElem)) and (OleElem <> null) then
begin
if (String(OleElem) = AttributeValue) then
begin
if HTMLElem <> nil then Result := HTMLElem;
Break;
end;
end;
except raise; end;
end;
end;
function TSiteRobot.GetElementScreenPos(WebBrowser: TEmbeddedWB; HTMLElement: IHTMLElement): TPoint;
var WinRect: TRect;
elTop, elLeft: integer;
HTMLElem2: IHTMLElement2;
begin
HTMLElement.scrollIntoView(True);
Application.ProcessMessages; //let the coordinates get updated since the page moved
GetWindowRect(WebBrowser.Handle, WinRect);
HTMLElem2 := (HTMLElement as IHTMLElement2);
elLeft := HTMLElem2.getBoundingClientRect.left + WinRect.Left;
elTop := HTMLElem2.getBoundingClientRect.top + WinRect.Top;
Result := Point(elLeft, elTop);
end;
procedure TfrmMain.DropFilesAtPoint(Area: TPoint; Wnd: HWND);
var DropTarget: IDropTarget;
DataObj: IDataObject;
DropFiles: PDropFiles;
StgMed: TSTGMEDIUM;
FormatEtc: TFORMATETC;
EnumFormatEtc: IEnumFORMATETC;
dwEffect: integer;
begin
DropTarget := IDropTarget(GetProp(Wnd, 'OleDropTargetInterface'));
OleGetClipboard(dataObj);
DataObj.EnumFormatEtc(DATADIR_GET, EnumFormatEtc);
while (EnumFormatEtc.Next(1, FormatEtc, nil) <> S_FALSE) do
begin
if (FormatEtc.cfFormat = CF_HDROP) and (DataObj.QueryGetData(FormatEtc) = S_OK) then
begin
DataObj.GetData(FormatEtc, StgMed);
DropFiles := GlobalLock(StgMed.hGlobal);
dwEffect := DROPEFFECT_COPY;
DropTarget.Drop(DataObj, Integer(DropFiles), Area, dwEffect); // This is where the image opens in the web browser
GlobalFree(StgMed.hGlobal);
ReleaseStgMedium(StgMed);
end;
end; //while
DataObj._Release;
end;
Calling Code:
var HTMLElem: IHTMLElement;
dndArea: TPoint;
…
HTMLElem := SiteRobot.FindElementByTagAttributeValue(Document, 'SPAN', 'id', 'dndArea', Info);
dndArea := SiteRobot.GetElementScreenPos(WebBrowser, HTMLElem);
dndArea.X := dndArea.X+24; //go ‘deeper’ into the drop area
dndArea.Y := dndArea.Y+24;
SetCursorPos(dndArea.X, dndArea.Y); //cursor moves onto the correct spot in the website every time
(HTMLElem as IHTMLElement2).focus;
DropFilesAtPoint(dndArea, webBrowser.Handle);
I have come to a solution regarding this problem. Rather than using the clipboard, I piggy-backed on Melander’s drag-and-drop PIDLDemo. Adding a TListView component to the form and giving it the ability to drag-and-drop files to the shell does the trick. Using Windows' MOUSE_EVENT I am able to (programmatically) drag the files from the TListView and drop them onto the TEmbeddedWB at the correct location. Presto! The files are accepted and uploaded to the website.
The calling code now looks as follows:
function TfrmMain.GetMickey(val: TPoint): TPoint;
begin
{
http://delphi.xcjc.net/viewthread.php?tid=43193
Mouse Coordinates given are in "Mickeys", where their are 65535 "Mickeys"
to a screen's width.
}
Result.X := Round(val.X * (65535 / Screen.Width));
Result.Y := Round(val.Y * (65535 / Screen.Height));
end;
procedure TfrmMain.DropFilesAtPoint(const Area: TPoint; Wnd: HWND);
var Rect: TRect;
DropPoint,
ListViewPoint,
ListViewItemPoint: TPoint;
begin
GetWindowRect(ListView1.Handle, Rect);
ListViewItemPoint := ListView1.Items.Item[0].GetPosition;
ListViewPoint := Point(Rect.Left + ListViewItemPoint.X+10,
Rect.Top + ListViewItemPoint.Y+10);
ListView1.SelectAll; //ensures all files are dragged together
SetCursorPos(ListViewPoint.X, ListViewPoint.Y);
ListViewPoint := GetMickey(ListViewPoint);
MOUSE_EVENT(MOUSEEVENTF_LEFTDOWN,
ListViewPoint.X, ListViewPoint.Y, 0, 0); //left mouse button down
Sleep(500);
DropPoint := ClientToScreen(Area);
DropPoint := GetMickey(DropPoint);
MOUSE_EVENT(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE or
MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP,
DropPoint.X, DropPoint.Y, 0, 0); //move and drop
Application.ProcessMessages;
end;
I want to know how to get TOTAL height of html document loaded into TWebBrowser component (Delphi)?
I have found something like this and it is not working:
webbrowser.oleobject.document.body.scrollheight
I placed it inside OnDocumentComplete event.
I need height because I am calculating PageSize property of ScrollBar (my custom scrollbar - build-in WebBrowser is disabled) which depends on web page height.
Thanks for any feedback, best regards
Something like this should work:
uses MSHTML;
var
HtmlElement: IHTMLElement2;
PageHeight: Integer;
begin
with MyWebBrowser.ControlInterface do
begin
HtmlElement := (Document as IHTMLDocument3).documentElement as IHTMLElement2;
end;
PageHeight := HtmlElement.scrollHeight;
end;
This is the full height. The body element seems to give a bit smaller value (probably thanks to margins):
var
BodyElement: IHTMLElement2;
PageHeight: Integer;
begin
with MyWebBrowser.ControlInterface do
begin
BodyElement := (Document as IHTMLDocument2).body as IHTMLElement2;
end;
PageHeight := BodyElement.scrollHeight;
end;
I'm using Delphi and WebBrowser componenet to navigate a html page . the page have a Combobox . is there any way to call the OnChange event ?
The ComboBox is like this :
<select name="comboname" onchange="Some Javascript codes">
Also , i have used this code :
function TFrmMain.SetComboboxValue(WB: TEmbeddedWB;
SelectName, ItemName: string): Boolean;
var
iForms, iFormItems, iSelectItems: Word;
FormItem: OleVariant;
begin
Result := false;
for iForms := 0 to WB.OleObject.Document.Forms.length - 1 do
begin
FormItem := WB.OleObject.Document.Forms.item(iForms);
for iFormItems := 0 to FormItem.length - 1 do
begin
if (FormItem.item(iFormItems). type = 'select-one') and SameText
(FormItem.item(iFormItems).Name, SelectName) then
begin
for iSelectItems := 0 to FormItem.item(iFormItems).Options.length - 1 do
begin
if SameText(FormItem.item(iFormItems).Options.item(iSelectItems)
.Text, ItemName) then
begin
FormItem.item(iFormItems).SelectedIndex := iSelectItems;
Result := true;
Break;
end;
end;
end;
end;
end;
end;
But it change the value only.
to execute the onchange event you can use the execScript method
check this sample
uses
MSHTML;
var
Doc: IHTMLDocument2;
HTMLWindow: IHTMLWindow2;
begin
Doc := WebBrowser1.Document as IHTMLDocument2;
if not Assigned(Doc) then
Exit;
HTMLWindow := Doc.parentWindow;
if not Assigned(HTMLWindow) then
Exit;
HTMLWindow.execScript('yourfunctioname()', 'JavaScript');
end;
for more info check this excellent article
How to call JavaScript functions in a TWebBrowser from Delphi
Inspired by the response. NET have been using the structures below:
FrameSet Document Elements Item Name Value Change ;
EWB.OleObject.Document.Frames.Item('mainFrame').Document.Forms.Item('invoiceForm').Elements.Item('inputname').Value:= '123456';
or
FrameSet Document Elements Items Lenth;
EWB.OleObject.Document.Forms.Item('invoiceForm').Elements.Length;