unit web;

{This unit encapsulates SHDocVw.dll and MSHTML.dll functionality by subclassing
TWebBrowser object as TWeb object

TWeb was designed for easy use of HTML display and editing capacity in
SuperMemo 2002 for Windows developed by SuperMemo R&D in Fall 2001.

SuperMemo 2002 implements HTML-based incremental reading in which extensive HTML
support is vital

Pieces of this units can be used by anyone in other Delphi applications that make
use of HTML WYSIWYG interfaces made open by Microsoft

Please send comments, questions, suggestions for improvements or bugs to:
bugs(AT)supermemo(.)com}

{IMPORTANT! you need to assign TWinControl(Web).Parent to make Web:TWeb visible}
{For example, putting TWeb on a panel:
   TheWeb:=TWeb.Create(Panel);
   TheWeb.TheParent:=Self; //Form parenting the panel
   TWinControl(TheWeb).Parent:=Panel;
   TWinControl(TheWeb).Align:=alClient;
   TheWeb.Tag:=1; //Set different Tag if more TWeb's placed in a form}

interface

uses SysUtils,WinTypes,
     ActiveX,MSHTMLEvents,SHDocVw,MSHTML,
     IeConst,Classes,Forms,Graphics;

const
  CGID_MSHTML:TGUID='{DE4BA900-59CA-11CF-9592-444553540000}';
  IID_IOleCommandTarget:TGUID='{B722BCCB-4E68-101B-A2BC-00AA00404770}';
  CGID_WebBrowser:TGUID='{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
  FontScale=3;

var IEStr,LastHyperlink:string;
    ApplicationOnMessage:TMessageEvent; {set to Forms.Application.OnMessage when creating the main form}
    OnMessageCompNo:byte;

type TWeb=class(TWebBrowser)
          public
             Modified,ReadOnly,Extrinsic,SuperMemoMenu,_Filter:boolean;
             TheDoc:IHTMLDocument2; //MSHTML HTML Document 2 interface
             TheWind:IHTMLWindow2;
             DocCmd,WebCmd:IOleCommandTarget; //MSHTML IOLECommandTarget interface
             Editable:boolean;
             TheSlot,TheTextPosit:integer;
             LastClickX,LastClickY:integer;
             TheParent:TForm;
             ElWind:byte; {pointer reference error protection; to occlude ElementWindow.ElWind in SuperMemo}
             LoadedHTMLFile:string;
             procedure Clear;
             procedure Save;
             procedure SaveAs(DefaultName:string);
             function SaveFile(Filename:string):boolean;
             procedure Print;
             procedure SetState(Edit:boolean);
             procedure LoadFile(FileName:string);
             procedure StatusTextChange(Sender: TObject; const Text: WideString);
             procedure CommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
             procedure BeforeNavigate2(Sender: TObject;const pDisp: IDispatch;
                 var URL: OleVariant;var Flags: OleVariant;var TargetFrameName:OleVariant;
                 var PostData: OleVariant;var Headers: OleVariant;var Cancel: WordBool);
             procedure NavigateComplete2(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
             constructor Create(Owner:TComponent); override;
             destructor Destroy; override;
             procedure SetFocus; override;
             function SourceText:string;
             procedure SetSelection(Start,Length:integer);
             function GetTextRange:IHtmlTxtRange;
             function SelStart:integer;
             function SelEnd:integer;
             function SelLength:integer;
             procedure SetBackgroundColor(Color:TColor);
             function GetBackgroundColor:TColor;
             procedure SetHTMLText(HTML:WideString);
             procedure WaitLoad(peek:boolean);
             function GetScrollTop:integer;
             procedure SetScrollTop(ScrollTop:integer);
             function GetHTMLSelection:WideString;
             procedure ClearSelection;
             procedure ReplaceSelection(HTML:string);
             procedure SetFont(AFont:TFont;SetFontMode:byte);
             function Text:string;
             procedure SetBorder(Border:boolean);
             procedure SetScrollBar(ScrollBar:boolean);
             procedure Undo;
             procedure GetFont(var AFont:TFont);
             procedure FontDialog;
             function  SpecialCommand(Cmd : Cardinal; PromptUser : boolean;
                       editModeOnly : boolean; bTriEditCommandGroup : boolean;
                       InputArgs : OleVariant) : HRESULT;
             procedure ToggleBullet;
             procedure ToggleNumbering;
             procedure Indent(Indent:boolean);
             procedure Align(IDM:integer);
             function SelText:string;
             procedure Paste;
             procedure Copy;
             procedure Cut;
             procedure Delete;
             procedure SelectAll;
             procedure SetText(HTML:string);
             procedure CompleteLoading;
             function CompNo:byte;
             function Visible:boolean;
             procedure Find;
             procedure Subscript;
             procedure Superscript;
             {end public}
          private
             OleInPlaceActiveObject: IOleInPlaceActiveObject;
             Events:TMSHTMLHTMLDocumentEvents;
             CtrlToBeProcessed,ShiftToBeProcessed:boolean;
             procedure SuperMemoMessageHandler(var Msg: TMsg; var Handled: Boolean);
             procedure OnMouseDown(Sender:TObject);
             procedure OnMouseUp(Sender:TObject);
             procedure OnMouseMove(Sender:TObject);
             procedure OnMouseOver(Sender:TObject);
             procedure OnMouseOut(Sender:TObject);
             function OnClick(Sender:TObject):WordBool;
             function OnSelectStart(Sender:TObject):WordBool;
             procedure OnFocusOut(Sender:TObject);
             procedure OnFocusIn(Sender:TObject);
             function OnContextMenu(Sender:TObject):WordBool;
             function OnKeyPress(Sender:TObject):WordBool;
             procedure OnKeyDown(Sender:TObject);
             procedure OnKeyUp(Sender:TObject);
             procedure ClickPoint(X,Y:integer);
             procedure DefineEvents;
             function HyperlinkClicked:boolean;
             function HrExecCommand(ucmdID: cardinal;
                       const pVarIn: OleVariant; var pVarOut: OleVariant; bPromptUser,
                       bTriEditCmdGroup: boolean): HResult;
             procedure ProcessLoadMessages;
             procedure SetBorderWidth;
             procedure ReassignKeyboardHandler(CompNo:byte;TurnOn:boolean);
            {end private}
          end;

implementation

uses WinProcs,Messages,Controls,Variants,Clipbrd,
     {Pieces of code specific to SuperMemo are marked as: SMSpecific:}
     {SMSpecific:}{These units are specific to SuperMemo}
     const8,Basic,Dial,Files,Component,
     DBDat,Col,Option,LayoutMan,ElementWindow,Main;

var PtrWGUID,PtrMGUID,PtrDGUID:PGUID;
    NULL:OleVariant;

constructor TWeb.Create(Owner:TComponent);
begin
  inherited Create(Owner);
  LoadedHTMLFile:='';
  OnBeforeNavigate2:=BeforeNavigate2;
  OnStatusTextChange:=StatusTextChange;
  OnCommandStateChange:=CommandStateChange;
  OnNavigateComplete2:=NavigateComplete2;
  TheDoc:=nil;
  DocCmd:=nil;
  WebCmd:=nil;
  Modified:=false;
  SuperMemoMenu:=true; {SMSpecific}
  LastClickX:=0;
  LastClickY:=0;
  ReadOnly:=false;
  CtrlToBeProcessed:=false;
  ShiftToBeProcessed:=false;
  Events:=nil;
end;

destructor TWeb.Destroy;
begin
  ReassignKeyboardHandler(Tag,false);
  inherited Destroy;
end;

procedure TWeb.SaveAs(DefaultName:string);
begin
  if TheDoc=nil then
     exit;
  TheDoc.ExecCommand('SaveAs',false,DefaultName);
  Modified:=false;
end;

procedure TWeb.Print;
begin
  ExecWB(OLECMDID_PRINT,OLECMDEXECOPT_PROMPTUSER,NULL,NULL);
end;

procedure TWeb.Save;
var
  sHTML:string;
  fsOut:TFileStream;
begin
  sHTML:=SourceText;
  fsOut:=TFileStream.Create(TheDoc.URL,fmCreate or fmShareExclusive);
  try
    fsOut.Write(pchar(sHTML)^, length(sHTML));
  finally
    fsOut.Free;
    Modified:=false;
  end;
end;

procedure TWeb.OnKeyUp(Sender:TObject);
begin {those empty handlers are needed for the keyboard and mouse to behave correctly with EventSink!}
  {nop}
end;

procedure TWeb.OnMouseMove(Sender:TObject);
begin
 {nop}
end;

procedure TWeb.OnMouseOver(Sender:TObject);
begin
  {nop}
end;

procedure TWeb.OnMouseOut(Sender:TObject);
begin
 {nop}
end;

function TWeb.OnClick(Sender:TObject):WordBool;
begin
  Result:=true;
end;

function TWeb.OnSelectStart(Sender:TObject):WordBool;
begin
  Result:=true;
end;

procedure TWeb.OnMouseUp(Sender:TObject);
begin
  {nop}
end;

procedure TWeb.Clear;
begin
  TheTextPosit:=0;
  SetHTMLText('');
end;

function TWeb.SelStart:integer;
var TextRange:IHtmlTxtRange;
begin
  Result:=0;
  TextRange:=GetTextRange;
  if TextRange=nil then
     exit;
  Result:=Abs(Integer(TextRange.move('character',-MaxTextLength)));
end;

function TWeb.SelEnd:integer;
var TextRange:IHtmlTxtRange;
begin
  Result:=0;
  TextRange:=GetTextRange;
  if TextRange=nil then
     exit;
  Result:=Abs(Integer(TextRange.MoveEnd('character',-MaxTextLength)));
end;

function TWeb.SelLength:integer;
begin
  Result:=SelEnd-SelStart;
end;

function TWeb.GetScrollTop:integer;
var FocusElement:IHTMLElement2;
begin
  Result:=0;
  try
     if TheDoc=nil then
        exit;
     FocusElement:=TheDoc.ActiveElement as IHTMLElement2;
     if FocusElement=nil then
        exit;
     Result:=FocusElement.ScrollTop;
  except
    on E:Exception do EError('Cannot get scroll top position',E);
    end;
end;

function TWeb.GetHTMLSelection:WideString;
var TextRange:IHtmlTxtRange;
begin
  Result:='';
  TextRange:=GetTextRange;
  if TextRange=nil then
     exit;
  Result:=TextRange.HTMLText;
end;

procedure TWeb.ClearSelection;
begin
  if TheDoc=nil then
     exit;
  TheDoc.Selection.Clear;
  Modified:=true;
end;

procedure TWeb.ReplaceSelection(HTML:string);
var TextRange:IHtmlTxtRange;
begin
  try
     TextRange:=GetTextRange;
     if TextRange=nil then
        exit;
     TextRange.PasteHTML(HTML); {Warning! pasting relative paths will result in conversion to absolute paths!}
     Modified:=true;
  except
   on E:Exception do begin
      ShortenString(HTML,80);
      EError('Error pasting HTML'+nl+
      'Microsoft HTML refuses to paste this string:'+nl+
      HTML+nl,E);
      end;
   end;
end;

procedure TWeb.SetFont(AFont:TFont;SetFontMode:byte);
begin
  try
     if TheDoc=nil then
        exit;
     Modified:=true;
     case TSetFontMode(SetFontMode) of
        sfAll:begin
          SetFont(AFont,byte(sfName));
          SetFont(AFont,byte(sfSize));
          SetFont(AFont,byte(sfStyle));
          SetFont(AFont,byte(sfColor));
          SetFont(AFont,byte(sfCharset));
          end;
        sfSize:TheDoc.ExecCommand('FontSize',false,AFont.Size div FontScale);
        sfColor:TheDoc.ExecCommand('ForeColor',false,AFont.Color);
        sfName:TheDoc.ExecCommand('FontName',false,AFont.Name);
        sfStyle:begin
           {bold}
           if TheDoc.queryCommandValue('Bold') then
              TheDoc.ExecCommand('Bold',false,true);
           if fsBold in AFont.Style then
              TheDoc.ExecCommand('Bold',false,true);
           {italic}
           if TheDoc.queryCommandValue('Italic') then
              TheDoc.ExecCommand('Italic',false,true);
           if fsItalic in AFont.Style then
              TheDoc.ExecCommand('Italic',false,true);
           {underline}
           if TheDoc.queryCommandValue('Underline') then
              TheDoc.ExecCommand('Underline',false,true);
           if fsUnderline in AFont.Style then
              TheDoc.ExecCommand('Underline',false,true);
          end;
        end;
  except
     on E:Exception do EError('Error setting HTML font',E);
    end;
end;

procedure TWeb.SetBorder(Border:boolean);
begin
  if TheDoc=nil then
     exit;
  if TheDoc.body=nil then
     exit;
  if not Border then begin
     if not Editable then begin
        TheDoc.body.style.borderStyle:='none';
        TheDoc.body.style.borderWidth:='thin';
        TheDoc.body.style.borderColor:='white';
        end;
     if Editable then begin
        TheDoc.body.style.borderStyle:='none';
        TheDoc.body.style.borderWidth:='thin';
        TheDoc.body.style.borderColor:='blue';
        end;
     end;
  if Border then begin
     if not Editable then begin
        TheDoc.body.style.borderStyle:='solid';
        TheDoc.body.style.borderWidth:='thin';
        TheDoc.body.style.borderColor:='silver';
        end;
     if Editable then begin
        TheDoc.body.style.borderStyle:='solid';
        TheDoc.body.style.borderWidth:='thin';
        TheDoc.body.style.borderColor:='blue';
        end;
     end;
end;

procedure TWeb.SetScrollBar(ScrollBar:boolean);
begin
  if TheDoc=nil then
     exit;
  if TheDoc.body=nil then
     exit;
  if ScrollBar then {values of "hidden" and "visible" lock PgUp and PgDn!}
     TheDoc.body.style.overflow:='scroll'
  else
     TheDoc.body.style.overflow:='auto';
end;

procedure TWeb.Undo;
begin
  if TheDoc=nil then
     exit;
  TheDoc.ExecCommand('Undo',false,0);
  Modified:=true;
end;

procedure TWeb.FontDialog;
begin
  SpecialCommand(IDM_FONT,True,True,False,Null);
  Modified:=true;
end;

function TWeb.SpecialCommand(Cmd:Cardinal;PromptUser:boolean;
                              editModeOnly:boolean;bTriEditCommandGroup:boolean;
                              InputArgs:OleVariant):HRESULT;
begin
  Result:=HrExecCommand(Cmd,null,InputArgs,promptUser,bTriEditCommandGroup);
end;

function TWeb.HrExecCommand(ucmdID: cardinal;
  const pVarIn: OleVariant; var pVarOut: OleVariant; bPromptUser,
  bTriEditCmdGroup: boolean): HResult;
var dwCmdOpt:DWORD;
begin
   result := S_OK;
   if DocCmd = nil then
      Exit;
   if (bPromptUser) then
      dwCmdOpt := MSOCMDEXECOPT_PROMPTUSER
   else
      dwCmdOpt := MSOCMDEXECOPT_DONTPROMPTUSER;
   if (bTriEditCmdGroup) then
      result := DocCmd.Exec(@GUID_TriEditCommandGroup,ucmdID,dwCmdOpt,pVarIn,pVarOut)
   else
      result := DocCmd.Exec(@CMDSETID_Forms3,ucmdID,dwCmdOpt,pVarIn,pVarOut);
end;

procedure TWeb.ToggleBullet;
begin
  if TheDoc=nil then
     exit;
  SpecialCommand(IDM_UnORDERLIST,false,true,false,Null);
  Modified:=true;
end;

procedure TWeb.ToggleNumbering;
begin
  if TheDoc=nil then
     exit;
  SpecialCommand(IDM_ORDERLIST,false,true,false,Null);
  Modified:=true;
end;

procedure TWeb.Align(IDM:integer);
begin
  if TheDoc=nil then
     exit;
  SpecialCommand(IDM,false,true,false,Null);
  Modified:=true;
end;

procedure TWeb.SetBackgroundColor(Color:TColor);
begin
  if TheDoc=nil then
     exit;
  TheDoc.ExecCommand('BackColor',false,Color);
  Modified:=true;
end;

function TWeb.SelText:string;
var TextRange:IHtmlTxtRange;
begin
  Result:='';
  TextRange:=GetTextRange;
  if TextRange=nil then
     exit;
  Result:=TextRange.text;
end;

procedure TWeb.Indent(Indent:boolean);
begin
  if TheDoc=nil then
     exit;
  if Indent then
     TheDoc.ExecCommand('Indent',false,0)
  else
     TheDoc.ExecCommand('Outdent',false,0);
  Modified:=true;
end;

procedure TWeb.BeforeNavigate2(Sender: TObject;
   const pDisp: IDispatch;var URL: OleVariant;var Flags: OleVariant;var TargetFrameName:OleVariant;var PostData: OleVariant;
   var Headers: OleVariant;var Cancel: WordBool);
begin
  if SuperMemoURL(URL) then begin {cancel the link if it uses an internal SuperMemo protocol}{SMSpecific}
     Cancel:=true;
     LastHyperlink:='';
     exit;
     end;
end;

procedure TWeb.SelectAll;
begin
  SetSelection(0,MaxTextLength);
end;

procedure TWeb.NavigateComplete2(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
begin
  CompleteLoading;
end;

procedure TWeb.CompleteLoading;
begin
  Waitload(false); {used only to set up interface variables}
  SetBorderWidth;
  if ReadOnly then
     exit;
  if TheDoc=nil then
     exit;
  DefineEvents;
  {do not use Modified:=false here as navigation might go from an edited page to a hyperlinked page}
  if TheParent<>ElementWindow.ElWind then
     exit;
  if TElWind(TheParent).GetState(CompNo)=stEdit then
     SetState(true)
  else
     SetState(false);
end;

procedure TWeb.SetHTMLText(Html:WideString); {after this command, Copy and Paste will not work}
var V:OleVariant;
begin
   try
      Stop;
      V:=Document;
      V.Open;
      V.Clear;
      V.Write(Html);
      V.Close;
      Modified:=true;
   except
      on E:Exception do EError('Error setting HTML text',E);
     end;
end;

function TWeb.CompNo:byte;
begin
  Result:=byte(Tag);
end;

function TWeb.Visible;
begin
  Result:=true;
  if TheParent<>ElementWindow.ElWind then
     exit;
  Result:=TWinControl(ElementWindow.ElWind.Objects[CompNo]).Visible;
end;

function TWeb.GetBackgroundColor:TColor;
var Background:OleVariant;
    vt:TVarType;
begin
  Result:=clWindow;
  try
     if TheDoc=nil then
        exit;
     if not Visible then {SMSpecific:}{to avoid errors on Ctrl+T before Show Answer}{Nov 8, 2001}
        exit;
     Background:=TheDoc.queryCommandValue('BackColor');
     vt:=varType(Background);
     if vt<>varNull then
        Result:=Background;
  except
    on E:Exception do EError('Error retrieving background color',E);
    end;
end;

procedure TWeb.GetFont(var AFont:TFont);
var FontName,FontSize,FontColor:OleVariant;
    vt:TVarType;
begin
  try
     if TheDoc=nil then
        exit;
     {name}
     FontName:=TheDoc.queryCommandValue('FontName');
     vt:=varType(FontName);
     if vt<>varNull then
        AFont.Name:=FontName
     else
        AFont.Name:=Database.DefaultFont.Name;
     {size}
     FontSize:=TheDoc.queryCommandValue('FontSize');
     vt:=varType(FontSize);
     if vt<>varNull then
        AFont.Size:=FontSize*FontScale
     else
        AFont.Size:=Database.DefaultFont.Size;
     {color}
     FontColor:=TheDoc.queryCommandValue('ForeColor');
     vt:=varType(FontColor);
     if vt<>varNull then
        AFont.Color:=FontColor
     else
        AFont.Color:=Database.DefaultFont.Color;
     {style}
     AFont.Style:=[];
     {bold}
     if TheDoc.queryCommandValue('Bold') then
        AFont.Style:=AFont.Style+[fsBold];
     {italic}
     if TheDoc.queryCommandValue('Italic') then
        AFont.Style:=AFont.Style+[fsItalic];
     {underline}
     if TheDoc.queryCommandValue('Underline') then
        AFont.Style:=AFont.Style+[fsUnderline];
  except
    on E:Exception do EError('Error detecing HTML font',E);
    end;
end;

procedure TWeb.Find;
const HTMLID_FIND=1;
var vaIn,vaOut:OleVariant;
begin
  if WebCmd=nil then
     exit;
  WebCmd.Exec(PtrWGUID,HTMLID_FIND,0,vaIn,vaOut); {this command is not guaranteed to work in future versions of IE!}
end;

function TWeb.OnKeyPress(Sender:TObject):WordBool;
begin {must be defined empty for the keyboard to work correctly}
  Modified:=true;
  Result:=true;
end;

function TWeb.OnContextMenu(Sender:TObject):WordBool;
var APoint:TPoint;
begin
  Result:=true;
  if AccessMode<amFull then
     exit;
  if SM8Main.IsSimplified then
     exit;
  if not SuperMemoMenu then
     exit;
  Result:=false;
  if TheParent<>ElementWindow.ElWind then
     exit;
  if TheDoc=nil then
     exit;
  if TheDoc.body=nil then
     exit;
  if Extrinsic then
     exit;
  if ReadOnly then
     exit;
  if TheWind=nil then
     exit;
  if TheWind.Event=nil then
     exit;
  GetCursorPos(APoint);
  ElementWindow.ElWind.CurrentComponent:=CompNo;
  ElementWindow.ElWind.ComponentMenu.PopUp(APoint.X,APoint.Y);
end;

procedure TWeb.SetText(HTML:string);
begin
  if (TheDoc=nil)or(TheDoc.body=nil) then
     SetHTMLText(HTML)
  else
     TheDoc.body.innerHTML:=HTML;
end;

procedure TWeb.DefineEvents;
begin
  if IEVer<5.5 then {if Internet Explorer older than 5.5 then ignore events}
     exit;
  if Events<>nil then
     Events.Free;
  Events:=TMSHTMLHTMLDocumentEvents.Create(Self);
  Events.Connect(IUnknown(Document));
  Events.OnMouseDown:=OnMouseDown;
  Events.OnMouseUp:=OnMouseUp;
  Events.OnMouseMove:=OnMouseMove;
  Events.OnMouseOver:=OnMouseOver;
  Events.OnMouseOut:=OnMouseOut;
  Events.OnClick:=OnClick;
  Events.OnSelectStart:=OnSelectStart;
  Events.OnKeyPress:=OnKeyPress;
  Events.OnKeyDown:=OnKeyDown;
  Events.OnKeyUp:=OnKeyUp;
  Events.OnContextMenu:=OnContextMenu;
  Events.OnFocusOut:=OnFocusOut;
  Events.OnFocusIn:=OnFocusIn;
end;

procedure TWeb.Paste;
begin
  if TheDoc=nil then
     exit;
  TheDoc.ExecCommand('Paste',false,0);
  Modified:=true;
  _Filter:=true;
end;

procedure TWeb.Delete;
begin
  if TheDoc=nil then
     exit;
  TheDoc.ExecCommand('Delete',false,0);
  Modified:=true;
  _Filter:=true;
end;

procedure TWeb.Cut;
begin
  Copy;
  Delete;
end;

procedure TWeb.SetFocus;
begin
  try
    if TheDoc=nil then
       exit;
    SendMessage(Handle,wm_Activate,1,0);
    if TheWind<>nil then
       TheWind.Focus; {TheWind.Focus must come before TWeb.SetFocus}
    if TheParent.Visible then {Parenting window hosting web browser}
       if Visible then
          if CanFocus then
             inherited SetFocus; {must come AFTER TheWind.Focus}
  except
    on E:Exception do EError('Error setting focus on HTML component',E);
    end;
end;

function TWeb.HyperlinkClicked:boolean;
var Element:IHTMLElement;
begin
  Result:=false;
  LastHyperlink:='';
  if TheWind.Event=nil then
     exit;
  Element:=TheWind.Event.srcElement;
  repeat
    if Element.tagName='A' then begin
       LastHyperlink:=Element.getAttribute('href',0);
       if LastHyperlink<>'' then begin
          Result:=TheWind.Event.Button=1; {Button=1 is the left mouse button}
          exit;
          end;
       end;
    if Element<>nil then
       Element:=Element.ParentElement;
    until Element=nil;
end;

procedure TWeb.SetScrollTop(ScrollTop:integer);
begin
  if TheDoc=nil then
     exit;
  if TheWind=nil then
     exit;
  TheWind.scrollTo(0,ScrollTop);
end;

procedure TWeb.Subscript;
begin
  if TheDoc=nil then
     exit;
  TheDoc.execCommand('Subscript',False,0);
  Modified:=true;
end;

procedure TWeb.Superscript;
begin
  if TheDoc=nil then
     exit;
  TheDoc.execCommand('Superscript',False,0);
  Modified:=true;
end;

procedure TWeb.ProcessLoadMessages;
var msg:TMsg;
    OldElementNo:integer;
    MessageQueue:array of TMsg;
    m:integer;
begin
  OldElementNo:=ElementWindow.ElWind.TheElement;
  while PeekMessage(msg,0,wm_KeyFirst,wm_KeyLast,pm_Remove) do; {remove keyboard input first}
  while PeekMessage(msg,0,wm_MouseFirst,wm_MouseLast,pm_Remove) do; {remove mouse input}
  while PeekMessage(msg,0,wm_Close,wm_Close,pm_Remove) do; {disallow closing the application}
  while PeekMessage(msg,0,wm_ActivateApp,wm_ActivateApp,pm_Remove) do; {disallow activating the application}
  while PeekMessage(msg,0,wm_User,cm_LastUserMessage,pm_Remove) do begin
        SetLength(MessageQueue,length(MessageQueue)+1);
        MessageQueue[length(MessageQueue)-1]:=msg;
        end;
  forms.Application.ProcessMessages; {process messages needed to complete navigation}
  for m:=1 to length(MessageQueue) do begin
      msg:=MessageQueue[m-1];
      PostMessage(msg.hwnd,msg.message,msg.wParam,msg.lParam);
      end;
  if ElementWindow.ElWind.TheElement<>OldElementNo then
     Error('Element changed while loading HTML'+nl+
           'Loading: '+ElementStr(OldElementNo)+nl+
           'Changed to: '+ElementStr(ElementWindow.ElWind.TheElement));
end;

function TWeb.SaveFile(Filename:string):boolean;
var Source:string;
begin
  Result:=false;
  try
     Modified:=false;
     Source:=SourceText;
     if pos('&#',Source)=0 then
        if pos('<',Source)=0 then
           if pos('>',Source)=0 then begin
              Result:=false; {do not save plain text into the file}
              exit;
              end;
     WriteStringToTXTFile(FileName,Source);
     Result:=true;
  except
    on Exception do Error('Error writing to "'+Filename+'"');
    end;
end;

function TWeb.SourceText:string;
var WS:WideString;
    ch:WideChar;
    n:integer;
    w:word;
    s:string;
begin
  Result:='';
  if TheDoc=nil then
     exit;
  WS:=TheDoc.body.innerHTML;
  for n:=1 to length(WS) do begin
      ch:=WS[n];
      w:=word(ch);
      if w>255 then begin
         s:=IntToStr(w);
         s:='&#'+s+';';
         end
      else
         s:=ch;
      Result:=Result+s;
      end;
end;

function TWeb.Text:string;
var WS:WideString;
    ch:WideChar;
    n:integer;
    w:word;
    s:string;
begin
  Result:='';
  if TheDoc=nil then
     exit;
  WS:=TheDoc.body.innerText;
  for n:=1 to length(WS) do begin
      ch:=WS[n];
      w:=word(ch);
      if w>255 then begin
         w:=(w mod 256)+48;
         s:=IntToStr(w);
         s:=char(w);
         end
      else
         s:=ch;
      Result:=Result+s;
      end;
end;

procedure TWeb.ClickPoint(X,Y:integer);
var TextRange:IHtmlTxtRange;
begin
  try
     TextRange:=GetTextRange;
     if TextRange=nil then
        exit;
     TextRange.MoveToPoint(X,Y);
     TextRange.Select;
  except
    on E:Exception do EError('Error processing mouse click',E);
    end;
end;

procedure TWeb.WaitLoad(peek:boolean);
begin
  try
     TheDoc:=Document as IHTMLDocument2;
     while TheDoc=nil do begin
        if peek then
           ProcessLoadMessages
        else
           exit;
        TheDoc:=Document as IHTMLDocument2;
        end;

     repeat
        ControlInterface.QueryInterface(IID_IOleCommandTarget,WebCmd);
        until WebCmd<>nil;

     repeat
        TheDoc.QueryInterface(IOleCommandTarget,DocCmd);
        until DocCmd<>nil;

     repeat
        TheWind:=TheDoc.parentWindow;
        until TheWind<>nil;

     while (TheDoc=nil)or((theDoc.ReadyState<>'complete')and(theDoc.ReadyState<>'interactive')) do begin
        {remove messages that should not be processed while the element is loading}
        {TheDoc can become nil when switching applications!}
        if TheDoc=nil then
           MessageBeep(0); {this beep is sounded while page is loading while SuperMemo is no longer in forefront}
        if peek then
           ProcessLoadMessages
        else
           exit;
        end;

  except
       on E:Exception do EError('Error loading the document',E);
    end;
end;

procedure TWeb.SetSelection(Start,Length:integer);
var TextRange:IHtmlTxtRange;
begin
  try
     if TheDoc=nil then
        exit;
     TheDoc.Selection.Empty;
     TextRange:=GetTextRange;
     if TextRange=nil then
        exit;
     TextRange.collapse(true);
     l:=TextRange.moveEnd('character',Start+Length);
     l:=TextRange.moveStart('character',Start);
     TextRange.select;
  except
    on E:Exception do EError('Error setting HTML selection'+nl+
                             'Start='+IntToStr(Start)+nl+
                             'Length='+IntToStr(Length),E);
    end;
end;

procedure TWeb.SuperMemoMessageHandler(var Msg: TMsg; var Handled: Boolean);
{this message handler is vital to enable accelerators, Del, Backspace and other keys}
var iOIPAO: IOleInPlaceActiveObject;
    Dispatch: IDispatch;
begin
  Handled:=false;
  if msg.message=wm_SysChar then begin
     SendMessage(ElementWindow.ElWind.Handle,Msg.message,Msg.wparam,Msg.lParam); {Nov 17, 2001}{to enable the main menu}
     Handled:=true;
     exit;
     end;
  if not ((msg.message=wm_keydown)or(msg.message=wm_keyup)or(msg.message=wm_char)) then
     exit;
  if msg.wparam=ord('P') then begin
     if ShiftToBeProcessed then
        if CtrlToBeProcessed then begin {Block printing}
           msg.wparam:=0;
           CtrlToBeProcessed:=false;
           ShiftToBeProcessed:=false;
           Handled:=true;
           SM8Main.MIElementParametersClick(nil);
           exit;
           end;
     if CtrlToBeProcessed then begin {Block printing}
        msg.wparam:=0;
        CtrlToBeProcessed:=false;
        Handled:=true;
        Sm8Main.MIPlanClick(nil); {SMSpecific}{Open Plan with Ctrl+P}
        exit;
        end;
     end;
  if msg.wparam=ord('F') then begin
     if CtrlToBeProcessed then begin {Block searching}
        msg.wparam:=0;
        CtrlToBeProcessed:=false;
        Handled:=true;
        ElementWindow.ElWind.LockReadPointOnSearch:=true;
        Sm8Main.ActFindStringExecute(nil); {SMSpecific}{Search whole collection}
        exit;
        end;
     end;
  if msg.wparam=17 then  {Ctrl key pressed}
     if msg.message=wm_keydown then begin
        CtrlToBeProcessed:=true;
        Handled:=true;
        exit;
        end;
  if msg.wparam=vk_Shift then
     if msg.message=wm_keydown then begin
        ShiftToBeProcessed:=true;
        Handled:=true;
        exit;
        end;
  CtrlToBeProcessed:=false;
  ShiftToBeProcessed:=false;
  if msg.wparam in [vk_Return,vk_Escape, {to ensure that Enter and shortcuts work}
     {vk_F3 cannot be used due to conflict with 'R'}
     vk_F4, {tasklist}
     {vk_F6 is handled in OnKeyDown}
     vk_F7, {read points}
     vk_F11, {random jump}
     vk_F12, {quick backup, recovery}
     vk_Up, {to handle Ctrl+Alt+Up}
     ord('1'), {Ctrl+Shift+1 for deHTMLize}
     {'A' cannot be listed due to conflict with Show Answer}
     {'D' cannot be listed due to conflict with Dismiss}
     ord('E'), {Ctrl+alt+E}
     ord('F'), {Ctrl+Shift+F}
     {'G' cannot be listed due to conflict with Cancel Grade}
     ord('H'), {Ctrl+Alt+H}
     ord('J'), {Ctrl+J}
     ord('K'), {Ctrl+Alt+K}
     {'M' cannot be listed due to conflict with Remember}
     ord('T'), {Ctrl+T}
     ord('U'), {Ctrl+Alt+U}
     ord('W') {Ctrl+W}
     ] then exit;
  if Msg.wParam in [vk_Back,vk_Delete] then
     Modified:=true;
  Handled:=(IsDialogMessage(Handle, Msg) = True);
  if (Handled) and (not Busy) then begin
    if OleInPlaceActiveObject = nil then begin
      Dispatch := Application;
      if Dispatch <> nil then begin
         Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
         if iOIPAO <> nil then
            OleInPlaceActiveObject := iOIPAO;
         end;
       end;
    if OleInPlaceActiveObject <> nil then
      if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
         ((Msg.wParam=VK_BACK)or {do not include vk_Delete here!!!}{Nov 11, 2001}
         (Msg.wParam=VK_LEFT)or(Msg.wParam=VK_RIGHT)or
         (Msg.wParam=VK_Up)or
         (Msg.wParam=VK_Down)or
         (Msg.wParam=vk_Next)or(Msg.wParam=vk_Prior)) then
         {nop}
      else
        OleInPlaceActiveObject.TranslateAccelerator(Msg);
  end;
end;

procedure TWeb.SetBorderWidth;
begin
  try
     if TheDoc=nil then
        exit;
     if TheParent<>ElementWindow.ElWind then
        exit;
     SetBorder(TElWind(TheParent).GetBorder(CompNo));
     SetScrollBar(TElWind(TheParent).GetScrollBar(CompNo));
  except
    on Exception do Error('Cannot set HTML border');
    end;
end;

procedure TWeb.OnFocusIn(Sender:TObject);
begin
  if Editable then
     ReassignKeyboardHandler(CompNo,true); {each TWeb has a unique handler which must be reassigned at SetFocus}
end;

procedure TWeb.ReassignKeyboardHandler(CompNo:byte;TurnOn:boolean);
{assign HTML keyboard handler to HTML component; assign standard if TurnOn=false}
var IsDefault:boolean;
begin
  if TurnOn then
     if CompNo<>0 then begin
        Forms.Application.OnMessage:=SuperMemoMessageHandler; {each TWeb has a unique handler which must be reassigned at SetFocus}
        OnMessageCompNo:=CompNo;
        end;
  if not TurnOn then
     if CompNo=OnMessageCompNo then begin
        Forms.Application.OnMessage:=ApplicationOnMessage;
        OnMessageCompNo:=0;
        end;
  IsDefault:=OnMessageCompNo=0;
  if TheParent=ElementWindow.ElWind then begin
     ElementWindow.ElWind.Learn.Default:=IsDefault;
     ElementWindow.ElWind.ShowAnswer.Default:=IsDefault;
     ElementWindow.ElWind.Pass.Default:=IsDefault;
     ElementWindow.ElWind.NextRepetition.Default:=IsDefault;
     end;
end;

procedure TWeb.Copy;
var TheRange:OleVariant;
begin
  if TheDoc=nil then
     exit;
  TheDoc.ExecCommand('Copy',false,0);
  if Clipboard.AsText='' then begin
     if (TheDoc.Selection.type_='Text')or(TheDoc.Selection.type_='None') then
        TheRange:=TheDoc.Selection.CreateRange as IHtmlTxtRange
     else
        TheRange:=TheDoc.Selection.CreateRange as IHtmlControlRange;
     TheRange.execCommand('Copy');
     end;
end;

procedure TWeb.StatusTextChange(Sender: TObject; const Text: WideString);
begin
   SM8Main.ShowStatusText(Text);
end;

procedure TWeb.CommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
begin
  case Command of
    CSC_NAVIGATEBACK:if not Enable then
       Extrinsic:=false; {to make sure Back< does not execute TWeb.GoBack}
    CSC_NAVIGATEFORWARD:{nop};
  end;
end;

procedure TWeb.SetState(Edit:boolean);
begin
  try
    SetBorderWidth;
    if ReadOnly then
       exit;
    if IEVer<5.5 then
       exit;
    if TheDoc<>nil then begin
       if Edit then begin
          if TheDoc.body<>nil then begin
             TheDoc.body.setAttribute('contentEditable','true',0);
             SetFocus;
             SuperMemoMenu:=true;
             Editable:=true;
             end;
          end;
       if not Edit then begin
          if TheDoc.body<>nil then begin
             TheDoc.body.setAttribute('contentEditable','false',0);
             ReassignKeyboardHandler(CompNo,false);
             Editable:=false;
             end;
          end;
       end;
  except
    on E:Exception do EError('Error switching HTML editing state',E);
    end;
end;

procedure TWeb.OnMouseDown(Sender:TObject);
var ScrollTop:integer;
begin
  if HyperlinkClicked then
     if not Editable then begin
        SuperMemoMenu:=false; {SMSpecific}
        Extrinsic:=true;
        exit;
        end;
  TComponent(Sender).Tag:=CompNo;
  if TheDoc=nil then
     exit;
  if TheDoc.body=nil then
     exit;
  if Extrinsic then
     exit;
  if ReadOnly then
     exit;
  if TheWind=nil then
     exit;
  if TheWind.Event=nil then
     exit;
  if Editable then begin
     if TheParent=ElementWindow.ElWind then begin
        if not TheWind.Event.altKey then
           exit;
        ElementWindow.ElWind.SetState(CompNo,stDrag);
        end;
     SetState(true); {Parent not ElementWindow}
     SetFocus;
     exit;
     end;
  if not Editable then begin
     if TheWind.Event.button<>1 {mbLeft} then
        exit;
     if Width-TheWind.event.offsetX<VerticalScrollBarWidth+2 then {scrollbar click}
        exit;
     if Height-(TheWind.event.offsetY-GetScrollTop)<HorizontalScrollBarHeight+2 then {scrollbar click}
        exit;
     LastClickX:=TheWind.Event.X;
     LastClickY:=TheWind.Event.Y;
     ScrollTop:=GetScrollTop;
     if TheParent=ElementWindow.ElWind then
        ElementWindow.ElWind.FormMouseDown(Sender,mbLeft,[],LastClickX,LastClickY) {SMSpecific}
     else
        SetState(true);
     SetFocus;
     SetScrollTop(ScrollTop);
     ClickPoint(LastClickX,LastClickY);
     end;
end;

procedure TWeb.OnFocusOut(Sender:TObject);
begin
  ReassignKeyboardHandler(CompNo,false); {each TWeb has a unique handler which must be cleared at Focus out}
end;

procedure TWeb.LoadFile(FileName:string);
var OldWidth,OldHeight:integer;
begin
  try
     Hourglass;
     OldHeight:=Height;
     OldWidth:=Width;
     Navigate(FileName);
     LoadedHTMLFile:=FileName;
     Width:=OldWidth; {due to a bug that sizes down HTML components on start}{Oct 15, 2001}
     Height:=OldHeight;
     TheDoc:=nil;
     if DocCmd<>nil then begin
        DocCmd._Release;
        DocCmd:=nil;
        end;
     Modified:=false;
     Extrinsic:=false;
     _Filter:=false;
  except
    on E:Exception do begin
       EError('Cannot load '+Filename,E);
       ElementWindow.ElWind.MustReloadComponents:=false; {otherwise wm_ActicateApp can loop}
       end;
    end;
end;

procedure TWeb.OnKeyDown(Sender:TObject);
{SMSpecific: most of the codes used here are specific to SuperMemo}
begin
  if TheWind=nil then
     exit;
  if TheWind.Event=nil then
     exit;
  if TheParent<>ElementWindow.ElWind then begin
     Modified:=true;
     exit;
     end;
  if not Editable then begin
     SendMessage(ElementWindow.ElWind.Handle,wm_KeyDown,TheWind.Event.KeyCode,0);
     exit;
     end;
  with TheWind.Event do begin
     if KeyCode=vk_Return then begin
        if (not CtrlKey) and (not ShiftKey) and (not AltKey) then
           if SelLength>0 then begin {SMSpecific}
              SetState(false);
              SendMessage(ElementWindow.ElWind.Handle,wm_KeyDown,TheWind.Event.KeyCode,0);
              exit;
              end;
        end;
     if KeyCode=vk_Delete then
        if CtrlKey and (not ShiftKey) and (not AltKey) then begin
           SetState(false);
           ElementWindow.ElWind.MIDeleteComponentClick(Sender);
           exit;
           end;
     if KeyCode=vk_Up then
        if CtrlKey and (not AltKey) and (not ShiftKey) then begin
           ElementWindow.ElWind.MIParentElementClick(Sender);
           exit;
           end;
     if KeyCode=vk_Left then
        if (not CtrlKey) and AltKey and (not ShiftKey) then begin
           PostMessage(ElementWindow.ElWind.Handle,cm_Back,0,0);
           exit;
           end;
     if KeyCode=vk_Right then
        if (not CtrlKey) and AltKey and (not ShiftKey) then begin
           PostMessage(ElementWindow.ElWind.Handle,cm_Forward,0,0);
           exit;
           end;
     if KeyCode in [vk_Control,
        vk_Left,vk_Up,vk_Down,vk_Right,vk_Escape] then {do not set modified to True on navigation keys}
           exit;
     if KeyCode=vk_F3 then begin
        if (not CtrlKey) and (not ShiftKey) and (not AltKey) then begin
           ElementWindow.ElWind.LockReadPointOnSearch:=true;
           ElementWindow.ElWind.MISearchTextClick(Sender);
           exit;
           end;
        if (CtrlKey) and (ShiftKey) and (not AltKey) then begin
           ElementWindow.ElWind.MIShowCitationClick(Sender);
           exit;
           end;
        end;
     if KeyCode=vk_F6 then begin
        if (not CtrlKey) and (not ShiftKey) and (not AltKey) then begin
           PostMessage(ElementWindow.ElWind.Handle,cm_FilterSource,0,0);
           exit;
           end;
        if (CtrlKey) and (ShiftKey) and (not AltKey) then begin
           ElementWindow.ElWind.MIViewSourceClick(Sender);
           exit;
           end;
        end;
     if KeyCode=ord('A') then {SMSpecific}
        if not TrimShortcuts then
           if CtrlKey and (not ShiftKey) and AltKey then begin
              Sm8Main.ActAddTaskExecute(Sender);
              exit;
              end;
     if KeyCode=ord('C') then {SMSpecific}{Ctrl+Shift+C does not work}
        if CtrlKey and ShiftKey and (not AltKey) then begin
           SM8Main.MICopyClick(Sender);
           exit;
           end;
     if KeyCode=ord('D') then begin {SMSpecific}{Ctrl+Shift+C does not work}
        if CtrlKey and (not ShiftKey) and (not AltKey) then begin
           ElementWindow.ElWind.DismissCurrentElement;
           exit;
           end;
        if CtrlKey and (not ShiftKey) and AltKey then begin
           ElementWindow.ElWind.MIDuplicateClick(Sender);
           exit;
           end;
        end;
     if KeyCode=ord('F') then
        if CtrlKey and (not ShiftKey) and (not AltKey) then begin
           ElementWindow.ElWind.LockReadPointOnSearch:=true;
           exit;
           end;
     if KeyCode=ord('G') then
        if CtrlKey and (not ShiftKey) and (not AltKey) then begin
           SM8Main.MIGoToClick(Sender);
           exit;
           end;
     if KeyCode=ord('L') then {SMSpecific}{Ctrl+L does not work}
        if CtrlKey and (not ShiftKey) and (not AltKey) then begin
           ElementWindow.ElWind.Learning(lsOutstanding);
           exit;
           end;
     if KeyCode=ord('M') then
        if CtrlKey and ShiftKey and (not AltKey) then begin
           ElementWindow.ElWind.ApplyTemplate(false{=do not replace});
           exit;
           end;
     if KeyCode=ord('N') then
        if not TrimShortcuts then begin
           if CtrlKey and (not ShiftKey) and (AltKey) then begin
              SM8Main.MIAddArticleClick(Sender);
              exit;
              end;
           if (not CtrlKey) and (not ShiftKey) and (AltKey) then begin
              ElementWindow.ElWind.NextRepetitionClick(Sender);
              exit;
              end;
           end;
     if KeyCode=ord('P') then begin
        if CtrlKey and ShiftKey and (not AltKey) then begin
           ElementWindow.ElWind.MIEditParamtersClick(Sender);
           exit;
           end;
        end;
     if KeyCode=ord('R') then {SMSpecific}{Ctrl+L does not work}
        if CtrlKey and ShiftKey and (not AltKey) then begin
           PostMessage(ElementWindow.ElWind.Handle,cm_ForceRepetition,0,ElementWindow.ElWind.TheElement);
           exit;
           end;
     if KeyCode=ord('Y') then {SMSpecific}{Ctrl+L does not work}
        if CtrlKey and (not ShiftKey) and (not AltKey) then begin
           SM8Main.MIMercyClick(Sender);
           exit;
           end;
     if KeyCode=221 {Ctrl+]} then
        ElementWindow.ElWind.ChangeFontSize(+1);
     if KeyCode=219 {Ctrl+[} then
        ElementWindow.ElWind.ChangeFontSize(-1);
  end;
  Modified:=true;
end;

function TWeb.GetTextRange:IHtmlTxtRange;
begin
  Result:=nil;
  try
     if TheDoc=nil then
        exit;
     while TheDoc.body=nil do begin
        WaitLoad(true);
        if TheDoc.body=nil then
           if QueryC('Wait for document loading?')<>id_Yes then
              exit;
        end;
     if (TheDoc.Selection.type_='Text')or(TheDoc.Selection.type_='None') then
        Result:=TheDoc.Selection.CreateRange as IHtmlTxtRange;
  except
    on E:Exception do EError('This type of selection cannot be processed',E);
    end;
end;

initialization
  FillChar(BrowserData,SizeOf(BrowserData),#0);
  OleInitialize(nil);
  New(PtrWGUID);
  New(PtrMGUID);
  New(PtrDGUID);
  PtrWGUID^:=CGID_WebBrowser;
  PtrMGUID^:=CGID_MSHTML;
  PtrDGuid:=PGUID(nil);
  GetBrowserData(BrowserData);
  IEStr:=IEVerStr;
  OnMessageCompNo:=0;

finalization
  Dispose(PtrWGUID);
  Dispose(PtrMGUID);
  Dispose(PtrDGUID);
  OleUninitialize;

end.