{**************************************************************************}
{ Mini HTML rendering engine }
{ for Delphi & C++Builder }
{ }
{ written by TMS Software }
{ copyright © 1999-2008 }
{ Email : info@tmssoftware.com }
{ Website : http://www.tmssoftware.com/ }
{ }
{ The source code is given as is. The author is not responsible }
{ for any possible damage done due to the use of this code. }
{ The component can be freely used in any application. The complete }
{ source code remains property of the author and may not be distributed, }
{ published, given or sold in any form as such. No parts of the source }
{ code can be included in any other component or application without }
{ written authorization of the author. }
{**************************************************************************}
{$I TMSDEFS.INC}
{$IFNDEF TMSDOTNET}
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
var
BitmapHeader: pBitmapInfo;
BitmapImage : POINTER;
HeaderSize : DWORD;
ImageSize : DWORD;
begin
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);
GetMem(BitmapImage, ImageSize);
try
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top, // Destination Origin
DestRect.Right - DestRect.Left, // Destination Width
DestRect.Bottom - DestRect.Top, // Destination Height
0, 0, // Source Origin
Bitmap.Width, Bitmap.Height, // Source Width & Height
BitmapImage,
TBitmapInfo(BitmapHeader^),
DIB_RGB_COLORS,
SRCCOPY)
finally
FreeMem(BitmapHeader);
FreeMem(BitmapImage)
end;
end;
{$ENDIF}
{$IFDEF TMSDOTNET}
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
var
BitmapHeader: TBitmapInfo;
HeaderSize : DWORD;
ImageSize : DWORD;
Bits: HBITMAP;
Image: TBytes;
Info: IntPtr;
begin
Bits := Bitmap.Handle;
GetDIBSizes(Bits, HeaderSize, ImageSize);
Info := System.Runtime.InteropServices.Marshal.AllocHGlobal(HeaderSize);
try
SetLength(Image, ImageSize);
GetDIB(Bits, 0, Info, Image);
BitmapHeader := TBitmapInfo(System.Runtime.InteropServices.Marshal.PtrToStructure(Info, TypeOf(TBitmapInfo)));
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top, // Destination Origin
DestRect.Right - DestRect.Left, // Destination Width
DestRect.Bottom - DestRect.Top, // Destination Height
0, 0, // Source Origin
Bitmap.Width, Bitmap.Height, // Source Width & Height
Image,
Info,
DIB_RGB_COLORS,
SRCCOPY)
finally
System.Runtime.InteropServices.Marshal.FreeHGlobal(Info);
end;
end;
{$ENDIF}
function DirExists(const Name: string): Boolean;
var
Code: Integer;
begin
{$IFNDEF TMSDOTNET}
Code := GetFileAttributes(PChar(Name));
{$ENDIF}
{$IFDEF TMSDOTNET}
Code := GetFileAttributes(Name);
{$ENDIF}
Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
function SysImage(Canvas: TCanvas;x,y:Integer;APath:string;large,draw,print:boolean;resfactor:double):TPoint;
var
SFI: TSHFileInfo;
i,Err: Integer;
imglsthandle: THandle;
rx,ry: Integer;
bmp: TBitmap;
r: TRect;
begin
Val(APath,i,Err);
{$IFNDEF TMSDOTNET}
FillChar(SFI,Sizeof(SFI),0);
{$ENDIF}
{$IFNDEF TMSDOTNET}
if (APath <> '') and (Err <> 0) then
begin
if FileExists(APath) or DirExists(APath) then
// If the file or directory exists, just let Windows figure out it's attrs.
SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo),
SHGFI_SYSICONINDEX {or OPEN_FLAG[Open] or SELECTED_FLAG[Selected]})
else
// File doesn't exist, so Windows doesn't know what to do with it. We have
// to tell it by passing the attributes we want, and specifying the
// SHGFI_USEFILEATTRIBUTES flag so that the function knows to use them.
SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo),
SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES {or OPEN_FLAG[Open] or SELECTED_FLAG[Selected]});
i := SFI.iIcon;
end;
if Large then
imglsthandle := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
SHGFI_SYSICONINDEX or SHGFI_LARGEICON)
else
imglsthandle := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
{$ENDIF}
{$IFDEF TMSDOTNET}
if (APath <> '') and (Err <> 0) then
begin
if FileExists(APath) or DirExists(APath) then
// If the file or directory exists, just let Windows figure out it's attrs.
SHGetFileInfo(APath, 0, SFI, System.Runtime.interopservices.marshal.SizeOf(TypeOf(TSHFileInfo)),
SHGFI_SYSICONINDEX {or OPEN_FLAG[Open] or SELECTED_FLAG[Selected]})
else
// File doesn't exist, so Windows doesn't know what to do with it. We have
// to tell it by passing the attributes we want, and specifying the
// SHGFI_USEFILEATTRIBUTES flag so that the function knows to use them.
SHGetFileInfo(APath, 0, SFI, System.Runtime.interopservices.Marshal.SizeOf(TypeOf(TSHFileInfo)),
SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES {or OPEN_FLAG[Open] or SELECTED_FLAG[Selected]});
i := SFI.iIcon;
end;
if Large then
imglsthandle := SHGetFileInfo('', 0, SFI, System.Runtime.interopservices.Marshal.SizeOf(TypeOf(SFI)),
SHGFI_SYSICONINDEX or SHGFI_LARGEICON)
else
imglsthandle := SHGetFileInfo('', 0, SFI, System.Runtime.interopservices.Marshal.SizeOf(TypeOf(SFI)),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
{$ENDIF}
ImageList_GetIconSize(imglsthandle,rx,ry);
{$IFNDEF TMSDOTNET}
Result := Point(rx,ry);
{$ENDIF}
{$IFDEF TMSDOTNET}
Result := Borland.Vcl.Types.Point(rx,ry);
{$ENDIF}
if Draw and not Print then
ImageList_Draw(imglsthandle,i,Canvas.Handle,x,y, ILD_TRANSPARENT);
if Draw and Print then
begin
bmp := TBitmap.Create;
bmp.Width := rx;
bmp.Height := ry;
ImageList_Draw(imglsthandle,i,bmp.Canvas.handle,0,0,ILD_NORMAL);
r.left := x;
r.top := y;
r.right := x + Round(rx * ResFactor);
r.bottom := y + Round(ry * ResFactor);
PrintBitmap(Canvas,r,bmp);
bmp.Free;
end;
end;
procedure DrawHTMLGradient(Canvas: TCanvas; FromColor,ToColor,BorderColor: TColor; Steps: Integer;R:TRect; Direction: Boolean);
var
diffr,startr,endr: Integer;
diffg,startg,endg: Integer;
diffb,startb,endb: Integer;
iend: Integer;
rstepr,rstepg,rstepb,rstepw: Real;
i,stepw: Word;
begin
if Steps = 0 then
Steps := 1;
FromColor := ColorToRGB(FromColor);
ToColor := ColorToRGB(ToColor);
startr := (FromColor and $0000FF);
startg := (FromColor and $00FF00) shr 8;
startb := (FromColor and $FF0000) shr 16;
endr := (ToColor and $0000FF);
endg := (ToColor and $00FF00) shr 8;
endb := (ToColor and $FF0000) shr 16;
diffr := endr - startr;
diffg := endg - startg;
diffb := endb - startb;
rstepr := diffr / steps;
rstepg := diffg / steps;
rstepb := diffb / steps;
if Direction then
rstepw := (R.Right - R.Left) / Steps
else
rstepw := (R.Bottom - R.Top) / Steps;
with Canvas do
begin
for i := 0 to Steps - 1 do
begin
endr := startr + Round(rstepr*i);
endg := startg + Round(rstepg*i);
endb := startb + Round(rstepb*i);
stepw := Round(i*rstepw);
Pen.Color := endr + (endg shl 8) + (endb shl 16);
Brush.Color := Pen.Color;
if Direction then
begin
iend := R.Left + stepw + Trunc(rstepw) + 1;
if iend > R.Right then
iend := R.Right;
Rectangle(R.Left + stepw,R.Top,iend,R.Bottom)
end
else
begin
iend := R.Top + stepw + Trunc(rstepw)+1;
if iend > r.Bottom then
iend := r.Bottom;
Rectangle(R.Left,R.Top + stepw,R.Right,iend);
end;
end;
if BorderColor <> clNone then
begin
Brush.Style := bsClear;
Pen.Color := BorderColor;
Rectangle(R.Left,R.Top,R.Right,R.Bottom);
end;
end;
end;
{
procedure DrawHTMLGradient(Canvas: TCanvas; FromColor,ToColor: TColor; Steps: Integer;R:TRect; Direction: Boolean);
var
diffr,startr,endr: Integer;
diffg,startg,endg: Integer;
diffb,startb,endb: Integer;
iend: Integer;
rstepr,rstepg,rstepb,rstepw: Real;
i,stepw: Word;
begin
if Steps = 0 then
Steps := 1;
FromColor := ColorToRGB(FromColor);
ToColor := ColorToRGB(ToColor);
startr := (FromColor and $0000FF);
startg := (FromColor and $00FF00) shr 8;
startb := (FromColor and $FF0000) shr 16;
endr := (ToColor and $0000FF);
endg := (ToColor and $00FF00) shr 8;
endb := (ToColor and $FF0000) shr 16;
diffr := endr - startr;
diffg := endg - startg;
diffb := endb - startb;
rstepr := diffr / steps;
rstepg := diffg / steps;
rstepb := diffb / steps;
if Direction then
rstepw := (R.Right - R.Left) / Steps
else
rstepw := (R.Bottom - R.Top) / Steps;
with Canvas do
begin
for i := 0 to Steps - 1 do
begin
endr := startr + Round(rstepr*i);
endg := startg + Round(rstepg*i);
endb := startb + Round(rstepb*i);
stepw := Round(i*rstepw);
Pen.Color := endr + (endg shl 8) + (endb shl 16);
Brush.Color := Pen.Color;
if Direction then
begin
iend := R.Left + stepw + Trunc(rstepw) + 1;
if iend > R.Right then
iend := R.Right;
Rectangle(R.Left + stepw,R.Top,iend,R.Bottom)
end
else
begin
iend := R.Top + stepw + Trunc(rstepw)+1;
if iend > r.Bottom then
iend := r.Bottom;
Rectangle(R.Left,R.Top + stepw,R.Right,iend);
end;
end;
end;
end;
}
function Text2Color(s:string):tcolor;
begin
Result := clBlack;
if (s='clred') then result:=clred else
if (s='clblack') then result:=clblack else
if (s='clblue') then result:=clblue else
if (s='clgreen') then result:=clgreen else
if (s='claqua') then result:=claqua else
if (s='clyellow') then result:=clyellow else
if (s='clfuchsia') then result:=clfuchsia else
if (s='clwhite') then result:=clwhite else
if (s='cllime') then result:=cllime else
if (s='clsilver') then result:=clsilver else
if (s='clgray') then result:=clgray else
if (s='clolive') then result:=clolive else
if (s='clnavy') then result:=clnavy else
if (s='clpurple') then result:=clpurple else
if (s='clteal') then result:=clteal else
if (s='clmaroon') then result:=clmaroon;
if Result <> clBlack then Exit;
if (s='clbackground') then result:=clbackground else
if (s='clactivecaption') then result:=clactivecaption else
if (s='clinactivecaption') then result:=clinactivecaption else
if (s='clmenu') then result:=clmenu else
if (s='clwindow') then result:=clwindow else
if (s='clwindowframe') then result:=clwindowframe else
if (s='clmenutext') then result:=clmenutext else
if (s='clwindowtext') then result:=clwindowtext else
if (s='clcaptiontext') then result:=clcaptiontext else
if (s='clactiveborder') then result:=clactiveborder else
if (s='clinactiveborder') then result:=clinactiveborder else
if (s='clappworkspace') then result:=clappworkspace else
if (s='clhighlight') then result:=clhighlight else
if (s='clhighlighttext') then result:=clhighlighttext else
if (s='clbtnface') then result:=clbtnface else
if (s='clbtnshadow') then result:=clbtnshadow else
if (s='clgraytext') then result:=clgraytext else
if (s='clbtntext') then result:=clbtntext else
if (s='clinactivecaptiontext') then result:=clinactivecaptiontext else
if (s='clbtnhighlight') then result:=clbtnhighlight else
if (s='cl3ddkshadow') then result:=clgraytext else
if (s='cl3dlight') then result:=cl3dlight else
if (s='clinfotext') then result:=clinfotext else
if (s='clinfobk') then result:=clinfobk;
end;
function HexVal(s:string): Integer;
var
i,j: Integer;
begin
if Length(s) < 2 then
begin
Result := 0;
Exit;
end;
if s[1] >= 'A' then
i := ord(s[1]) - ord('A') + 10
else
i := ord(s[1]) - ord('0');
if s[2] >= 'A' then
j := ord(s[2]) - ord('A') + 10
else
j := ord(s[2]) - ord('0');
Result := i shl 4 + j;
end;
function Hex2Color(s:string): TColor;
var
r,g,b: Integer;
begin
r := Hexval(Copy(s,2,2));
g := Hexval(Copy(s,4,2)) shl 8;
b := Hexval(Copy(s,6,2)) shl 16;
Result := TColor(b + g + r);
end;
function IPos(su,s:string):Integer;
begin
Result := Pos(UpperCase(su),UpperCase(s));
end;
function IStrToInt(s:string):Integer;
var
Err,Res: Integer;
begin
Val(s,Res,Err);
Result := Res;
end;
function DBTagStrip(s:string):string;
var
i,j: Integer;
begin
i := Pos('<#',s);
if i > 0 then
begin
Result := Copy(s,1,i - 1);
Delete(s,1,i);
j := Pos('>',s);
if j > 0 then
Delete(s,j,1);
Result := Result + s;
end
else
Result := s;
end;
function CRLFStrip(s:string;break:boolean):string;
var
i: Integer;
begin
Result := '';
for i := 1 to Length(s) do
begin
if not ( (s[i] =#13) or (s[i] =#10)) then
Result := Result + s[i]
else
if (s[i] = #13) and break then
Result := Result + '
';
end;
end;
function VarPos(su,s:string;var Res:Integer):Integer;
begin
Res := Pos(su,s);
Result := Res;
end;
function TagReplaceString(const Srch,Repl:string;var Dest:string):Boolean;
var
i: Integer;
begin
i := IPos(srch,dest);
if i > 0 then
begin
Result := True;
Delete(Dest,i,Length(Srch));
Dest := Copy(Dest,1,i-1) + Repl + Copy(Dest,i,Length(Dest));
end
else
Result := False;
end;
{$WARNINGS OFF}
function HTMLDrawEx(Canvas:TCanvas; s:string; fr:TRect;
FImages: TCustomImageList;
XPos,YPos,FocusLink,HoverLink,ShadowOffset: Integer;
CheckHotSpot,CheckHeight,Print,Selected,Blink,HoverStyle,WordWrap: Boolean;
ResFactor:Double;
URLColor,HoverColor,HoverFontColor,ShadowColor:TColor;
var AnchorVal,StripVal,FocusAnchor: string;
var XSize,YSize,HyperLinks,MouseLink: Integer;
var HoverRect:TRect;ic: THTMLPictureCache; pc: TPictureContainer;LineSpacing: Integer): Boolean;
var
su: string;
r,dr,hr,rr,er: TRect;
htmlwidth,htmlheight,txtheight: Integer;
Align: TAlignment;
PIndent: Integer;
OldFont: TFont;
CalcFont: TFont;
DrawFont: TFont;
OldCalcFont: TFont;
OldDrawFont: TFont;
Hotspot, ImageHotspot: Boolean;
Anchor,OldAnchor,MouseInAnchor,Error: Boolean;
bgcolor,paracolor,hvrcolor,hvrfntcolor,pencolor,blnkcolor,hifcol,hibcol: TColor;
LastAnchor,OldAnchorVal: string;
IMGSize: TPoint;
isSup,isSub,isPara,isShad: Boolean;
subh,suph,imgali,srchpos,hlcount,licount: Integer;
hrgn,holdfont: THandle;
ListIndex: Integer;
dtp: TDrawTextParams;
Invisible: Boolean;
FoundTag: Boolean;
{new for editing}
nnFit: Integer;
nnSize: TSize;
inspoint: Integer;
{$IFNDEF TMSDOTNET}
nndx: Pointer;
{$ENDIF}
AltImg,ImgIdx,OldImgIdx: Integer;
DrawStyle: DWord;
Col1,Col2: TColor;
ofsx,newofsx: integer;
procedure StartRotated(Canvas:TCanvas;Angle: Integer);
var
LFont:TLogFont;
begin
{$IFNDEF TMSDOTNET}
GetObject(Canvas.Font.Handle,SizeOf(LFont),Addr(LFont));
{$ENDIF}
{$IFDEF TMSDOTNET}
GetObject(Canvas.Font.Handle,System.Runtime.InteropServices.Marshal.SizeOf(TypeOf(LFont)),LFont);
{$ENDIF}
LFont.lfEscapement := Angle * 10;
LFont.lfOrientation := Angle * 10;
hOldFont:=SelectObject(Canvas.Handle,CreateFontIndirect(LFont));
end;
procedure EndRotated(Canvas:TCanvas);
begin
DeleteObject(SelectObject(Canvas.Handle,hOldFont));
end;
function HTMLDrawLine(Canvas: TCanvas;var s:string;r: TRect;Calc:Boolean;
var w,h,subh,suph,imgali:Integer;var Align:TAlignment; var PIndent: Integer;
XPos,YPos:Integer;var Hotspot,ImageHotSpot:Boolean;OffsetX: integer; var NewOffsetX: integer):string;
var
su,Res,TagProp,Prop,AltProp,Tagp,LineText:string;
cr: TRect;
linebreak,imgbreak,linkbreak: Boolean;
th,sw,indent,err,bmpx,bmpy,oldh: Integer;
TagPos,SpacePos,o,l: Integer;
bmp: THTMLPicture;
ABitmap: TBitmap;
NewColor,NewColorTo: TColor;
TagWidth,TagHeight,WordLen,WordLenEx,WordWidth: Integer;
TagChar: Char;
LengthFits, SpaceBreak: Boolean;
begin
Result := '';
LineText := '';
r.Bottom := r.Bottom - Subh;
w := 0;
sw := 0;
LineBreak := False;
ImgBreak := False;
LinkBreak := False;
HotSpot := False;
ImageHotSpot := False;
// r.Left := r.Left + offsetX;
cr := r;
res := '';
if not Calc then
cr.Left := cr.Left + OffsetX;
if isPara and not Calc then
begin
Pencolor := Canvas.Pen.Color;
Canvas.Pen.color := Canvas.Brush.Color;
Canvas.Rectangle(fr.Left,r.Top,fr.Right,r.Top + h);
end;
while (Length(s) > 0) and not LineBreak and not ImgBreak do
begin
// get next word or till next HTML tag
TagPos := Pos('<',s);
if WordWrap then
SpacePos := Pos(' ',s)
else
SpacePos := 0;
if (Tagpos > 0) and ((SpacePos > TagPos) or (SpacePos = 0)) then
begin
su := Copy(s,1,TagPos - 1);
end
else
begin
if SpacePos > 0 then
su := Copy(s,1,SpacePos)
else
su := s;
end;
{$IFDEF TMSDEBUG}
DbgMsg(su+ '.');
{$ENDIF}
WordLen := Length(su);
while Pos(' ',su) > 0 do
begin
TagReplacestring(' ',' ',su);
end;
while Pos('<',su) > 0 do
begin
TagReplacestring('<','<',su);
end;
while Pos('>',su) > 0 do
begin
TagReplacestring('>','>',su);
end;
WordLenEx := Length(su);
if WordLen > 0 then
begin
th := Canvas.TextHeight(su);
if isSub and (subh < (th shr 2)) then subh := th shr 2;
if isSup and (suph < (th shr 2)) then suph := th shr 2;
if th > h then
h := th;
StripVal := StripVal + su;
if Invisible then
Delete(s,1,WordLen);
if not Invisible then
begin
// draw mode
if not Calc then
begin
if isSup then
cr.Bottom := cr.Bottom - suph;
if isSub then
cr.Bottom := cr.Bottom + subh;
cr.Bottom := cr.Bottom - imgali;
if isShad then
begin
OffsetRect(cr,ShadowOffset,ShadowOffset);
NewColor := Canvas.Font.Color;
Canvas.Font.Color := ShadowColor;
{$IFNDEF TMSDOTNET}
DrawTextEx(Canvas.Handle,PChar(su),WordLenEx,cr,DrawStyle and not DT_EXTERNALLEADING,nil);
{$ENDIF}
{$IFDEF TMSDOTNET}
DrawTextEx(Canvas.Handle,su,WordLenEx,cr,DrawStyle and not DT_EXTERNALLEADING,nil);
{$ENDIF}
Offsetrect(cr,-ShadowOffset,-ShadowOffset);
Canvas.Font.Color := NewColor;
end;
{$IFNDEF TMSDOTNET}
DrawTextEx(Canvas.Handle,PChar(su),WordLenEx,cr,DrawStyle and not DT_EXTERNALLEADING,nil);
DrawTextEx(Canvas.Handle,PChar(su),WordLenEx,cr,DrawStyle or DT_CALCRECT,nil);
{$ENDIF}
{$IFDEF TMSDOTNET}
DrawTextEx(Canvas.Handle,su,WordLenEx,cr,DrawStyle and not DT_EXTERNALLEADING,nil);
DrawTextEx(Canvas.Handle,su,WordLenEx,cr,DrawStyle or DT_CALCRECT,nil);
{$ENDIF}
if Anchor and (Hyperlinks - 1 = FocusLink) then
FocusAnchor := LastAnchor;
{$IFDEF TMSDEBUG}
if Anchor then
OutputDebugString(pchar('drawrect for '+anchorval+' = ['+inttostr(cr.Left)+':'+inttostr(cr.Top)+'] ['+inttostr(cr.right)+':'+inttostr(cr.bottom)+'] @ ['+inttostr(xpos)+':'+inttostr(ypos)));
{$ENDIF}
if Error then
begin
Canvas.Pen.Color := clRed;
Canvas.Pen.Width := 1;
l := (cr.Left div 2) * 2;
if (l mod 4)=0 then o := 2 else o := 0;
Canvas.MoveTo(l,r.Bottom + o - 1);
while l < cr.Right do
begin
if o = 2 then o := 0 else o := 2;
Canvas.LineTo(l + 2,r.bottom + o - 1);
Inc(l,2);
end;
// if o = 2 then o := 0 else o := 2;
// Canvas.LineTo(l + 2,r.Bottom + o - 1);
end;
cr.Left := cr.Right;
cr.Right := r.Right;
cr.Bottom := r.Bottom;
cr.Top := r.Top;
end
else
begin
cr := r; //reinitialized each time !
{$IFNDEF TMSDOTNET}
DrawTextEx(Canvas.Handle,PChar(su),WordLenEx,cr,DrawStyle or DT_CALCRECT,nil);
{$ENDIF}
{$IFDEF TMSDOTNET}
DrawTextEx(Canvas.Handle,su,WordLenEx,cr,DrawStyle or DT_CALCRECT,nil);
{$ENDIF}
// preparations for editing purposes
if (ypos > cr.Top) and (ypos < cr.bottom) and (xpos > w) then {scan charpos here}
begin
{$IFNDEF TMSDOTNET}
er := rect(w,cr.top,xpos,cr.bottom);
Fillchar(dtp,sizeof(dtp),0);
{$ENDIF}
{$IFDEF TMSDOTNET}
er := Borland.Vcl.Types.rect(w,cr.top,xpos,cr.bottom);
{$ENDIF}
dtp.cbSize:=sizeof(dtp);
{$IFDEF DELPHI4_LVL}
{$IFNDEF TMSDOTNET}
GetTextExtentExPoint(Canvas.Handle,pChar(su),WordLenEx,xpos-w,@nnfit,nil,nnSize);
{$ENDIF}
{$IFDEF TMSDOTNET}
GetTextExtentExPoint(Canvas.Handle,su,WordLenEx,xpos-w,nnfit,nil,nnSize);
{$ENDIF}
{$ELSE}
{$IFNDEF TMSDOTNET}
nndx := nil; {fix for declaration error in Delphi 3 WINDOWS.PAS}
GetTextExtentExPoint(Canvas.Handle,pChar(su),WordLenEx,xpos - w,nnfit,integer(nndx^),nnSize);
{$ENDIF}
{$IFDEF TMSDOTNET}
GetTextExtentExPoint(Canvas.Handle,su,WordLenEx,xpos - w,nnfit,nil,nnSize);
{$ENDIF}
{$ENDIF}
{this will get the character pos of the insertion point}
if nnfit = WordLen then
InsPoint := InsPoint + WordLen
else
InsPoint := InsPoint + nnfit;
end;
{end of preparations for editing purposes}
{ Calculated text width }
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 - OfsX) or (r.Right - r.Left - OfsX <= WordWidth);
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 and (LineText <> su) then
// s := '';
Delete(s,1,WordLen);
if Length(su) >= WordLen then
begin
{$IFNDEF TMSDOTNET}
if System.Copy(su, WordLen, 1) = ' ' then
{$ENDIF}
{$IFDEF TMSDOTNET}
if Copy(su, WordLen, 1) = ' ' then
{$ENDIF}
sw := Canvas.TextWidth(' ')
else
sw := 0;
end
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;
'L':begin
LineBreak := True;
end;
'O':begin
NewOffsetX := 0;
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); //
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]);
case TagChar of
'>': Canvas.Font.Style := Canvas.Font.Style + [fsBold]; // tag
'R': //
tag
begin
LineBreak := true;
StripVal := StripVal + #13;
end;
'L': if not Blink then
Canvas.Font.Color := BlnkColor; // ' + value + '' + h + '' + value + '