📄 iwhtmleng.pas
字号:
if Pos('HEIGHT',TagProp) > 0 then
begin
Tagp := Copy(TagProp,ipos('HEIGHT',TagProp) + 7,Length(TagProp));
Tagp := Copy(Tagp,pos('"',Tagp) + 1,Length(Tagp));
Tagp := Copy(Tagp,1,pos('"',Tagp) - 1);
Val(Tagp,TagHeight,Err);
end;
IMGSize.x := 0;
IMGSize.y := 0;
bmp := nil;
if Assigned(ic) then
begin
if (Pos('://',Prop) > 0) 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;
end;
if Assigned(bmp) then
begin
if not bmp.Empty then
begin
if not Calc {and not Print} then
begin
if (TagWidth > 0) and (TagHeight > 0) then
Canvas.StretchDraw(Rect(cr.Left,cr.Top,cr.Left + TagWidth,cr.Top + TagHeight),bmp)
else
begin
// need for animation - redraw background
if bmp.FrameCount > 1 then
begin
Canvas.Pen.Color := BlnkColor;
Canvas.Brush.Color := BlnkColor;
Canvas.Rectangle(cr.Left,cr.Top,cr.Left + bmp.MaxWidth,cr.Top+bmp.MaxHeight);
end;
Canvas.Draw(cr.Left + bmp.FrameXPos,cr.Top + bmp.FrameYPos,bmp);
end;
end;
if (TagWidth > 0) and (TagHeight > 0) then
begin
IMGSize.x := MulDiv(TagWidth,GetDeviceCaps(Canvas.Handle,LOGPIXELSX),96);
IMGSize.y := MulDiv(TagHeight,GetDeviceCaps(Canvas.Handle,LOGPIXELSY),96);
end
else
begin
IMGSize.x := MulDiv(bmp.MaxWidth,GetDeviceCaps(Canvas.Handle,LOGPIXELSX),96);
IMGSize.y := MulDiv(bmp.MaxHeight,GetDeviceCaps(Canvas.Handle,LOGPIXELSY),96);
end;
end;
end;
if (XPos - r.Left > w) and (XPos - r.Left < w + IMGSize.x) and
(YPos > cr.Top) and (YPos < cr.Top + IMGSize.Y) and Anchor then
begin
ImageHotSpot := True;
AnchorVal := LastAnchor;
AltImg := ImgIdx;
end;
if Print then
begin
//IMGSize.x := Round(IMGSize.x * ResFactor);
//IMGSize.y := Round(IMGSize.y * ResFactor);
{$IFDEF TMSDEBUG}
DbgPoint('bmp : ',point(IMGSize.x,IMGSize.y));
{$ENDIF}
end;
if (w + IMGSize.x > r.Right-r.Left) and
(IMGSize.x < r.Right - r.Left) then
begin
ImgBreak := True;
end
else
begin
w := w + IMGSize.x;
cr.left := cr.left + IMGSize.x;
if IMGSize.y > h then
h := IMGSize.y;
end;
if Pos('ALIGN',TagProp) > 0 then
begin
if Pos('"TOP',TagProp) > 0 then
begin
ImgAli := h - Canvas.TextHeight('gh');
end
else
begin
if Pos('"MIDDLE',TagProp) > 0 then
ImgAli := (h - Canvas.TextHeight('gh')) shr 1;
end;
end;
end;
end;
'L':begin
w := w + 12 * ListIndex;
if Linkbreak then
Imgbreak := True else Linkbreak := True;
cr.left := cr.left + 12 * (ListIndex - 1);
if not calc then
begin
Prop := Canvas.Font.Name;
Canvas.Font.Name:='Symbol';
if Odd(ListIndex) then
DrawText(Canvas.Handle,'?',1,cr,0)
else
DrawText(Canvas.Handle,'o',1,cr,0);
Canvas.Font.Name:=prop;
end;
cr.Left := cr.Left + 12;
end;
'U':begin
if s[3] <> '>' then
begin
Inc(ListIndex);
end
else
Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
end;
'P':begin
if (VarPos('>',s,TagPos)>0) then
begin
TagProp := Uppercase(Copy(s,3,TagPos-1));
if VarPos('ALIGN',TagProp,TagPos) > 0 then
begin
Prop := Copy(TagProp,TagPos+5,Length(TagProp));
Prop := Copy(Prop,Pos('"',prop)+1,Length(Prop));
Prop := Copy(Prop,1,Pos('"',prop)-1);
if Pos('RIGHT',Prop) > 0 then Align := taRightJustify;
if Pos('LEFT',Prop) > 0 then Align := taLeftJustify;
if Pos('CENTER',Prop) > 0 then Align := taCenter;
end;
if VarPos('INDENT',TagProp,TagPos) > 0 then
begin
Prop := Copy(TagProp,TagPos+6,Length(TagProp));
Prop := Copy(Prop,Pos('"',prop)+1,Length(Prop));
Prop := Copy(Prop,1,Pos('"',prop)-1);
PIndent := IStrToInt(Prop);
end;
if VarPos('BGCOLOR',TagProp,TagPos) > 0 then
begin
Prop := Copy(TagProp,TagPos + 5,Length(TagProp));
Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop));
Prop := Copy(Prop,1,Pos('"',Prop) - 1);
NewColor := clNone;
if Length(Prop) > 0 then
begin
if Prop[1] = '#' then
NewColor := Hex2Color(Prop)
else
NewColor := Text2Color(AnsiLowerCase(prop));
end;
if not Calc then
begin
isPara := True;
paracolor := Canvas.Brush.Color;
if Canvas.Brush.Style = bsClear then ParaColor := clNone;
Canvas.Brush.color := NewColor;
PenColor:=Canvas.Pen.Color;
Canvas.Pen.Color := Newcolor;
Canvas.Rectangle(fr.left,r.top,fr.right,r.bottom);
end;
end;
end;
end;
'F':begin
if (VarPos('>',s,TagPos)>0) then
begin
TagProp := UpperCase(Copy(s,6,TagPos-6));
if (VarPos('FACE',TagProp,TagPos) > 0) then
begin
Prop := Copy(TagProp,TagPos+4,Length(TagProp));
Prop := Copy(prop,pos('"',prop)+1,Length(prop));
Prop := Copy(prop,1,pos('"',prop)-1);
Canvas.Font.Name := Prop;
end;
if (VarPos(' COLOR',TagProp,TagPos) > 0) and not Selected then
begin
Prop := Copy(TagProp,TagPos+6,Length(TagProp));
Prop := Copy(Prop,Pos('"',prop)+1,Length(prop));
Prop := Copy(Prop,1,Pos('"',prop)-1);
//oldfont.color:=Canvas.font.color;
if Length(Prop) > 0 then
begin
if Prop[1] = '#' then
Canvas.font.color := Hex2Color(Prop)
else
Canvas.Font.Color := Text2Color(AnsiLowerCase(prop));
end;
end;
if (VarPos('BGCOLOR',TagProp,TagPos)>0) and not Calc and not Selected then
begin
Prop := Copy(TagProp,TagPos+7,Length(TagProp));
Prop := Copy(prop,pos('"',prop)+1,Length(prop));
Prop := Copy(prop,1,pos('"',prop)-1);
BGColor := Canvas.Brush.Color;
if Canvas.Brush.Style = bsClear then
bgcolor := clNone;
if Length(Prop) > 0 then
begin
if Prop[1] = '#' then
Canvas.Brush.Color := Hex2Color(Prop)
else
Canvas.Brush.Color := Text2Color(AnsiLowerCase(prop));
end;
end;
if (VarPos('SIZE',TagProp,TagPos)>0) then
begin
Prop := Copy(TagProp,TagPos+4,Length(TagProp));
Prop := Copy(Prop,Pos('=',Prop)+1,Length(Prop));
Prop := Copy(Prop,Pos('"',Prop)+1,Length(Prop));
case IStrToInt(Prop) of
1:Canvas.Font.Size := 8;
2:Canvas.Font.Size := 10;
3:Canvas.Font.Size := 12;
4:Canvas.Font.Size := 14;
5:Canvas.Font.Size := 16;
else
Canvas.Font.Size := IStrToInt(Prop);
end;
end;
end;
end;
'S':begin
TagChar := Upcase(s[3]);
if TagChar = '>' then
Canvas.Font.Style := Canvas.font.Style + [fsStrikeOut]
else
begin
if TagChar = 'H' then
isShad := True
else
begin
if ipos('<SUB>',s)=1 then
isSub := True
else
if ipos('<SUP>',s)=1 then
isSup := True;
end;
end;
end;
'R':begin
TagProp := Copy(s,3,pos('>',s)-1);
prop := Copy(TagProp,ipos('a',TagProp)+2,Length(TagProp));
prop := Copy(prop,pos('"',prop)+1,Length(prop));
prop := Copy(prop,1,pos('"',prop)-1);
Val(prop,Indent,err);
StartRotated(Canvas,indent);
end;
'Z':Invisible := True;
end;
end;
if (VarPos('>',s,TagPos)>0) and not ImgBreak then
begin
Res := Res + Copy(s,1,TagPos);
Delete(s,1,TagPos);
end
else
if not Imgbreak then
Delete(s,1,Length(s));
end;
end;
w := w - sw;
if w > xsize then
xsize := w;
if (FocusLink = Hyperlinks-1) and Anchor and not Calc then
begin
rr.Right := cr.Left;
rr.Bottom := cr.Bottom;
InflateRect(rr,1,0);
if not Calc then
Canvas.DrawFocusRect(rr);
rr.Left := r.Left + 1;
rr.Top := rr.Bottom;
end;
Result := Res;
end;
{$WARNINGS ON}
begin
Anchor := False;
Error := False;
OldFont := TFont.Create;
OldFont.Assign(Canvas.Font);
DrawFont := TFont.Create;
DrawFont.Assign(Canvas.Font);
CalcFont := TFont.Create;
CalcFont.Assign(Canvas.Font);
OldDrawfont := TFont.Create;
OldDrawFont.Assign(Canvas.Font);
OldCalcFont := TFont.Create;
OldCalcFont.Assign(Canvas.Font);
BlnkColor := Canvas.Brush.color;
Canvas.Brush.Color := clNone;
BGColor := clNone;
ParaColor := clNone;
isPara := False;
isShad := False;
Invisible := False;
Result := False;
r := fr;
r.Left := r.Left + 1; {required to add offset for DrawText problem with first capital W letter}
Align := taLeftJustify;
PIndent := 0;
XSize := 0;
YSize := 0;
HyperLinks := 0;
HlCount := 0;
ListIndex := 0;
LiCount := 0;
StripVal := '';
FocusAnchor := '';
MouseLink := -1;
MouseInAnchor := False;
ImgIdx := 0;
AltImg := -1;
SetBKMode(Canvas.Handle,TRANSPARENT);
DrawStyle := DT_LEFT or DT_SINGLELINE or DT_EXTERNALLEADING or DT_BOTTOM or DT_EXPANDTABS;// or DT_NOPREFIX;
if not WordWrap then
DrawStyle := DrawStyle or DT_END_ELLIPSIS;
if Pos('&',s) > 0 then
begin
repeat
Foundtag := False;
//if TagReplacestring('<','<',s) then Foundtag := True;
//if TagReplacestring('>','>',s) then Foundtag := True;
if TagReplacestring('&','&&',s) then Foundtag := True;
if TagReplacestring('"','"',s) then Foundtag := True;
if TagReplacestring('§','?',s) then Foundtag := True;
if TagReplacestring('‰','畨',s) then Foundtag := True;
if TagReplacestring('®','?',s) then Foundtag := True;
if TagReplacestring('©','?',s) then Foundtag := True;
if TagReplacestring('¶','?',s) then Foundtag := True;
if TagReplacestring('™','?',s) then Foundtag := True;
if TagReplacestring('€','⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -