htmlview.pas

查看html文件的控件

HandleNeeded;
try
  DontDraw := True;
  if FBorderStyle = htNone then WFactor := 0
    else WFactor := 2;
  Wid := Width - WFactor;
  if FScrollBars in [ssBoth, ssVertical] then
    begin
    if not (htShowVScroll in FOptions) and (Length(FDocumentSource) < 10000) then   
      begin   {see if there is a vertical scrollbar with full width}
      FMaxVertical := FSectionListDoLogic(Wid);
      if HasVScrollBar then {yes, there is vertical scrollbar, allow for it}
        begin
        FMaxVertical := FSectionListDoLogic(Wid-sbWidth);
        if not HasVScrollBar1 then
          FMaxVertical := FSectionListDoLogic(Wid);
        end;
      end
    else {assume a vertical scrollbar}
      FMaxVertical := FSectionListDoLogic(Wid-sbWidth);
    end
  else {there is no vertical scrollbar}
    FMaxVertical := FSectionListDoLogic(Wid);

  DoScrollbars;
  if Cursor = crIBeam then
    Cursor := ThickIBeamCursor;   
finally
  DontDraw := False;
  end;
end;

procedure ThtmlViewer.HTMLPaint(Sender: TObject);
var
  ARect: TRect;
begin
if not DontDraw then
  begin
  ARect := Rect(0, 1, PaintPanel.Width, PaintPanel.Height);
  FSectionList.Draw(PaintPanel.Canvas2, ARect, MaxHScroll,
                         -HScrollBar.Position, 0, 0, 0);
  end;
end;

procedure ThtmlViewer.WMSize(var Message: TWMSize);
begin
inherited;
if InCreate then    
  Exit;
if not FProcessing then
  Layout
else
  DoScrollBars;
if FMaxVertical < PaintPanel.Height then
  Position := 0
else ScrollTo(VScrollBar.Position);   {keep aligned to limits}
with HScrollBar do
  Position := IntMin(Position, Max - PaintPanel.Width);
end;

procedure ThtmlViewer.Scroll(Sender: TObject; ScrollCode: TScrollCode;
       var ScrollPos: Integer);
{only the horizontal scrollbar comes here}
begin  
ScrollPos := IntMin(ScrollPos, HScrollBar.Max - PaintPanel.Width);
PaintPanel.Invalidate;
end;

procedure ThtmlViewer.ScrollTo(Y: integer);
begin
Y := IntMin(Y, FMaxVertical - PaintPanel.Height);
Y := IntMax(Y, 0);
VScrollBar.Position := Y;
FSectionList.SetYOffset(Y);
Invalidate;
end;

procedure ThtmlViewer.Layout;
var
  OldPos: integer;
begin
if FProcessing then Exit;
SetProcessing(True);
try
  OldPos := Position;
  FSectionList.ProgressStart := 0;   
  htProgressInit;
  DoLogic;
  Position := OldPos;   {return to old position after width change}
finally
  htProgressEnd;     
  SetProcessing(False);
  end;
end;

function ThtmlViewer.HotSpotClickHandled: boolean;
var
  Handled: boolean;
begin
Handled := False;
if Assigned(FOnHotSpotClick) then
  FOnHotSpotClick(Self, URL, Handled);
Result := Handled;
end;

procedure ThtmlViewer.TriggerUrlAction;  
begin
PostMessage(Handle, wm_UrlAction, 0, 0);
end;

procedure ThtmlViewer.WMUrlAction(var Message: TMessage); 
begin
UrlAction;
end;

procedure ThtmlViewer.URLAction;
var
  S, Dest: string;
  Ext: string[5];
  I: integer;
  OldPos: integer;

begin
if not HotSpotClickHandled then
  begin
  OldPos := Position;
  S := URL;
  I := Pos('#', S);  {# indicates a position within the document}
  if I = 1 then
    begin
    if PositionTo(S) then    {no filename with this one}
      begin
      BumpHistory(FCurrentFile, FTitle, OldPos, Nil, FCurrentFileType);   
      AddVisitedLink(FCurrentFile+S);    
      end;
    end
  else
    begin
    if I >= 1 then
      begin
      Dest := System.Copy(S, I, Length(S)-I+1);  {local destination}   
      S := System.Copy(S, 1, I-1);     {the file name}
      end
    else
      Dest := '';    {no local destination}
    S := HTMLExpandFileName(S);
    Ext := Uppercase(ExtractFileExt(S));
    if (Ext = '.HTM') or (Ext = '.HTML')  then
      begin              {an html file}
      if S <> FCurrentFile then
        begin
        LoadFromFile(S + Dest);
        AddVisitedLink(S+Dest);
        end
      else
        if PositionTo(Dest) then   {file already loaded, change position}
          begin
          BumpHistory(FCurrentFile, FTitle, OldPos, Nil, HTMLType);
          AddVisitedLink(S+Dest);
          end;
      end
    else if (Ext = '.BMP') or (Ext = '.GIF') or (Ext = '.JPG') or (Ext = '.JPEG')
                or (Ext = '.PNG') then
      LoadImageFile(S);
    end;
    {Note: Self may not be valid here}
  end;
end;

{----------------ThtmlViewer.AddVisitedLink}
procedure ThtmlViewer.AddVisitedLink(const S: string);    
var
  I, J: integer;
  S1, UrlTmp: string;
begin
if Assigned(FrameOwner) or (FVisitedMaxCount = 0) then
  Exit;      {TFrameViewer will take care of visited links}
I := Visited.IndexOf(S);
if I = 0 then Exit
else if I < 0 then
  begin
  for J := 0 to SectionList.LinkList.Count-1 do
    with TFontObj(SectionList.LinkList[J]) do
      begin
      UrlTmp := Url;
      if Length(UrlTmp) > 0 then
        begin
        if Url[1] = '#' then
          S1 := FCurrentFile+UrlTmp
        else
          S1 := HTMLExpandFilename(UrlTmp);
        if CompareText(S, S1) = 0 then
          Visited := True;
        end;
      end;
  end
else Visited.Delete(I);   {thus moving it to the top}
Visited.Insert(0, S);
for I :=  Visited.Count-1 downto FVisitedMaxCount do
  Visited.Delete(I);
end;

{----------------ThtmlViewer.CheckVisitedLinks}
procedure ThtmlViewer.CheckVisitedLinks;
var
  I, J: integer;
  S, S1: string;
begin
if FVisitedMaxCount = 0 then
  Exit;
for I := 0 to Visited.Count-1 do
  begin
  S := Visited[I];
  for J := 0 to SectionList.LinkList.Count-1 do
    with TFontObj(SectionList.LinkList[J]) do
      begin
      if (Url <> '') and (Url[1] = '#') then
        S1 := FCurrentFile+Url
      else
        S1 := HTMLExpandFilename(Url);
      if CompareText(S, S1) = 0 then
        Visited := True;
      end;
  end;
end;

{----------------ThtmlViewer.HTMLMouseDown}
procedure ThtmlViewer.HTMLMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  XR, CaretHt: integer;
  YR: integer;
  InText: boolean;
begin
inherited MouseDown(Button, Shift, X, Y);

SetFocus;
HotSpotAction := False;
if MiddleScrollOn then
  begin
  MiddleScrollOn := False;
  PaintPanel.Cursor := Cursor;
  MouseScrolling := False;
  end
else if (Button = mbMiddle) and not (htNoWheelMouse in htOptions) then  {comment this out to disable mouse middle button scrolling}
  begin
  MiddleScrollOn := True;
  MiddleY := Y;
  PaintPanel.Cursor := UpDownCursor;
  end
else if (Button = mbLeft) then
  begin
  LeftButtonDown := True;
  HiLiting := True;
  with FSectionList do
    begin
    Sel1 := FindCursor(PaintPanel.Canvas, X, Y+YOff, XR, YR, CaretHt, InText);
    if Sel1 > -1 then
      begin
      if (SelB <> SelE) or (ssShift in Shift) then    
        InvalidateRect(PaintPanel.Handle, Nil, True);
      if (ssShift in Shift) then   
        if Sel1 < CaretPos then
          begin
          SelE := CaretPos;
          SelB := Sel1;
          end
        else
          begin
          SelB := CaretPos;
          SelE := Sel1;
          end
      else
        begin
        SelB := Sel1;
        SelE := Sel1;
        CaretPos := Sel1;
        end;
      end;
    LButtonDown(True);   {signal to TSectionList}
    end;
  end;
end;

procedure ThtmlViewer.HTMLTimerTimer(Sender: TObject);  
var
  Pt: TPoint;
begin
if GetCursorPos(Pt) and (WindowFromPoint(Pt) <> PaintPanel.Handle) then
  begin
  SectionList.CancelActives;
  HTMLTimer.Enabled := False;
  if FURL <> '' then
    begin
    FURL := '';
    FTarget := '';
    if Assigned(FOnHotSpotCovered) then FOnHotSpotCovered(Self, '');
    end;
  end;
end;

function ThtmlViewer.PtInObject(X, Y: integer; var Obj: TObject): boolean;  {X, Y, are client coord} {css}
var
  IX, IY: integer;
begin
Result := PtInRect(ClientRect, Point(X, Y)) and
            FSectionList.PtInObject(X, Y+FSectionList.YOff, Obj, IX, IY);
end;

procedure ThtmlViewer.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  Dummy : TUrlTarget;
  DummyFC: TImageFormControlObj;
begin
if Sender is TFormControlObj then
  with TFormControlObj(Sender), TheControl do
    begin
    FTitleAttr:= Title;
    if FTitleAttr = '' then
      GetURL(X+Left, Y+Top, Dummy, DummyFC, FTitleAttr);
    Inherited MouseMove(Shift,X,Y);
    end;
end;

function ThtmlViewer.GetTextByIndices(AStart, ALast: integer): WideString;  
var
  SaveSelB: Integer;
  SaveSelE: Integer;
begin
if (AStart >= 0) and (ALast >= 0) and (ALast > AStart) then
  with FSectionList do
    begin
    SaveSelB := SelB;
    SaveSelE := SelE;
    SelB := Self.FindDisplayPos(AStart, False);
    SelE := Self.FindDisplayPos(ALast, False);
    Result := GetSelText;
    SelB := SaveSelB;
    SelE := SaveSelE;
    end
else Result := '';
end;

{----------------ThtmlViewer.HTMLMouseMove}
procedure ThtmlViewer.HTMLMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  UrlTarget : TUrlTarget;
  Url, Target: string;
  FormControl: TImageFormControlObj;
  Obj: TObject;
  IX, IY: integer;
  XR, CaretHt: integer;
  YR: integer;
  InText: boolean;
  NextCursor: TCursor;
  guResult: guResultType; 
begin
Inherited MouseMove(Shift,X,Y);

if MiddleScrollOn then
  begin
  if not MouseScrolling and (Abs(Y-MiddleY) > ScrollGap) then
    begin
    MouseScrolling := True;
    PostMessage(Handle, wm_MouseScroll, 0, 0);
    end;
  Exit;
  end;

UrlTarget := Nil;
URL := '';
NextCursor := crArrow;
FTitleAttr := '';
guResult := GetURL(X, Y, UrlTarget, FormControl, FTitleAttr);
if guUrl in guResult then
  begin
  NextCursor := HandCursor;
  Url := UrlTarget.Url;
  Target := UrlTarget.Target;
  FLinkAttributes.Text := UrlTarget.Attr;  
  FLinkText := GetTextByIndices(UrlTarget.Start, UrlTarget.Last);   
  UrlTarget.Free;
  end; 
if guControl in guResult then
  NextCursor := HandCursor;
if (Assigned(FOnImageClick) or Assigned(FOnImageOver)) and
     FSectionList.PtInObject(X, Y+FSectionList.YOff, Obj, IX, IY) then
  begin
  if NextCursor <> HandCursor then  {in case it's also a Link}
    NextCursor := crArrow;
  if Assigned(FOnImageOver) then FOnImageOver(Self, Obj, Shift, IX, IY);
  end
else if (FSectionList.FindCursor(PaintPanel.Canvas, X, Y+FSectionList.YOff, XR, YR, CaretHt, InText) >= 0)