📄 iwhtmleng.pas
字号:
WordWidth := cr.Right - cr.Left;
w := w + WordWidth;
if (XPos - cr.Left >= w - WordWidth) and (XPos - cr.Left <= w) and Anchor then
begin
HotSpot := True;
if (YPos > cr.Top){ and (YPos < cr.Bottom)} then
begin
Anchorval := LastAnchor;
MouseInAnchor := True;
end;
end;
end;
LengthFits := (w < r.Right - r.Left) or (r.Right - r.Left <= WordWidth);
//outputdebugstring(pchar('*'+LineText+'*'));
if not LengthFits and
((Length(LineText) > 0) and (LineText[Length(LineText)] <> ' ')) then
LengthFits := True;
LineText := LineText + su;
if LengthFits or not WordWrap then
begin
Res := Res + Copy(s,1,WordLen);
if not LengthFits and Calc then
s := '';
Delete(s,1,WordLen);
if su[WordLen] = ' ' then
sw := Canvas.TextWidth(' ')
else
sw := 0;
end
else
begin
LineBreak := True;
w := w - WordWidth;
end;
end;
end;
TagPos := Pos('<',s);
if (TagPos = 1) and (Length(s) <= 2) then
s := '';
if not LineBreak and (TagPos = 1) and (Length(s) > 2) then
begin
if (s[2] = '/') and (Length(s) > 3) then
begin
case UpCase(s[3]) of
'A':begin
if (not HoverStyle or (Hoverlink = Hyperlinks)) and not Calc then
begin
Canvas.Font.Style := Canvas.Font.Style - [fsUnderline];
if Hovercolor <> clNone then
begin
Canvas.Brush.Color := HvrColor;
if HvrColor = clNone then
Canvas.Brush.Style := bsClear;
end;
if HoverFontColor <> clNone then
Canvas.Font.Color := HoverFontColor;
end;
if not Selected then
Canvas.Font.Color := Oldfont.Color;
Anchor := False;
if MouseInAnchor then
begin
hr.Bottom := r.Bottom;
hr.Right := r.Left + w;
if r.Top <> hr.Top then
begin
hr.Left := r.Left;
hr.Top := r.Top;
end;
HoverRect := hr;
MouseLink := HyperLinks;
{$IFDEF TMSDEBUG}
DbgRect('hotspot anchor '+lastanchor,hr);
{$ENDIF}
MouseInAnchor := False;
end;
if Focuslink = Hyperlinks - 1 then
begin
rr.Right := cr.Left;
rr.Bottom := cr.Bottom - ImgAli;
rr.Top := rr.Bottom - Canvas.TextHeight('gh');
InflateRect(rr,1,0);
if not Calc then Canvas.DrawFocusRect(rr);
end;
end;
'E':begin
if not Calc then
Error := False;
end;
'B':begin
if s[4] <> '>' then
Canvas.Font.Color := OldFont.Color
else
Canvas.Font.Style := Canvas.Font.Style - [fsBold];
end;
'S':begin
TagChar := UpCase(s[4]);
if (TagChar = 'U') then
begin
isSup := False;
isSub := False;
end
else
if (TagChar = 'H') then
isShad := False
else
Canvas.Font.Style := Canvas.Font.Style - [fsStrikeOut];
end;
'F':begin
Canvas.Font.Name := OldFont.Name;
Canvas.Font.Size := OldFont.Size;
if not Calc and not Selected then
begin
Canvas.Font.Color := OldFont.Color;
Canvas.Brush.Color := BGColor;
if BGColor = clNone then
begin
Canvas.Brush.Style := bsClear;
end;
end;
end;
'H':begin
if not Calc then
begin
Canvas.Font.Color := hifCol;
Canvas.Brush.Color := hibCol;
if hibCol = clNone then
Canvas.Brush.Style := bsClear;
end;
end;
'I':begin
Canvas.Font.Style := Canvas.Font.Style - [fsItalic];
end;
'P':begin
LineBreak := True;
if not Calc then
begin
Canvas.Brush.Color := ParaColor;
if ParaColor = clNone then Canvas.Brush.Style := bsClear;
isPara := false;
end;
end;
'U':begin
if (s[4] <> '>') and (ListIndex > 0) then
Dec(Listindex)
else
Canvas.Font.Style := Canvas.Font.Style - [fsUnderline];
end;
'R':begin
EndRotated(Canvas);
end;
'Z':Invisible := False;
end;
end
else
begin
case Upcase(s[2]) of
'A':begin
{only do this when at hover position in xpos,ypos}
if (FocusLink = HyperLinks) and not Calc then
begin
rr.Left := cr.Left;
rr.Top := cr.Top;
end;
Inc(HyperLinks);
if (not HoverStyle or (Hoverlink = HyperLinks)) and not Calc then
begin
Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
if (Hovercolor <> clNone) and not Calc then
begin
HvrColor := Canvas.Brush.Color;
if Canvas.Brush.Style = bsClear then
HvrColor := clNone;
Canvas.Brush.Color := HoverColor;
end;
if HoverFontColor <> clNone then
begin
hvrfntcolor := Canvas.Font.Color;
Canvas.Font.Color := HoverFontColor;
end;
end;
if not Selected and ((HoverFontColor = clNone) or (HoverLink <> HyperLinks) or not HoverStyle) then
Canvas.Font.Color := URLColor;
TagProp := Copy(s,3,Pos('>',s) - 1); // <A href="anchor">
Prop := Copy(TagProp,Pos('"',TagProp) + 1,Length(TagProp));
Prop := Copy(Prop,1,Pos('"',Prop) - 1);
LastAnchor := Prop;
Anchor := True;
hr.Left := w;
hr.Top := r.Top;
end;
'B':begin
TagChar := Upcase(s[3]);
if TagChar = '>' then // <B> tag
Canvas.Font.Style := Canvas.Font.Style + [fsBold]
else
if TagChar = 'R' then // <BR> tag
begin
LineBreak := true;
StripVal := StripVal + #13;
end
else
begin
if TagChar = 'L' then // <BLINK> tag
begin
if not Blink then Canvas.Font.Color := BlnkColor;
end
else
if TagChar = 'O' then // <BODY ... >
begin
Res := Res + Copy(s,1,pos('>',s));
TagProp := Uppercase(Copy(s,6,pos('>',s)-1));
if (Pos('BACKGROUND',TagProp) > 0) and not Calc then
begin
Prop := Copy(TagProp,Pos('BACKGROUND',TagProp)+10,Length(TagProp));
Prop := Copy(Prop,Pos('"',Prop)+1,Length(prop));
Prop := Copy(Prop,1,Pos('"',Prop)-1);
bmp := nil;
if (Pos('://',Prop) > 0) and Assigned(ic) then
begin
bmp := ic.FindPicture(Prop);
if not Assigned(bmp) then
begin
with ic.AddPicture do
begin
Asynch := False;
LoadFromURL(Prop);
end;
bmp := ic.FindPicture(Prop);
end;
end
else
begin
bmp := ic.FindPicture(Prop);
if not Assigned(bmp) then
begin
with ic.AddPicture do
begin
BaseDir := ic.BaseDir;
LoadFromFile(Prop);
end;
bmp := ic.FindPicture(Prop);
end;
end;
if Assigned(bmp) then
begin
if not bmp.Empty and (bmp.Width > 0) and (bmp.Height > 0) then
begin
// do the tiling here
bmpy := 0;
hrgn := CreateRectRgn(fr.left, fr.top, fr.right,fr.bottom);
SelectClipRgn(Canvas.Handle, hrgn);
while (bmpy < fr.bottom-fr.top) do
begin
bmpx := 0;
while (bmpx < fr.right - fr.left) do
begin
Canvas.Draw(fr.left+bmpx,fr.top+bmpy,bmp);
bmpx := bmpx + bmp.width;
end;
bmpy := bmpy + bmp.height;
end;
SelectClipRgn(Canvas.handle, 0);
DeleteObject(hrgn);
end;
end; //end of bmp <> nil
end; //end of background
if (Pos('BGCOLOR',TagProp)>0) then
begin
Prop := Copy(TagProp,Pos('BGCOLOR',TagProp) + 7,Length(TagProp));
Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop));
Prop := Copy(Prop,1,Pos('"',Prop) - 1);
if not Calc then
begin
if Pos('CL',Prop) > 0 then
Canvas.Brush.color := Text2Color(AnsiLowerCase(Prop));
if Pos('#',Prop) > 0 then
Canvas.Brush.color := Hex2Color(Prop);
if not Calc then
begin
BGColor := Canvas.Brush.Color;
Pencolor := Canvas.Pen.Color;
Canvas.Pen.color := BGColor;
Canvas.Rectangle(fr.Left,fr.Top,fr.Right,fr.Bottom);
Canvas.Pen.Color := PenColor;
end;
end;
end;
end;
end;
end;
'E':begin
if not Calc then
Error := True;
end;
'H':begin
case Upcase(s[3]) of
'R':
begin
LineBreak := True;
if not Calc then
begin
Pencolor := Canvas.Pen.color;
Canvas.Pen.color:=clblack;
Canvas.MoveTo(r.left,cr.bottom+1);
Canvas.Lineto(r.right,cr.bottom+1);
Canvas.pen.color:=pencolor;
end;
end;
'I':
begin
if not Calc then
begin
hifCol := Canvas.Font.Color;
hibCol := Canvas.Brush.Color;
if Canvas.Brush.Style = bsClear then
hibCol := clNone;
Canvas.Brush.Color := clHighLight;
Canvas.Font.Color := clHighLightText;
end;
end;
end;
end;
'I':begin
TagChar := Upcase(s[3]);
if TagChar = '>' then // <I> tag
Canvas.Font.Style := Canvas.Font.Style + [fsItalic]
else
if TagChar = 'N' then // <IND> tag
begin
TagProp := Copy(s,3,pos('>',s)-1);
Prop := Copy(TagProp,ipos('x',TagProp)+2,Length(TagProp));
Prop := Copy(Prop,Pos('"',Prop)+1,Length(prop));
Prop := Copy(Prop,1,Pos('"',Prop)-1);
val(Prop,indent,err);
if err = 0 then
begin
if indent > w then
begin
w := Indent;
cr.left := fr.left + Indent;
end;
end;
end
else
if TagChar = 'M' then
begin
inc(ImgIdx);
//oldfont.color:=Canvas.font.color;
TagProp := Uppercase(Copy(s,3,pos('>',s) - 1));
Prop := Copy(TagProp,Pos('SRC',TagProp) + 4,Length(TagProp));
Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop));
Prop := Copy(Prop,1,Pos('"',Prop) - 1);
if (Pos('ALT',TagProp) > 0) and (AltImg = ImgIdx) then
begin
Prop := Copy(TagProp,Pos('ALT',TagProp) + 4,Length(TagProp));
Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop));
Prop := Copy(Prop,1,Pos('"',Prop) - 1);
end;
TagWidth := 0;
TagHeight := 0;
if Pos('WIDTH',TagProp) > 0 then
begin
Tagp := Copy(TagProp,Pos('WIDTH',TagProp) + 6,Length(TagProp));
Tagp := Copy(Tagp,Pos('"',tagp) + 1,Length(Tagp));
Tagp := Copy(Tagp,1,Pos('"',tagp) - 1);
Val(Tagp,TagWidth,Err);
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -