unit TMGHTML2;

(*
NOTES:  By Kevin Toppenberg, MD 5/27/09

Code heavily modified from original code found at www.supermemo.com/source/
Their notes (below) indicate that the code may be freely used.
---------------
This unit encapsulates SHDocVw.dll and MSHTML.dll functionality by subclassing
THtmlEditorBrowser object as THtmlEditor object

THtmlEditor 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.
*)

(*
NOTICE: Also Derived from EmbeddedED.  See notes in that code block.
*)

interface

uses SysUtils, WinTypes, Dialogs, StdCtrls, Menus,
     EmbeddedED,
     ActiveX, MSHTMLEvents, SHDocVw, {MSHTML,} MSHTML_EWB,
     AppEvnts, controls,
     IeConst,Messages,Classes,Forms,Graphics;

type  
  TSetFontMode = (sfAll,sfSize,sfColor,sfName,sfStyle,sfCharset); 

  TRGBColor = record
       R : byte; 
       G : byte;
       B : byte;
  end; {record}
  
  TMGColor = record
    case boolean of
      True: (Color : TColor);
      False: (RGBColor : TRGBColor);
  end; {record}
                               
type 
    // THtmlObj=class(TWebBrowser)
    THtmlObj=class(TEmbeddedED)
    private
      CtrlToBeProcessed  :     boolean; 
      ShiftToBeProcessed :     boolean;
      CtrlReturnToBeProcessed: boolean;
      Modified:                boolean;
      FOrigAppOnMessage :      TMessageEvent;  
      FApplication :           TApplication;
      FActive :                boolean;
      FEditable:               boolean;       
      ColorDialog:             TColorDialog;       
      AllowNextBlur :          boolean;
      function  GetHTMLText:string;
      procedure SetHTMLText(HTML:String);
      function  GetText:string;
      procedure SetText(HTML:string);  
      function  GetEditableState : boolean;
      procedure SetEditableState (EditOn : boolean);         
      procedure SetBackgroundColor(Color:TColor);
      function  GetBackgroundColor : TColor;       
      function ColorToMSHTMLStr(color : TColor) : string; 
      function MSHTMLStrToColor(MSHTMLColor : string) : TColor;
      procedure SetTextForegroundColor(Color:TColor);
      function  GetTextForegroundColor : TColor; 
      procedure SetTextBackgroundColor(Color:TColor);
      function  GetTextBackgroundColor : TColor;
      function  GetFontSize : integer;
      procedure SetFontSize (Size : integer);                   
      function  GetFontName : string;
      procedure SetFontName (Name : string);
      function  GetSelText:string;        
      procedure SetSelText (HTMLText : string); 
      procedure ReassignKeyboardHandler(TurnOn : boolean);
      procedure GlobalMsgHandler(var Msg: TMsg; var Handled: Boolean);
      procedure HandleBlur(Sender: TObject);
      procedure SubMessageHandler(var Msg: TMessage); override;
      function SubFocusHandler(fGotFocus: BOOL): HResult; override;
      function GetActive : boolean;
      {end private}
    public
      {end public}
      PopupMenu:     TPopupMenu;
      KeyStruck : boolean; // A VERY crude determiner as to if Modified.
      NextControl : TWinControl;
      PrevControl : TWinControl;
      procedure SetMsgActive (Active : boolean);
      constructor Create(Owner:TControl; Application : TApplication);
      destructor Destroy; override;
      procedure Clear;
      procedure ToggleBullet;
      procedure ToggleItalic;
      procedure ToggleBold;         
      procedure ToggleNumbering;
      procedure ToggleUnderline;
      procedure ToggleSubscript;
      procedure ToggleSuperscript;
      procedure Indent;
      procedure Outdent;
      procedure AlignLeft;
      procedure AlignRight;
      procedure AlignCenter;
      procedure TextForeColorDialog;
      procedure TextBackColorDialog;     
      procedure FontDialog;
      function  SelStart:integer;
      function  SelEnd:integer;
      function  SelLength:integer;
      function  GetTextRange:IHtmlTxtRange;
      procedure ReplaceSelection(HTML:string);
      procedure Loaded; Override;      
      function  GetTextLen : integer;
      function  MoveCaretToEnd : boolean;
      function  MoveCaretToPos(ScreenPos: TPoint) : HRESULT;  //kt added
      procedure InsertHTMLAtCaret(HTMLText : AnsiString); //kt 4/21/10
      procedure InsertTextAtCaret(Text : AnsiString); //Note: Text is NOT HTMLtext
      property  HTMLText:string read GetHTMLText write SetHTMLText;
      property  Text:string read GetText write SetText;
      //property Active : boolean read FActive write SetMsgActive;        
      property  Active : boolean read GetActive;
      property  Editable : boolean read GetEditableState write SetEditableState;
      property  BackgroundColor : TColor read GetBackgroundColor write SetBackgroundColor;
      property  FontSize : integer read GetFontSize write SetFontSize;
      property  FontName : string read GetFontName write SetFontName;
      property  SelText : string read GetSelText write SetSelText;
    end;

