web.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

     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.