htmlview.pas

来自「查看html文件的控件」· PAS 代码 · 共 1,969 行 · 第 1/5 页

          and InText and (NextCursor <> HandCursor) then
  NextCursor := Cursor;

PaintPanel.Cursor := NextCursor;

if ((NextCursor = HandCursor) or (SectionList.ActiveImage <> Nil)) then
  HTMLTimer.Enabled := True
else HTMLTimer.Enabled := False;

if (URL <> FURL) or (Target <> FTarget) then
  begin
  FURL := URL;
  FTarget := Target;
  if Assigned(FOnHotSpotCovered) then FOnHotSpotCovered(Self, URL);
  end;
if (ssLeft in Shift) and not MouseScrolling
       and ((Y <= 0) or (Y >= Self.Height)) then
  begin
  MouseScrolling := True;
  PostMessage(Handle, wm_MouseScroll, 0, 0);
  end;
if (ssLeft in Shift) and not FNoSelect then
  DoHilite(X, Y);
end;

procedure ThtmlViewer.HTMLMouseUp(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
var
  UrlTarget: TUrlTarget;
  FormControl: TImageFormControlObj;
  Obj: TObject;
  IX, IY: integer;
  InImage, TmpLeft: boolean;  
  Parameters: TRightClickParameters;
  AWord: WideString;
  St, En: integer;
  guResult: guResultType;
  I, ThisID: integer;
  ParentForm: TCustomForm;  
begin
if MiddleScrollOn then
  begin
  {cancel unless it's middle button and has moved}
  if (Button <> mbMiddle) or (Y <> MiddleY) then
    begin
    MiddleScrollOn := False;
    PaintPanel.Cursor := Cursor;
    end;
  Exit;
  end;

inherited MouseUp(Button, Shift, X, Y);

if Assigned(FOnImageClick) or Assigned(FOnRightClick) then
  begin
  InImage := FSectionList.PtInObject(X, Y+FSectionList.YOff, Obj, IX, IY);
  if Assigned(FOnImageClick) and InImage then
    FOnImageClick(Self, Obj, Button, Shift, IX, IY);
  if (Button = mbRight) and Assigned(FOnRightClick) then
    begin
    Parameters := TRightClickParameters.Create;
    try
      if InImage then
        begin
        Parameters.Image := Obj as TImageObj;
        Parameters.ImageX := IX;
        Parameters.ImageY := IY;
        end;
      if guUrl in GetURL(X, Y, UrlTarget, FormControl, FTitleAttr) then
        begin
        Parameters.URL := UrlTarget.Url;
        Parameters.Target := UrlTarget.Target;
        UrlTarget.Free;
        end;
      if GetWordAtCursor(X, Y, St, En, AWord) then
        Parameters.ClickWord := AWord;
      HTMLTimer.Enabled := False;
      FOnRightClick(Self, Parameters);
    finally
      HTMLTimer.Enabled := True;   
      Parameters.Free;
      end;
    end;
  end;

if (Button = mbLeft) and not (ssShift in Shift) then  
  begin
  MouseScrolling := False;
  DoHilite(X, Y);
  Hiliting := False;
  FSectionList.LButtonDown(False);
  TmpLeft := LeftButtonDown;
  LeftButtonDown := False;
  if TmpLeft and (FSectionList.SelE <= FSectionList.SelB) then
    begin
    guResult := GetURL(X, Y, UrlTarget, FormControl, FTitleAttr);
    if guControl in guResult then
      FormControl.ImageClick(Nil)   
    else if guUrl in guResult then
      begin
      FURL := UrlTarget.Url;
      FTarget := UrlTarget.Target;
      FLinkAttributes.Text := UrlTarget.Attr;  
      FLinkText := GetTextByIndices(UrlTarget.Start, UrlTarget.Last);   
      ThisID := UrlTarget.ID;
      for I := 0 to LinkList.Count-1 do  
        with TFontObj(LinkList.Items[I]) do
          if (ThisID = UrlTarget.ID) and Assigned(TabControl) then
            begin
            ParentForm := GetParentForm(TabControl);    
            if Assigned(ParentForm) and TabControl.CanFocus then
              begin
              NoJump := True;    {keep doc from jumping position on mouse click}
              try
                ParentForm.ActiveControl := TabControl;
              finally
                NoJump := False;
                end;
              end;
            break;
            end;
      UrlTarget.Free;
      HotSpotAction := True;   {prevent double click action}
      URLAction;
      {Note:  Self pointer may not be valid after URLAction call (TFrameViewer, HistoryMaxCount=0)}
      end;
    end;
  end;
end;

{----------------ThtmlViewer.HTMLMouseWheel}
{$ifdef ver120_plus}
procedure ThtmlViewer.HTMLMouseWheel(Sender: TObject; Shift: TShiftState;   
      WheelDelta: Integer; MousePos: TPoint);
var
  Lines: integer;
begin
Lines := Mouse.WheelScrollLines;
if Lines > 0 then
  if WheelDelta > 0 then
     VScrollBarPosition := VScrollBarPosition - (Lines * 16)
  else
     VScrollBarPosition := VScrollBarPosition + (Lines * 16)
else VScrollBarPosition := VScrollBarPosition - WheelDelta div 2;
end;

function ThtmlViewer.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;   
                                         MousePos: TPoint): Boolean;
begin
result:= inherited DoMouseWheel(shift, wheelDelta, mousePos);
if not result and not (htNoWheelMouse in htOptions) then   
  begin
  HTMLMouseWheel(Self, Shift, WheelDelta, MousePos);
  Result := True;
  end;
end;
{$endif}

 {----------------ThtmlViewer.XYToDisplayPos}
function ThtmlViewer.XYToDisplayPos(X, Y: integer): integer;
var
  InText: boolean;
  XR, YR, CaretHt: integer;
begin
with SectionList do
  Result := FindCursor(PaintPanel.Canvas, X, Y+YOff, XR, YR, CaretHt, InText);
if not InText then
  Result := -1;
end;

{----------------ThtmlViewer.GetCharAtPos}
function ThtmlViewer.GetCharAtPos(Pos: integer; var Ch: WideChar;
             var Font: TFont): boolean;   
var
  Obj: TObject;
  FO: TFontObj;
  Index: integer;
begin
Result := FSectionList.GetChAtPos(Pos, Ch, Obj);
if Result and (Obj is TSection) then
  with TSection(Obj) do
    begin
    FO := Fonts.GetFontObjAt(Pos-StartCurs, Index);
    Font := FO.TheFont;
    end;
end;

{----------------ThtmlViewer.GetWordAtCursor}
function ThtmlViewer.GetWordAtCursor(X, Y: integer; var St, En: integer; var AWord: WideString): boolean;
var
  XR, X1, CaretHt: integer;
  YR, Y1: integer;
  Obj: TObject;
  Ch: WideChar;
  InText: boolean;
  Tmp: WideString;

  function AlphaNum(Ch: WideChar): boolean;
  begin
  Result := (Ch in [WideChar('a')..WideChar('z'), WideChar('A')..WideChar('Z'), WideChar('0')..WideChar('9')]) 
             or (Ch >= #192);
  end;

  function GetCh(Pos: integer): WideChar;
  var
    Ch: WideChar;
    Obj1: TObject;
  begin
  Result := ' ';
  if not FSectionList.GetChAtPos(Pos, Ch, Obj1) or (Obj1 <> Obj) then Exit;
  Result := Ch;
  end;

begin
Result := False;
AWord := '';
with FSectionList do
  begin
  InText := False;   
  CaretPos := FindCursor(PaintPanel.Canvas, X,
         Y+YOff, XR, YR, CaretHt, InText);
  CursorToXy(PaintPanel.Canvas, CaretPos, X1, Y1);
  if InText then   {else cursor is past end of row}
    begin
    en := CaretPos;
    st := en-1;
    if GetChAtPos(en, Ch, Obj) and AlphaNum(Ch)  then
      begin
      AWord := Ch;
      Result := True;
      Inc(en);
      Ch := GetCh(en);
      while AlphaNum(Ch) do
        begin
        Tmp := Ch;     {Delphi 3 needs this nonsense}
        AWord := AWord + Tmp;
        Inc(en);
        Ch := GetCh(en);
        end;
      if St >= 0 then
        begin
        Ch := GetCh(st);
        while (st >= 0) and AlphaNum(Ch) do
          begin
          System.Insert(Ch, AWord, 1);
          Dec(st);
          if St >= 0 then
            Ch := GetCh(St);
          end;
        end;
      end;
    end;
  end;
end;

{----------------ThtmlViewer.HTMLMouseDblClk}
procedure ThtmlViewer.HTMLMouseDblClk(Message: TWMMouse);
var
  st, en: integer;
  AWord: WideString;
begin
FSectionList.LButtonDown(True);   
if FProcessing or HotSpotAction then Exit;  
if not FNoSelect and GetWordAtCursor(Message.XPos, Message.YPos, St, En, AWord) then
  begin
  FSectionList.SelB := st+1;
  FSectionList.SelE := en;
  FCaretPos := st+1;
  InvalidateRect(PaintPanel.Handle, Nil, True);
  end;
if Assigned(FOnMouseDouble) then
  with Message do
    FOnMouseDouble(Self, mbLeft, KeysToShiftState(Keys), XPos, YPos);
end;

procedure ThtmlViewer.DoHilite(X, Y: integer);
var
  Curs, YR, YWin: integer;
  XR, CaretHt: integer;
  InText: boolean;
begin
if Hiliting and (Sel1 >= 0) then
  with FSectionList do
    begin
    YWin := IntMin(IntMax(0, Y), Height);
    Curs := FindCursor(PaintPanel.Canvas, X, YWin+YOff, XR, YR, CaretHt, InText);
    if (Curs >= 0) and not FNoSelect then
      begin
      if Curs > Sel1 then
        begin
        SelE := Curs;
        SelB := Sel1;
        end
      else
        begin
        SelB := Curs;
        SelE := Sel1;
        end;
      InvalidateRect(PaintPanel.Handle, Nil, True);
      end;
    CaretPos := Curs;
    end;
end;

{----------------ThtmlViewer.WMMouseScroll}
procedure ThtmlViewer.WMMouseScroll(var Message: TMessage);
const
  Ticks: DWord = 0;
var
  Pos: integer;
  Pt: TPoint;
begin
GetCursorPos(Pt);
Ticks := 0;
with VScrollBar do
  begin
  Pt := PaintPanel.ScreenToClient(Pt);
  while MouseScrolling and (LeftButtonDown and((Pt.Y <= 0) or (Pt.Y > Self.Height)))
                  or (MiddleScrollOn and (Abs(Pt.Y - MiddleY) > ScrollGap)) do     
    begin
    if GetTickCount > Ticks +100 then
      begin
      Ticks := GetTickCount;
      Pos := Position;
      if LeftButtonDown then
        begin
        if Pt.Y < -15 then
          Pos := Position - SmallChange * 8
        else if Pt.Y <= 0 then
          Pos := Position - SmallChange
        else if Pt.Y > Self.Height+15 then
          Pos := Position + SmallChange * 8
        else
          Pos := Position + SmallChange;
        end
      else
        begin   {MiddleScrollOn}    
        if Pt.Y-MiddleY < -3*ScrollGap then
          Pos := Position - 32
        else if Pt.Y-MiddleY < -ScrollGap then
          Pos := Position - 8
        else if Pt.Y-MiddleY > 3*ScrollGap then
          Pos := Position + 32
        else if Pt.Y-MiddleY > ScrollGap then
          Pos := Position + 8;
        if Pos < Position then
          PaintPanel.Cursor := UpOnlyCursor
        else if Pos > Position then
          PaintPanel.Cursor := DownOnlyCursor;
        end;
      Pos := IntMax(0, IntMin(Pos, FMaxVertical - PaintPanel.Height));
      FSectionList.SetYOffset(Pos);
      SetPosition(Pos);
      DoHilite(Pt.X, Pt.Y);
      PaintPanel.Invalidate;
      GetCursorPos(Pt);
      Pt := PaintPanel.ScreenToClient(Pt);
      end;
    Application.ProcessMessages;
    Application.ProcessMessages;    
    Application.ProcessMessages;
    Application.ProcessMessages;
    end;
  end;
MouseScrolling := False;
if MiddleScrollOn then
  PaintPanel.Cursor := UpDownCursor;  
end;

function ThtmlViewer.PositionTo(Dest: string): boolean;
var
  I: integer;
  Obj: TObject;
begin
Result := False;
If Dest = '' then Exit;
if Dest[1] = '#' then
  System.Delete(Dest, 1, 1);
I := FNameList.IndexOf(UpperCase(Dest));
if I > -1 then
  begin
  Obj := FNameList.Objects[I];
  if (Obj is TIDObject) then
     ScrollTo(TIDObject(Obj).YPosition); 

  HScrollBar.Position := 0;
  Result := True;
  AddVisitedLink(FCurrentFile+'#'+Dest);   
  end;
end;

function ThtmlViewer.GetURL(X, Y: integer; var UrlTarg: TUrlTarget;
          var FormControl: TImageFormControlObj; var ATitle: string): guR