implementation


uses 
  WinProcs,Variants,Clipbrd, StrUtils, Math,
  Windows;

const   
  FontScale=3;  
  MaxTextLength = 100;
  nl = #13#10;
  
procedure EError(EText : string; E : Exception);
begin
  MessageDlg(EText,mtError,[mbOK],0);
end;


constructor THtmlObj.Create(Owner:TControl; Application : TApplication);
begin
  inherited Create(Owner);  //Note: Owner should be a descendant of TControl;  
  FApplication := Application;
  FOrigAppOnMessage := Application.OnMessage;
  OnBlur := HandleBlur;
  AllowNextBlur := false;  
  KeyStruck := false;
  NextControl := nil;
  PrevControl := nil;  
end;

destructor THtmlObj.Destroy;
begin
  SetMsgActive(false); //Turns off local OnMessage handling
  inherited Destroy;
end;

procedure THtmlObj.SetMsgActive (Active : boolean);
//NOTE: This object grabs the OnMessage for the entire application, so that 
//      it can intercept the right-click.  As a result, the object needs a
//      way that it can turn off this feature when it is covered up by other
//      windows application subwindows etc.  This function provides this.
begin
  FActive := Active;
  ReassignKeyboardHandler(FActive);
end;

procedure THtmlObj.SetHTMLText(Html : String); 
var //V : OleVariant;
    V2 : variant;
    body : IHTMLElement;
    status : string;
    temp : string;
begin
  DocumentHTML := Html;
  exit; //kt
  (*
  try
    Stop;
    if Doc =nil then exit;
    body := Doc.body;

    if UpperCase(Doc.designMode) <> 'ON' then begin
      Doc.designMode := 'on';
      repeat  //NOTE: potential endless loop.  Perhaps loop only status='loading'?
        status := Doc.readyState;
        {Possible status values:
          uninitialized	-- Object is not initialized with data.
          loading	      -- Object is loading its data.
          loaded	      -- Object has finished loading its data.
          interactive	  -- User can interact with the object even though it is not fully loaded.
          complete	    -- Object is completely initialized.                                      }      
        if status <> 'complete' then FApplication.ProcessMessages;
      until (status = 'complete') or (status='interactive') or (status='loaded');
    end;  
    body := Doc.body;
    if (body = nil) then begin   //Do so stuff to get IE to make a 'body'.
      V2 := VarArrayCreate([0, 0], VarVariant);
      V2[0] := ' ';  //Html;
      Doc.Write(PSafeArray(System.TVarData(V2).VArray));
      body := Doc.body;
      Doc.close;    
      repeat  
        status := Doc.readyState; //For possible status values, see above) 
        if status <> 'complete' then FApplication.ProcessMessages;
      until (status = 'complete') or (status='interactive') or (status='loaded');
      body := Doc.body;
    end;  
    body.innerHTML := Html;
    temp := body.innerHTML;  //to test if it was set or not...
    Modified:=true;
  except
    on E:Exception do EError('Error setting HTML text',E);
  end;  
  *)
end;
  

function THtmlObj.GetHTMLText:string;
var WS:WideString;
    ch:WideChar;
    n:integer;
    w:word;
    s:string;
begin
  //Result:=DocumentHTML;
  Result:='';
  if Doc=nil then exit;
  WS:=Doc.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 THtmlObj.GetText:string;
var WS:WideString;
    ch:WideChar;
    n:integer;
    w:word;
    s:string;
begin
  Result:='';
  if DOC=nil then exit;
  WS:=Doc.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 THtmlObj.SetText(HTML:string);
begin
  if (DOC=nil)or(DOC.body=nil) then SetHTMLText(HTML)
  else DOC.body.innerHTML:=HTML;
end;

procedure THtmlObj.Clear;
begin
  //kt if IsDirty then
    NewDocument;
    KeyStruck := false;
  //SetHTMLText('');
end;

function THtmlObj.GetEditableState : boolean;
var mode : string;
begin
  mode := Doc.designMode;
  result := (mode = 'On');
end;

procedure THtmlObj.SetEditableState(EditOn : boolean);
var LastMode : string;
    count : integer;
begin
  LastMode := 'Inherit';
  try
    count := 0;
    repeat
      inc (count);
      if Doc = nil then begin
        FApplication.ProcessMessages;
        Sleep (100);
        continue;
      end else if Doc.body = nil then begin
        FApplication.ProcessMessages;
        Sleep (100);
        continue;
      end;  
      if EditOn then begin
        Doc.body.setAttribute('contentEditable','true',0);
        Doc.designMode := 'On';  //kt
        FEditable:=true;
        //SetFocus;
      end else begin
        Doc.body.setAttribute('contentEditable','false',0);
        Doc.designMode := 'Off';  //kt
        FEditable:=false;
      end;  
      LastMode := Doc.designMode;
    until (LastMode <> 'Inherit') or (count > 20);  
  except
    on E:Exception do EError('Error switching into HTML editing state',E);
  end;
end;

procedure THtmlObj.SetBackgroundColor(Color:TColor);
begin
  if Doc=nil then exit;
  //WaitLoad(true); //kt  
  WaitForDocComplete;
  if Doc.body=nil then exit;
  Doc.body.style.backgroundColor := ColorToMSHTMLStr(Color);
end;

function  THtmlObj.GetBackgroundColor : TColor;       
begin
  Result := clBlack; //default;
  if Doc=nil then exit;
  if Doc.body=nil then exit;
  Result := MSHTMLStrToColor(Doc.body.style.backgroundColor);
end;

function THtmlObj.ColorToMSHTMLStr(color : TColor) : string; 
//Note: TColor stores colors lo-byte --> hi-byte as RGB
//Function returns '#RRGGBB'
var tempColor : TMGColor;        
begin
  tempColor.Color := color;
  Result := '#'+
            IntToHex(tempColor.RGBColor.R,2)+  
            IntToHex(tempColor.RGBColor.G,2)+
            IntToHex(tempColor.RGBColor.B,2);
end;

function THtmlObj.MSHTMLStrToColor(MSHTMLColor : string) : TColor;
//Function converts '#RRGGBB' -- TColor
//Note: TColor stores colors lo-byte --> hi-byte as RGB
var tempColor : TMGColor;            
    strHexRed,strHexGreen,strHexBlue : string[2];
begin
  Result := clBlack;  //FIX!!!! IMPLEMENT LATER...
  if Pos('#',MSHTMLColor)=1 then begin
   // MSHTMLColor := MidStr(MSHTMLColor,2,99);
   strHexRed := MidStr(MSHTMLColor,2,2);
   strHexGreen := MidStr(MSHTMLColor,4,2);
   strHexBlue := MidStr(MSHTMLColor,6,2);
   tempColor.RGBColor.R := StrToIntDef('$'+StrHexRed,0);
   tempColor.RGBColor.G := StrToIntDef('$'+StrHexGreen,0);
   tempColor.RGBColor.B := StrToIntDef('$'+StrHexBlue,0);
   Result := tempColor.Color;
   //NOTE: This function has not yet been tested....
  end;
end;

procedure THtmlObj.ToggleBullet;
begin
  if DOC=nil then exit;
  //SpecialCommand(IDM_UnORDERLIST,false,true,false,Null);
  DOC.execCommand('InsertUnorderedList',false,null);  
  Modified:=true;
end;

procedure THtmlObj.ToggleItalic;
begin
  if DOC=nil then exit;
  DOC.execCommand('Italic',false,null);  
  Modified:=true;
end;

procedure THtmlObj.ToggleBold;
begin
  if DOC=nil then exit;
  DOC.execCommand('Bold',false,null);
  Modified:=true;
end;

procedure THtmlObj.ToggleNumbering;
begin
  if DOC=nil then exit;
  DOC.execCommand('InsertOrderedList',false,null);
//  SpecialCommand(IDM_ORDERLIST,false,true,false,Null);
  Modified:=true;
end;

procedure THtmlObj.ToggleUnderline;
begin
   if DOC=nil then exit;
   DOC.execCommand('Underline',false,null);
  Modified:=true;
end;

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

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


procedure THtmlObj.Indent;
begin
  if DOC=nil then exit;
  DOC.ExecCommand('Indent',false,0);
  Modified:=true;
end;

procedure THtmlObj.Outdent;
begin
  if DOC=nil then exit;
  DOC.ExecCommand('Outdent',false,0);
  Modified:=true;
end;


procedure THtmlObj.AlignLeft;
begin
  if DOC=nil then exit;
  DOC.ExecCommand('JustifyLeft',false,0);
  Modified:=true;
end;

procedure THtmlObj.AlignRight;
begin
  if DOC=nil then exit;
  DOC.ExecCommand('JustifyRight',false,0);
  Modified:=true;
end;

procedure THtmlObj.AlignCenter;
begin
  if DOC=nil then exit;
  DOC.ExecCommand('JustifyCenter',false,0);
  Modified:=true;
end;

procedure THtmlObj.TextForeColorDialog;
begin
  if ColorDialog = nil then begin
    ColorDialog := TColorDialog.Create(self);
  end;
  if ColorDialog.Execute then begin
    SetTextForegroundColor(ColorDialog.Color);
  end;  
  Modified:=true;
end;

procedure THtmlObj.TextBackColorDialog;
begin
  if ColorDialog = nil then begin
    ColorDialog := TColorDialog.Create(self);
  end;
  if ColorDialog.Execute then begin
    SetTextBackgroundColor(ColorDialog.Color);
  end;  
  Modified:=true;
end;

procedure THtmlObj.SetTextForegroundColor(Color:TColor);
begin
  if DOC=nil then exit;
  DOC.ExecCommand('ForeColor',false,Color);
  Modified:=true;
end;

function THtmlObj.GetTextForegroundColor:TColor;
var Background :  OleVariant;
    vt         :  TVarType;
begin
  Result:=clWindow;
  try
    if DOC=nil then exit;
    Background:=DOC.queryCommandValue('ForeColor');
    vt:=varType(Background);
    if vt<>varNull then Result:=Background;
  except
    on E:Exception do EError('Error retrieving foreground color',E);
  end;
end;

procedure THtmlObj.SetTextBackgroundColor(Color:TColor);
begin
  if DOC=nil then exit;
  DOC.ExecCommand('BackColor',false,Color);
  Modified:=true;
end;

function THtmlObj.GetTextBackgroundColor:TColor;
var Background :  OleVariant;
    vt         :  TVarType;
begin
  Result:=clWindow;
  try
    if DOC=nil then exit;
    Background:=DOC.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 THtmlObj.FontDialog;
begin
  DoCommand(IDM_FONT);
  Modified:=true;
end;

function THtmlObj.GetFontSize : integer;
var FontSize : OleVariant;
    vt       : TVarType;
    
begin
  FontSize:=Doc.queryCommandValue('FontSize');
  vt:=varType(FontSize);
  if vt<>varNull then Result := FontSize*FontScale
  else Result :=12*FontScale; //kt
end;

procedure THtmlObj.SetFontSize (Size : integer);
begin
  if Doc=nil then exit;
  Doc.ExecCommand('FontSize', false, Size div FontScale);
end;

function THtmlObj.GetFontName : string;
var FontName :OleVariant;
    vt : TVarType;
begin
  if DOC=nil then exit;
  FontName:=DOC.queryCommandValue('FontName');
  vt:=varType(FontName);
  if vt<>varNull then Result := FontName
  else Result :='Times New Roman'; //kt
end;

procedure THtmlObj.SetFontName (Name : string);
begin
  if DOC=nil then exit;
  DOC.ExecCommand('FontName', false, Name);
end;

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

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

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

function THtmlObj.GetTextRange:IHtmlTxtRange;
begin
  Result:=nil;
  try
    if DOC=nil then exit;
    while DOC.body=nil do begin
      //WaitLoad(true); //kt  
      WaitForDocComplete;
      if DOC.body=nil then begin
        if MessageDlg('Wait for document loading?',mtConfirmation,
                      [mbOK,mbCancel],0) <> mrOK then begin
          exit;
        end;  
      end;  
    end;
    if (DOC.Selection.type_='Text') or (DOC.Selection.type_='None') then begin
      Result:=DOC.Selection.CreateRange as IHtmlTxtRange;
    end;  
  except
    on E:Exception do EError('This type of selection cannot be processed',E);
  end;
end;

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

procedure THtmlObj.SetSelText (HTMLText : string);
begin
  ReplaceSelection(HTMLText);
end;

procedure THtmlObj.ReplaceSelection(HTML:string);
var TextRange:IHtmlTxtRange;
begin
  try
    TextRange:=GetTextRange;
    if TextRange=nil then exit;
    TextRange.PasteHTML(HTML); 
    Modified:=true;
  except
    on E:Exception do begin
      // implement later... ShortenString(HTML,80);
      EError('Error pasting HTML'+nl+
             'Microsoft HTML refuses to paste this string:'+nl+
             HTML+nl,E);
    end;
  end;
end;


function THtmlObj.MoveCaretToEnd : boolean;
//kt added
var //TextRange:IHtmlTxtRange;
    count : integer;
begin
  if not assigned (FTMGDisplayPointer) then begin
    Result := false;
    exit;
  end;
  Result:=(S_OK = FTMGDisplayPointer.MoveUnit(DISPLAY_MOVEUNIT_BottomOfWindow,0));
  count := 0;
  repeat
    Result:=(S_OK = FTMGDisplayPointer.MoveUnit(DISPLAY_MOVEUNIT_NextLine,-1));
    inc (count);
  until (Result = false) or (count > 500);
  Result:=(S_OK = FTMGDisplayPointer.MoveUnit(DISPLAY_MOVEUNIT_CurrentLineEnd,0));
  Result:=(S_OK = FCaret.MoveCaretToPointer(FTMGDisplayPointer,
                                            integer(FALSE),
                                            CARET_DIRECTION_SAME));
  {
  SendMessage(FmsHTMLwinHandle, WM_KEYDOWN, VK_END, 0);
  SendMessage(FmsHTMLwinHandle, WM_KEYUP, VK_END, 0);
  SendMessage(FmsHTMLwinHandle, WM_KEYDOWN, VK_END, 0);
  SendMessage(FmsHTMLwinHandle, WM_KEYUP, VK_END, 0);
  }
end;

function THtmlObj.MoveCaretToPos(ScreenPos: TPoint) : HRESULT;
//kt added entire function
var  OutTemp : DWORD;
begin
  if not assigned (FTMGDisplayPointer) then exit;
  FTMGDisplayPointer.moveToPoint(ScreenPos, COORD_SYSTEM_GLOBAL, nil, HT_OPT_AllowAfterEOL, OutTemp);
  Result := FCaret.MoveCaretToPointer(FTMGDisplayPointer,Integer(True),CARET_DIRECTION_INDETERMINATE);
  FCaret.Show(Integer(True));
end;

procedure THtmlObj.InsertHTMLAtCaret(HTMLText : AnsiString);
var
   Range: IHTMLTxtRange;
begin
   Range:= Self.GetTextRange;
   Range.pasteHTML(HTMLText);
end;

procedure THtmlObj.InsertTextAtCaret(Text : AnsiString);
//kt added.  Note: inserts external format (not HTML markup)
var P : PWideChar;
begin
  P := StringToOleStr(Text);
  FCaret.InsertText(P,Length(Text))
end;


procedure THtmlObj.Loaded; 
begin
  inherited Loaded;
end;

function THtmlObj.GetTextLen : integer;
begin
  Result := Length(GetText);
end;    


procedure THtmlObj.ReassignKeyboardHandler(TurnOn : boolean);
{assign HTML keyboard handler to HTML component; restore standard if TurnOn=false}
begin
  if TurnOn then begin
    FApplication.OnMessage := GlobalMsgHandler; 
  end else begin
    FApplication.OnMessage := FOrigAppOnMessage;
  end;      
end;

procedure THtmlObj.GlobalMsgHandler(var Msg: TMsg; var Handled: Boolean);
{NOTE: This message handler will receive ALL messages directed to CPRS.  I
       have to do this, because something is filtering messages before they
       get to this THTMLObj object.  My goal is to do as little here as possible,
       and let the OnMessage for THTMLObj (found in EmbeddedED) take care of the rest.
 NOTE: This should get activated by OnFocus for object, and deactivated 
       by OnBlur, so it actually should only get messages when focused.   }       
var 
  i : Integer;
  NewMsg : TMessage;
  
  function TransformMessage (WinMsg : TMsg) : TMessage;
  begin
    Result.Msg := WinMsg.message;
    Result.WParam := WinMsg.wParam;
    Result.LParam := WinMsg.lParam;
    Result.Result := 0;
  end;
  
begin
  Handled:=false; //default to not handled  
  if (Msg.Message=WM_KEYDOWN) then begin
    if (Msg.WParam=VK_UP) or (Msg.WParam=VK_DOWN) or (Msg.WParam=VK_TAB) then begin
        NewMsg := TransformMessage(Msg);
        SubMessageHandler(NewMsg);               
        Handled := (NewMsg.Result = 1);
    end; 
  end; 
end;


procedure THtmlObj.SubMessageHandler(var Msg: TMessage);
//Called from parent's EDMessageHandler, or from GlobalMsgHandler
var  i : Integer;
     WinControl : TWinControl;

begin
  Msg.Result := 0; //default to not handled  
  if not ((Msg.Msg=WM_KEYDOWN) or
          (Msg.Msg=WM_KEYUP) or
          (Msg.Msg=WM_RBUTTONUP) ) then exit;  //Speedy exit of non-handled messages
  case Msg.Msg of
    WM_RBUTTONUP : begin
                     if CtrlToBeProcessed then begin
                       CtrlToBeProcessed := false;                   
                       exit; //Ctrl-right click is ignored
                     end;  
                     if assigned(PopupMenu) then PopupMenu.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);
                     Msg.Result := 1; //Handled
                     exit;
                   end;
    WM_KEYDOWN :   begin
                     GetSystemTimeAsFileTime(KeyPressTime);
                     KeyStruck := true;
                     //beep(200,50);
                     case Msg.WParam of
                       VK_ESCAPE  : begin
                                      if Assigned(PrevControl) then begin
                                        AllowNextBlur := true;
                                        PrevControl.SetFocus;
                                      end;  
                                    end; 
                       VK_CONTROL : begin
                                      CtrlToBeProcessed:=true;
                                      Msg.Result := 1; //Handled
                                      exit;
                                    end;
                       VK_SHIFT :   begin
                                      ShiftToBeProcessed:=true;
                                      Msg.Result := 1; //Handled
                                      exit;
                                    end;
                       VK_TAB :     begin
                                      if (ShiftToBeProcessed and CtrlToBeProcessed) then begin
                                        //This isn't working for some reason...
                                        for i := 0 to 5 do begin
                                          PostMessage(FmsHTMLwinHandle, WM_KEYDOWN, VK_LEFT, 0);
                                        end;  
                                        ShiftToBeProcessed := false;
                                        CtrlToBeProcessed := false;
                                      end else if ShiftToBeProcessed then begin 
                                        if Assigned(PrevControl) then begin
                                          AllowNextBlur := true;
                                          PrevControl.SetFocus;
                                        end;  
                                        ShiftToBeProcessed := false;
                                      end else if CtrlToBeProcessed then begin 
                                        if Assigned(NextControl) then begin
                                          AllowNextBlur := true;
                                          NextControl.SetFocus;
                                        end;  
                                        CtrltoBeProcessed := false;
                                      end else begin
                                        for i := 0 to 5 do begin
                                          PostMessage(FmsHTMLwinHandle, WM_KEYDOWN, VK_SPACE, 0);
                                        end;  
                                      end;  
                                      Msg.Result := 1; //Handled
                                    end;
                       {             
                       VK_RETURN :  if CtrlReturnToBeProcessed then begin 
                                      Msg.Result := 1; //Handled
                                      CtrlReturnToBeProcessed := false;
                                    end else if CtrlToBeProcessed then begin
                                      Msg.Result := 1; //Handled
                                      CtrlToBeProcessed := False; 
                                      CtrlReturnToBeProcessed := true;
                                      //PostMessage(Msg.hwnd, WM_KEYUP, VK_CONTROL, 0);                                      
                                    end else if ShiftToBeProcessed=false then begin
                                      //kt if not FEditable then exit;
                                      keybd_event(VK_SHIFT,0,0,0);
                                      keybd_event(VK_RETURN,0,0,0);
                                      keybd_event(VK_SHIFT,0,KEYEVENTF_KEYUP,0);
                                      Msg.Result := 1; //Handled
                                    end;
                       }             
                       Ord('B') :  if CtrlToBeProcessed then begin
                                     //kt if not FEditable then exit;
                                     ToggleBold;
                                     Msg.Result := 1; //Handled
                                     exit;
                                   end;  
                       Ord('U') :  if CtrlToBeProcessed then begin
                                     //kt if not FEditable then exit;
                                     ToggleUnderline;
                                     Msg.Result := 1; //Handled
                                     exit;
                                   end;  
                       Ord('I') :  if CtrlToBeProcessed then begin
                                     //kt if not FEditable then exit;
                                     ToggleItalic;
                                     Msg.Result := 1; //Handled
                                   end;  
                     end; {case}
                   end;
    WM_KEYUP :     begin
                     case Msg.WParam of
                       VK_CONTROL : begin
                                      CtrlToBeProcessed:=false;
                                      Msg.Result := 1; //Handled
                                      if CtrlReturnToBeProcessed then begin
                                        PostMessage(FmsHTMLwinHandle, WM_KEYDOWN, VK_RETURN, 0);
                                      end;                                      
                                      exit;
                                    end;
                       VK_SHIFT :   begin
                                      ShiftToBeProcessed:=false;
                                      Msg.Result := 1; //Handled
                                      exit;
                                   end;
                                   
                     end; {case}
                     exit;
                   end;    
  end;  {case}
end;

procedure THtmlObj.HandleBlur(Sender: TObject);
//kt added function
  function RecentKeyPressed : boolean;
  var NowTime : FILETIME; //kt 
      KeyTime,NowTime2 : LARGE_INTEGER;
      Delta : int64;
  begin
    GetSystemTimeAsFileTime(NowTime); 
    NowTime2.LowPart := NowTime.dwLowDateTime;
    NowTime2.HighPart := NowTime.dwHighDateTime;
    KeyTime.LowPart := KeyPressTime.dwLowDateTime;
    KeyTime.HighPart := KeyPressTime.dwHighDateTime;
    Delta := floor( (NowTime2.QuadPart - KeyTime.QuadPart) / 100000);
    Result := (Delta < 100) and (Delta > 0);
  end;

begin
  //kt Handle loss of focus when attempting to cursor above top line, or below bottom line.
  if (not AllowNextBlur) and RecentKeyPressed then begin   //kt entire block
    SetFocusToDoc;
    //beep(880,100);
    KeyPressTime.dwLowDateTime := 0;
    KeyPressTime.dwHighDateTime := 0;
    exit; 
  end;
  AllowNextBlur := false;
  SetMsgActive(false);
end;

function THtmlObj.SubFocusHandler(fGotFocus: BOOL): HResult; 
begin
  SetMsgActive(fGotFocus);
end;

function THtmlObj.GetActive : boolean;
begin
  Result := TWinControl(Owner).Visible;
end;


initialization

finalization

end.